mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 19:29:18 +02:00
* fix tests as depending on the platform the first parameter in the RTTI data might *not* be $self
git-svn-id: trunk@39965 -
This commit is contained in:
parent
7b150102bf
commit
c0c602f76d
@ -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
|
||||||
|
@ -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);
|
||||||
|
Loading…
Reference in New Issue
Block a user