compiler: write Delphi compatible tkArray RTTI:

- TotalSize of all array dimensions instead of first dimension size - Element type of last array dimension - dimension information rtl: - adopt array initialization/finalization/copy for the new tkArray RTTI - add Delphi compatible TArrayTypeData member for typinfo.TTypeData structure tests: - add a test which checks RTTI information for 2 dimension array git-svn-id: trunk@24458 -
2025-04-10 03:28:40 +02:00 · 2013-05-07 09:12:18 +00:00 · 2013-05-07 09:12:18 +00:00 · dce960c97b
commit dce960c97b
parent bef9b11dad
5 changed files with 143 additions and 35 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -11691,6 +11691,7 @@ tests/test/trtti4.pp svneol=native#text/plain
 tests/test/trtti5.pp svneol=native#text/plain
 tests/test/trtti6.pp svneol=native#text/pascal
 tests/test/trtti7.pp svneol=native#text/pascal
+tests/test/trtti8.pp svneol=native#text/pascal
 tests/test/tsafecall1.pp svneol=native#text/plain
 tests/test/tsafecall2.pp svneol=native#text/pascal
 tests/test/tsafecall3.pp svneol=native#text/pascal
--- a/compiler/ncgrtti.pas
+++ b/compiler/ncgrtti.pas
@ -579,6 +579,11 @@ implementation


        procedure arraydef_rtti(def:tarraydef);
+          var
+            lastai: TLinkedListItem;
+            dimcount: byte;
+            totalcount: asizeuint;
+            curdef:tarraydef;
        begin
           if ado_IsDynamicArray in def.arrayoptions then
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkdynarray))
@ -586,14 +591,34 @@ implementation
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray));
           write_rtti_name(def);
           maybe_write_align;
-           { size of elements }
-           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(def.elesize));

           if not(ado_IsDynamicArray in def.arrayoptions) then
             begin
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(pint(def.elecount)));
-               { element type }
-               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
+               { remember tha last instruction. we will need to insert some
+                 calculated values after it }
+               lastai:=current_asmdata.asmlists[al_rtti].last;
+               curdef:=def;
+               totalcount:=1;
+               dimcount:=0;
+               while assigned(curdef) do
+               begin
+                 { Dims[i] PTypeInfo }
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(curdef.rangedef,rt)));
+                 inc(dimcount);
+                 totalcount:=totalcount*curdef.elecount;
+                 if assigned(curdef.elementdef)and(curdef.elementdef.typ=arraydef) then
+                   curdef:=tarraydef(curdef.elementdef)
+                 else
+                   break;
+               end;
+               { dimension count }
+               current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_8bit(dimcount),lastai);
+               { last dimension element type }
+               current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_sym(ref_rtti(curdef.elementdef,rt)),lastai);
+               { total element count }
+               current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_pint(pint(totalcount)),lastai);
+               { total size = elecount * elesize of the first arraydef }
+               current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_pint(def.elecount*def.elesize),lastai);
             end
           else
             { write a delphi almost compatible dyn. array entry:
@ -603,13 +628,12 @@ implementation
               the names are swapped in typinfo.pp
             }
             begin
+               { size of elements }
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(def.elesize));
               { element type }
               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
-             end;
-           { variant type }
-           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(def.elementdef).getvardef));
-           if ado_IsDynamicArray in def.arrayoptions then
-             begin
+               { variant type }
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(def.elementdef).getvardef));
               { element type }
               if def.elementdef.needs_inittable then
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)))
@ -1221,7 +1245,10 @@ implementation
          setdef :
            write_rtti(tsetdef(def).elementdef,rt);
          arraydef :
-            write_rtti(tarraydef(def).elementdef,rt);
+            begin
+              write_rtti(tarraydef(def).rangedef,rt);
+              write_rtti(tarraydef(def).elementdef,rt);
+            end;
          recorddef :
            fields_write_rtti(trecorddef(def).symtable,rt);
          objectdef :
--- a/rtl/inc/rtti.inc
+++ b/rtl/inc/rtti.inc
@ -32,16 +32,21 @@ type

  PArrayInfo=^TArrayInfo;
  TArrayInfo=packed record
-    ElSize: SizeInt;
+    Size: SizeInt;
    ElCount: SizeInt;
    ElInfo: Pointer;
+    DimCount: Byte;
+    Dims:array[0..255] of Pointer;
  end;

-
 function RTTIArraySize(typeInfo: Pointer): SizeInt;
 begin
  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-  result:=PArrayInfo(typeInfo)^.ElSize * PArrayInfo(typeInfo)^.ElCount;
+  {$ifdef VER2_6}
+  result:=PArrayInfo(typeInfo)^.Size*PArrayInfo(typeInfo)^.ElCount;
+  {$else}
+  result:=PArrayInfo(typeInfo)^.Size;
+  {$endif}
 end;

 function RTTIRecordSize(typeInfo: Pointer): SizeInt;
@ -81,23 +86,38 @@ begin
  { Process elements }
  for i:=1 to count Do
    begin
-      rttiproc (Data+PRecordElement(typeInfo)^.Offset,PRecordElement(typeInfo)^.TypeInfo);
+      rttiproc(Data+PRecordElement(typeInfo)^.Offset,PRecordElement(typeInfo)^.TypeInfo);
      Inc(PRecordElement(typeInfo));
    end;
 end;


 { if you modify this procedure, fpc_copy must be probably modified as well }
