Test suite results for test file webtbs/tw2886.pp

Test run data :

Test file "webtbs/tw2886.pp" information:

t_id 1237
t_adddate 2004/01/23
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 1

Log of 488056:

Param 1/2 $self:Pointer
ERROR!

Source:

{ 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.

Link to SVN view of webtbs/tw2886.pp source.