Browse Source

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

git-svn-id: trunk@39965 -
svenbarth 6 years ago
parent
commit
c0c602f76d
2 changed files with 15 additions and 8 deletions
  1. 8 5
      tests/test/trtti15.pp
  2. 7 3
      tests/webtbs/tw2886.pp

+ 8 - 5
tests/test/trtti15.pp

@@ -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

+ 7 - 3
tests/webtbs/tw2886.pp

@@ -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);