paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 00:09:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix tests as depending on the platform the first parameter in the RTTI data might *not* be $self

Browse Source 
git-svn-id: trunk@39965 -
This commit is contained in:
svenbarth 2018-10-17 20:53:51 +00:00
parent 7b150102bf
commit c0c602f76d
2 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
tests/test/trtti15.pp
View File

@ -96,16 +96,19 @@ begin
if aMethod^.ParamCount < 1 then if aMethod^.ParamCount < 1 then
ErrorHalt('Expected at least 1 parameter, but got 0', []); ErrorHalt('Expected at least 1 parameter, but got 0', []);
{ first parameter is always self } { first parameter in aParams is always self }
c := 1; c := 1;
TestParam(aMethod^.Param[0], aParams[0].name, aParams[0].flags, aParams[0].paramtype);
for i := 1 to aMethod^.ParamCount - 1 do begin for i := 0 to aMethod^.ParamCount - 1 do begin
param := aMethod^.Param[i]; param := aMethod^.Param[i];
if pfResult in param^.Flags then if pfResult in param^.Flags then
Continue; Continue;
TestParam(param, aParams[c].name, aParams[c].flags, aParams[c].paramtype); if pfSelf in param^.Flags then
Inc(c); TestParam(param, aParams[0].name, aParams[0].flags, aParams[0].paramtype)
else begin
TestParam(param, aParams[c].name, aParams[c].flags, aParams[c].paramtype);
Inc(c);
end;
end; end;
if c <> Length(aParams) then if c <> Length(aParams) then

10
tests/webtbs/tw2886.pp
View File

@ -23,6 +23,8 @@ type
{ TMyClass } { TMyClass }
procedure TMyClass.ShowRTTI; procedure TMyClass.ShowRTTI;
type
PParamFlags = ^TParamFlags;
var var
TypeData: PTypeData; TypeData: PTypeData;
ParamCount: Integer; ParamCount: Integer;
@ -30,6 +32,7 @@ var
Len: Integer; Len: Integer;
CurParamName: string; CurParamName: string;
CurTypeIdentifier: string; CurTypeIdentifier: string;
CurFlags: TParamFlags;
i: Integer; i: Integer;
begin begin
TypeData:=GetTypeData(GetPropInfo(Self,'MyEvent')^.PropType); TypeData:=GetTypeData(GetPropInfo(Self,'MyEvent')^.PropType);
@ -39,6 +42,7 @@ begin
i:=0; i:=0;
// for i:=0 to ParamCount-1 do begin // for i:=0 to ParamCount-1 do begin
CurFlags := PParamFlags(@TypeData^.ParamList[0])^;
// SizeOf(TParamFlags) is 4, but the data is only 1 byte // SizeOf(TParamFlags) is 4, but the data is only 1 byte
//Len:=1; // typinfo.pp comment is wrong: SizeOf(TParamFlags) //Len:=1; // typinfo.pp comment is wrong: SizeOf(TParamFlags)
// Note by SB (2017-01-08): No longer true since typinfo uses packed sets // Note by SB (2017-01-08): No longer true since typinfo uses packed sets
@ -60,9 +64,9 @@ begin
inc(Offset,Len+1); inc(Offset,Len+1);
writeln('Param ',i+1,'/',ParamCount,' ',CurParamName,':',CurTypeIdentifier); writeln('Param ',i+1,'/',ParamCount,' ',CurParamName,':',CurTypeIdentifier);
// Note by SB (2019-10-08): The first parameter is now the hidden $self // Note by SB (2019-10-08): The first parameter might now be the hidden $self
if (CurParamName<>'$self') or (CurTypeIdentifier<>'Pointer') then if ((pfSelf in CurFlags) and ((CurParamName<>'$self') or (CurTypeIdentifier<>'Pointer'))) or
//if (CurParamName<>'Sender') or (CurTypeIdentifier<>'TObject') then (not (pfSelf in CurFlags) and ((CurParamName<>'Sender') or (CurTypeIdentifier<>'TObject'))) then
begin begin
writeln('ERROR!'); writeln('ERROR!');
halt(1); halt(1);