Sfoglia il codice sorgente

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

svenbarth 8 anni fa
parent
commit
460f309035
4 ha cambiato i file con 67 aggiunte e 2 eliminazioni
  1. 1 0
      .gitattributes
  2. 30 1
      rtl/objpas/typinfo.pp
  3. 1 1
      tests/test/trtti10.pp
  4. 35 0
      tests/test/trtti12.pp

+ 1 - 0
.gitattributes

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

+ 30 - 1
rtl/objpas/typinfo.pp

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

+ 1 - 1
tests/test/trtti10.pp

@@ -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 - 0
tests/test/trtti12.pp

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