diff --git a/tests/webtbs/tw2886.pp b/tests/webtbs/tw2886.pp new file mode 100644 index 0000000000..0e77c30833 --- /dev/null +++ b/tests/webtbs/tw2886.pp @@ -0,0 +1,75 @@ +{ Source provided for Free Pascal Bug Report 2886 } +{ Submitted by "Mattias Gaertner" on 2004-01-08 } +{ e-mail: mattias@freepascal.org } +program WrongRTTIParams; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, TypInfo; + +type + TAnEvent = procedure(Sender: TObject) of object; + + TMyClass = class(TPersistent) + private + FMyEvent: TAnEvent; + public + procedure ShowRTTI; + published + property MyEvent: TAnEvent read FMyEvent write FMyEvent; + end; + +{ TMyClass } + +procedure TMyClass.ShowRTTI; +var + TypeData: PTypeData; + ParamCount: Integer; + Offset: Integer; + Len: Integer; + CurParamName: string; + CurTypeIdentifier: string; + i: Integer; +begin + TypeData:=GetTypeData(GetPropInfo(Self,'MyEvent')^.PropType); + ParamCount:=TypeData^.ParamCount; + Offset:=0; + + i:=0; +// for i:=0 to ParamCount-1 do begin + + // SizeOf(TParamFlags) is 4, but the data is only 1 byte + Len:=1; // typinfo.pp comment is wrong: SizeOf(TParamFlags) + inc(Offset,Len); + + // read ParamName + Len:=ord(TypeData^.ParamList[Offset]); + SetLength(CurParamName,Len); + if Len>0 then + Move(TypeData^.ParamList[Offset+1],CurParamName[1],Len); + inc(Offset,Len+1); + + // read ParamType + Len:=ord(TypeData^.ParamList[Offset]); + SetLength(CurTypeIdentifier,Len); + if CurTypeIdentifier<>'' then + Move(TypeData^.ParamList[Offset+1],CurTypeIdentifier[1],Len); + inc(Offset,Len+1); + + writeln('Param ',i+1,'/',ParamCount,' ',CurParamName,':',CurTypeIdentifier); + if (CurParamName<>'Sender') or (CurTypeIdentifier<>'TObject') then + begin + writeln('ERROR!'); + halt(1); + end; + +// end; +end; + +var + MyClass: TMyClass; +begin + MyClass:=TMyClass.Create; + MyClass.ShowRTTI; +end.