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 ;-)
