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 -

.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

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 :

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 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:=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:=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,

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

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.