+{$ifdef VER2_6}
 procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
 var
-  i : SizeInt;
+  i: SizeInt;
 begin
  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
  { Process elements }
  for I:=0 to PArrayInfo(typeInfo)^.ElCount-1 do
-    rttiproc(Data+(I*PArrayInfo(typeInfo)^.ElSize),PArrayInfo(typeInfo)^.ElInfo);
+    rttiproc(Data+(I*PArrayInfo(typeInfo)^.Size),PArrayInfo(typeInfo)^.ElInfo);
 end;
-
+{$else}
+procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
+var  
+  i,Count,ElSize: SizeInt;
+  Info: Pointer;
+begin
+  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+  Count:=PArrayInfo(typeInfo)^.ElCount;
+  ElSize:=PArrayInfo(typeInfo)^.Size div Count;
+  Info:=PArrayInfo(typeInfo)^.ElInfo;
+  { Process elements }
+  for I:=0 to Count-1 do
+    rttiproc(Data+(I*ElSize),Info);
+end;
+{$endif}

 Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
 begin
@ -205,14 +225,13 @@ Function fpc_Copy_internal (Src, Dest, TypeInfo : Pointer) : SizeInt;[external n

 Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt;[Public,alias : 'FPC_COPY']; compilerproc;
 var
-  ArrayInfo: PArrayInfo;
-  Temp : pbyte;
+  Temp: pbyte;
  copiedsize,
  expectedoffset,
  count,
  offset,
-  i : SizeInt;
-  info : pointer;
+  i: SizeInt;
+  info: pointer;
 begin
  result:=sizeof(pointer);
  case PByte(TypeInfo)^ of
@ -230,11 +249,25 @@ begin
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
    tkArray:
      begin
-        ArrayInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+        Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+      {$ifdef VER2_6}
        { Process elements }
-        for I:=0 to ArrayInfo^.ElCount-1 do
-          fpc_Copy_internal(Src+(I*ArrayInfo^.ElSize),Dest+(I*ArrayInfo^.ElSize),ArrayInfo^.ElInfo);
-        Result:=ArrayInfo^.ElSize*ArrayInfo^.ElCount;
+        for I:=0 to PArrayInfo(Temp)^.ElCount-1 do
+          fpc_Copy_internal(Src+(I*PArrayInfo(Temp)^.Size),Dest+(I*PArrayInfo(Temp)^.Size),PArrayInfo(Temp)^.ElInfo);
+        Result:=PArrayInfo(Temp)^.Size*PArrayInfo(Temp)^.ElCount;
+      {$else}
+        Result:=PArrayInfo(Temp)^.Size;
+        Count:=PArrayInfo(Temp)^.ElCount;
+        Info:=PArrayInfo(Temp)^.ElInfo;
+        copiedsize:=Result div Count;
+        Offset:=0;
+        { Process elements }
+        for I:=1 to Count do
+          begin
+            fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
+            inc(Offset,copiedsize);
+          end;
+      {$endif}
      end;
 {$ifdef FPC_HAS_FEATURE_OBJECTS}
    tkobject,
--- a/rtl/objpas/typinfo.pp
+++ b/rtl/objpas/typinfo.pp
@ -112,6 +112,28 @@ unit typinfo;
      PTypeInfo = ^TTypeInfo;
      PPTypeInfo = ^PTypeInfo;

+      // members of TTypeData
+      TArrayTypeData =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        Size: SizeInt;
+        ElCount: SizeInt;
+        ElType: PTypeInfo;
+        DimCount: Byte;
+        Dims: array[0..255] of PTypeInfo;
+      end;
+
+      TManagedField =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        TypeRef: PTypeInfo;
+        FldOffset: Integer;
+      end;
+
 {$PACKRECORDS C}
      PTypeData = ^TTypeData;
      TTypeData =
@ -200,6 +222,10 @@ unit typinfo;
               RawIntfUnit: ShortString;
               IIDStr: ShortString;
              );
+            tkArray:
+              (
+              ArrayData: TArrayTypeData;
+              );
            tkDynArray:
              (
              elSize     : PtrUInt;
@ -218,15 +244,6 @@ unit typinfo;
              );
      end;

-      // unsed, just for completeness
-      TManagedField =
-      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-      packed
-      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-      record
-        TypeRef: PTypeInfo;
-        FldOffset: Integer;
-      end;
      TPropData =
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
      packed
--- a/tests/test/trtti8.pp
+++ b/tests/test/trtti8.pp
@ -0,0 +1,30 @@
+program trtti8;
+
+{$mode delphi}
+
+uses
+  typinfo;
+
+type
+  TColor = (red, green, blue);
+  TFirstArr = array[0..3] of Integer;
+  TArr = array[TColor] of TFirstArr;
+var
+  Info: PTypeInfo;
+  Data: PTypeData;
+begin
+  Info := TypeInfo(TArr);
+  if Info^.Kind <> tkArray then
+    halt(1);
+  Data := GetTypeData(Info);
+  if Data^.ArrayData.Size <> 12 * SizeOf(Integer) then
+    halt(2);
+  if Data^.ArrayData.ElCount <> 12 then
+    halt(3);
+  if Data^.ArrayData.ElType <> TypeInfo(Integer) then
+    halt(4);
+  if Data^.ArrayData.DimCount <> 2 then
+    halt(5);
+  if Data^.ArrayData.Dims[0] <> TypeInfo(TColor) then
+    halt(6)
+end.