Re: [fpc-pascal] Compatibility problems with fpc > 3.3.1 rev 42375

[fredvs]

Hello everybody (included Sven).

It seems that the problems come from
/mseide-msegui/lib/common/fpccompatibility/mclasses.pas.

In procedure TReader.ReadPropValue(Instance: TPersistent; PropInfo:
Pointer), IMHO there is something not compatible with rev 42375.

It would be wonderful if somebody could detect what is wrong with typinfo (I
did not find it yet).

Here the code (I guess) with problem:

-----------------

procedure TReader.ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
const
  NullMethod: TMethod = (Code: nil; Data: nil);
var
  PropType: PTypeInfo;
  Value: LongInt;
{  IdentToIntFn: TIdentToInt; }
  Ident: String;
  Method: TMethod;
  Handled: Boolean;
  TmpStr: String;
  TmpStr8: utf8String;
begin
  if not Assigned(PPropInfo(PropInfo)^.SetProc) then
    raise EReadError.Create(SReadOnlyProperty);

{$ifdef FPC}
  PropType := PPropInfo(PropInfo)^.PropType;
{$else}
  PropType := PPropInfo(PropInfo)^.PropType^;
{$endif}
  case PropType^.Kind of
    tkInteger:
      if FDriver.NextValue = vaIdent then
      begin
        Ident := ReadIdent;
        if GlobalIdentToInt(Ident,Value) then
          SetOrdProp(Instance, PropInfo, Value)
        else
          raise EReadError.Create(SInvalidPropertyValue);
      end else
        SetOrdProp(Instance, PropInfo, ReadInteger);
{$ifdef FPC}
    tkBool:
      SetOrdProp(Instance, PropInfo, Ord(ReadBoolean));
{$endif}
    tkChar:
      SetOrdProp(Instance, PropInfo, Ord(ReadChar));
    tkWChar{$ifdef FPC},tkUChar{$endif}:
      SetOrdProp(Instance, PropInfo, Ord(ReadWideChar));
    tkEnumeration:
      begin
       ident:= ReadIdent;
       Value := GetEnumValue(PropType, ident);
       if Value = -1 then begin
        if assigned(fonenumerror) then begin
         fonenumerror(self,proptype,ident,value);
        end;
       end;
       if Value = -1 then begin        
        raise EReadError.Create(SInvalidPropertyValue);
       end;
       SetOrdProp(Instance, PropInfo, Value);
      end;
{$ifndef FPUNONE}
    tkFloat:
      SetFloatProp(Instance, PropInfo, ReadFloat);
{$endif}
    tkSet:
      begin
        CheckValue(vaSet);
        SetOrdProp(Instance, PropInfo,
        {$ifdef FPC}
          FDriver.ReadSet(GetTypeData(PropType)^.CompType));
        {$else}
          FDriver.ReadSet(GetTypeData(PropType)^.CompType^));
        {$endif}
      end;
    tkMethod:
      if FDriver.NextValue = vaNil then
      begin
        FDriver.ReadValue;
        SetMethodProp(Instance, PropInfo, NullMethod);
      end else
      begin
        Handled:=false;
        Ident:=ReadIdent;
        if Assigned(OnSetMethodProperty) then
          OnSetMethodProperty(Self,Instance,PPropInfo(PropInfo),Ident,
                              Handled);
        if not Handled then begin
          Method.Code := FindMethod(Root, Ident);
          Method.Data := Root;
          if Assigned(Method.Code) then
            SetMethodProp(Instance, PropInfo, Method);
        end;
      end;
    {$ifdef FPC}
    tkSString, tkLString, tkAString:
    {$else}
    tkString, tkLString:
    {$endif}
      begin
       if proptype = typeinfo(utf8string) then begin
        TmpStr8:=Readutf8String;
        if Assigned(FOnReadStringProperty) then begin
          tmpstr:= tmpstr8;
          FOnReadStringProperty(Self,Instance,PropInfo,TmpStr);
          tmpstr8:= tmpstr;
        end;
        SetStrProp(Instance, PropInfo, TmpStr8);
       end
       else begin
        TmpStr:=ReadString;
        if Assigned(FOnReadStringProperty) then
          FOnReadStringProperty(Self,Instance,PropInfo,TmpStr);
        SetStrProp(Instance, PropInfo, TmpStr);
       end;
      end;
    {$ifdef FPC}
    tkUstring:
      SetUnicodeStrProp(Instance,PropInfo,ReadUnicodeString);
    {$endif}
    tkWString:
      SetWideStrProp(Instance,PropInfo,ReadWideString);
    tkVariant:
      begin
        SetVariantProp(Instance,PropInfo,ReadVariant);
      end;
    tkClass:
      case FDriver.NextValue of
        vaNil:
          begin
            FDriver.ReadValue;
            SetOrdProp(Instance, PropInfo, 0)
          end;
        vaCollection:
          begin
            FDriver.ReadValue;
            ReadCollection(TCollection(GetObjectProp(Instance, PropInfo)));
          end
        else begin
          If Not Assigned(FFixups) then begin
//            FFixups:=TLinkedList.Create(TLocalUnresolvedReference);
           FFixups:= tlocalfixups.create;
          end;
//          With tfixups(FFixups).newreference(instance,propinfo) do begin
          With TLocalUnresolvedReference(tlocalfixups(FFixups).add) do begin
           FInstance:= Instance;
           FRoot:= Root;
           FPropInfo:= PropInfo;
           FRelative:= ReadIdent;
          end;
        end;
      end;
    tkInt64{$ifdef FPC}, tkQWord{$endif}:
     SetInt64Prop(Instance, PropInfo, ReadInt64);
    else
      raise EReadError.CreateFmt(SUnknownPropertyType,
[Ord(PropType^.Kind)]);
  end;
end;

------------------------

Fre;D



-----
Many thanks ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal