* fix for Mantis #31123, applied patch by Maciej Izak

* adjusted test trtti10.pp due to renamed RecInitTable field

Original commit message:

Public interface for init table for records in TypInfo:

* Rename RecInitTable to RecInitInfo (because it is special kind of PTypeInfo for init table of record). Has more sense in practical usage.
+ New structure TRecInitData (and related PRecInitData) to handle data for (init) type info for records (aka init table)
+ New structure TInitManagedField and pointer type PInitManagedField (for init table)
+ Special helper property RecInitData to get PRecInitData for tkRecord

+ test attached

git-svn-id: trunk@35134 -
This commit is contained in:
svenbarth 2016-12-16 13:43:12 +00:00
parent 121a857af8
commit 460f309035
4 changed files with 67 additions and 2 deletions

1
.gitattributes vendored
View File

@ -13008,6 +13008,7 @@ tests/test/trstr8.pp svneol=native#text/plain
tests/test/trtti1.pp svneol=native#text/plain
tests/test/trtti10.pp svneol=native#text/pascal
tests/test/trtti11.pp svneol=native#text/pascal
tests/test/trtti12.pp svneol=native#text/pascal
tests/test/trtti2.pp svneol=native#text/plain
tests/test/trtti3.pp svneol=native#text/plain
tests/test/trtti4.pp svneol=native#text/plain

View File

@ -158,6 +158,9 @@ unit typinfo;
FldOffset: SizeInt;
end;
PInitManagedField = ^TInitManagedField;
TInitManagedField = TManagedField;
PProcedureParam = ^TProcedureParam;
TProcedureParam =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@ -192,6 +195,18 @@ unit typinfo;
function GetParam(ParamIndex: Integer): PProcedureParam;
end;
PRecInitData = ^TRecInitData;
TRecInitData =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
record
Terminator: Pointer;
Size: Integer;
ManagedFieldCount: Integer;
{ ManagedFields: array[0..ManagedFieldCount - 1] of TInitManagedField ; }
end;
PTypeData = ^TTypeData;
TTypeData =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@ -202,6 +217,9 @@ unit typinfo;
function GetBaseType: PTypeInfo; inline;
function GetCompType: PTypeInfo; inline;
function GetParentInfo: PTypeInfo; inline;
{$ifndef VER3_0}
function GetRecInitData: PRecInitData; inline;
{$endif}
function GetHelperParent: PTypeInfo; inline;
function GetExtendedInfo: PTypeInfo; inline;
function GetIntfParent: PTypeInfo; inline;
@ -218,6 +236,10 @@ unit typinfo;
property CompType: PTypeInfo read GetCompType;
{ tkClass }
property ParentInfo: PTypeInfo read GetParentInfo;
{ tkRecord }
{$ifndef VER3_0}
property RecInitData: PRecInitData read GetRecInitData;
{$endif}
{ tkHelper }
property HelperParent: PTypeInfo read GetHelperParent;
property ExtendedInfo: PTypeInfo read GetExtendedInfo;
@ -270,7 +292,7 @@ unit typinfo;
tkRecord:
(
{$ifndef VER3_0}
RecInitTable: Pointer; { points to TTypeInfo followed by init table }
RecInitInfo: Pointer; { points to TTypeInfo followed by init table }
{$endif VER3_0}
RecSize: Integer;
ManagedFldCount: Integer;
@ -2299,6 +2321,13 @@ begin
Result := DerefTypeInfoPtr(ParentInfoRef);
end;
{$ifndef VER3_0}
function TTypeData.GetRecInitData: PRecInitData;
begin
Result := PRecInitData(aligntoptr(PTypeData(RecInitInfo+2+PByte(RecInitInfo+1)^)));
end;
{$endif}
function TTypeData.GetHelperParent: PTypeInfo;
begin
Result := DerefTypeInfoPtr(HelperParentRef);

View File

@ -10,6 +10,6 @@ type
end;
begin
if GetTypeData(TypeInfo(TFoo)).RecInitTable = nil then
if GetTypeData(TypeInfo(TFoo)).RecInitInfo = nil then
Halt(1);
end.

35
tests/test/trtti12.pp Normal file
View File

@ -0,0 +1,35 @@
program trtti12;
{$MODE DELPHI}
uses
TypInfo;
type
PFoo = ^TFoo;
TFoo = packed record
public
B: Byte;
W: Word;
L: LongWord;
S: string;
I: IInterface;
A: TArray<byte>;
end;
var
td: PTypeData;
id: PRecInitData;
begin
td := GetTypeData(TypeInfo(TFoo));
id := td.RecInitData;
if id.Terminator <> nil then
Halt(1);
if td.ManagedFldCount <> 6 then
Halt(2);
if id.ManagedFieldCount <> 3 then
Halt(3);
end.