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

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

Browse Source 
git-svn-id: trunk@42511 -
This commit is contained in:
florian 2019-07-28 11:55:19 +00:00
parent 91016c97a4
commit 23585ded15
3 changed files with 51 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
packages/rtl-objpas/src/inc/rtti.pp
View File

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

36
rtl/objpas/typinfo.pp
View File

@ -832,6 +832,8 @@ unit TypInfo;
// general property handling
Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
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; AKinds: TTypeKinds): PPropInfo;
@ -1357,6 +1359,40 @@ begin
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;
begin
GetTypeData:=AlignTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);

12
tests/test/trtti19.pp
View File

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