paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 14:20:05 +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
ErrorHalt('Expected at least 1 parameter, but got 0', []);
{ first parameter is always self }
{ first parameter in aParams is always self }
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];
if pfResult in param^.Flags then
Continue;
TestParam(param, aParams[c].name, aParams[c].flags, aParams[c].paramtype);
Inc(c);
if pfSelf in param^.Flags then
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;
if c <> Length(aParams) then

10
tests/webtbs/tw2886.pp
View File

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