Browse Source

* fix access to ParamFlags of the tkMethod branch of type data for CPUs requiring proper alignment

git-svn-id: trunk@42511 -
florian 6 years ago
parent
commit
23585ded15
3 changed files with 51 additions and 4 deletions
  1. 5 2
      packages/rtl-objpas/src/inc/rtti.pp
  2. 36 0
      rtl/objpas/typinfo.pp
  3. 10 2
      tests/test/trtti19.pp

+ 5 - 2
packages/rtl-objpas/src/inc/rtti.pp

@@ -2967,7 +2967,8 @@ begin
   if not aWithHidden and (Length(FParams) > 0) then
   if not aWithHidden and (Length(FParams) > 0) then
     Exit(FParams);
     Exit(FParams);
 
 
-  ptr := @FTypeData^.ParamList[0];
+  ptr := AlignTParamFlags(@FTypeData^.ParamList[0]);
+
   visible := 0;
   visible := 0;
   total := 0;
   total := 0;
 
 
@@ -2983,7 +2984,9 @@ begin
       Inc(ptr, ptr^ + SizeOf(Byte));
       Inc(ptr, ptr^ + SizeOf(Byte));
       { skip type name }
       { skip type name }
       Inc(ptr, ptr^ + SizeOf(Byte));
       Inc(ptr, ptr^ + SizeOf(Byte));
-      { align? }
+      { align }
+      ptr := AlignTParamFlags(ptr);
+
       if not (pfHidden in infos[total].Flags) then
       if not (pfHidden in infos[total].Flags) then
         Inc(visible);
         Inc(visible);
       Inc(total);
       Inc(total);

+ 36 - 0
rtl/objpas/typinfo.pp

@@ -832,6 +832,8 @@ unit TypInfo;
 // general property handling
 // general property handling
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 Function AlignTypeData(p : Pointer) : Pointer; inline;
 Function AlignTypeData(p : Pointer) : Pointer; inline;
+Function AlignTParamFlags(p : Pointer) : Pointer; inline;
+Function AlignPTypeInfo(p : Pointer) : Pointer; inline;
 
 
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string): PPropInfo;
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string): PPropInfo;
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string; AKinds: TTypeKinds): PPropInfo;
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string; AKinds: TTypeKinds): PPropInfo;
@@ -1357,6 +1359,40 @@ begin
 end;
 end;
 
 
 
 
+Function AlignTParamFlags(p : Pointer) : Pointer; inline;
+{$packrecords c}
+  type
+    TAlignCheck = record
+      b : byte;
+      w : word;
+    end;
+{$packrecords default}
+begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=Pointer(align(p,PtrInt(@TAlignCheck(nil^).w)))
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=p;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+end;
+
+
+Function AlignPTypeInfo(p : Pointer) : Pointer; inline;
+{$packrecords c}
+  type
+    TAlignCheck = record
+      b : byte;
+      p : pointer;
+    end;
+{$packrecords default}
+begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=Pointer(align(p,PtrInt(@TAlignCheck(nil^).p)))
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+  Result:=p;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+end;
+
+
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 begin
 begin
   GetTypeData:=AlignTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);
   GetTypeData:=AlignTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);

+ 10 - 2
tests/test/trtti19.pp

@@ -19,6 +19,7 @@ var
   pb: PByte;
   pb: PByte;
   i: SizeInt;
   i: SizeInt;
 begin
 begin
+  // writeln(SizeOf(TparamFlags));
   ti := PTypeInfo(TypeInfo(TTestProc));
   ti := PTypeInfo(TypeInfo(TTestProc));
   td := GetTypeData(ti);
   td := GetTypeData(ti);
   if td^.ProcSig.ParamCount <> 3 then
   if td^.ProcSig.ParamCount <> 3 then
@@ -38,34 +39,41 @@ begin
     Halt(6);
     Halt(6);
   if procparam^.ParamFlags * [pfConstRef] <> [pfConstRef] then
   if procparam^.ParamFlags * [pfConstRef] <> [pfConstRef] then
     Halt(7);
     Halt(7);
-
+  
   ti := PTypeInfo(TypeInfo(TTestMethod));
   ti := PTypeInfo(TypeInfo(TTestMethod));
   td := GetTypeData(ti);
   td := GetTypeData(ti);
   if td^.ParamCount <> 4 then
   if td^.ParamCount <> 4 then
     Halt(8);
     Halt(8);
   pb := @td^.ParamList[0];
   pb := @td^.ParamList[0];
+  pb := AlignTParamFlags(pb);
   if PParamFlags(pb)^ * [pfHidden, pfSelf] <> [pfHidden, pfSelf] then
   if PParamFlags(pb)^ * [pfHidden, pfSelf] <> [pfHidden, pfSelf] then
     Halt(9);
     Halt(9);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
+
+  pb := AlignTParamFlags(pb);
   if PParamFlags(pb)^ * [pfVar] <> [pfVar] then
   if PParamFlags(pb)^ * [pfVar] <> [pfVar] then
     Halt(10);
     Halt(10);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
+
+  pb := AlignTParamFlags(pb);
   if PParamFlags(pb)^ * [pfOut] <> [pfOut] then
   if PParamFlags(pb)^ * [pfOut] <> [pfOut] then
     Halt(11);
     Halt(11);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
+
+  pb := AlignTParamFlags(pb);
   if PParamFlags(pb)^ * [pfConstRef] <> [pfConstRef] then
   if PParamFlags(pb)^ * [pfConstRef] <> [pfConstRef] then
     Halt(12);
     Halt(12);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(TParamFlags);
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
   pb := pb + SizeOf(Byte) + pb^;
 
 
-  pb := pb + SizeOf(TCallConv);
+  pb := AlignPTypeInfo(pb + SizeOf(TCallConv));
   for i := 1 to td^.ParamCount - 1 do begin
   for i := 1 to td^.ParamCount - 1 do begin
     if PPPTypeInfo(pb)[i] <> Nil then begin
     if PPPTypeInfo(pb)[i] <> Nil then begin
       Writeln(PPPTypeInfo(pb)[i]^^.Name);
       Writeln(PPPTypeInfo(pb)[i]^^.Name);