* fix for Mantis #31249: applied (adjusted) patch provided by Maciej Izak

Commit message:
[PATCH] More consistent RTTI (also better performance) for classic
 objects (reference to initrtti from fullrtti).

git-svn-id: trunk@35376 -

.gitattributes

@@ -13045,6 +13045,7 @@ tests/test/trtti12.pp svneol=native#text/pascal
 tests/test/trtti13.pp svneol=native#text/pascal
 tests/test/trtti14.pp svneol=native#text/pascal
 tests/test/trtti15.pp svneol=native#text/pascal
+tests/test/trtti16.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

compiler/ncgrtti.pas

@@ -1267,10 +1267,21 @@ implementation
           procedure objectdef_rtti_fields(def:tobjectdef);
           begin
             { - for compatiblity with record RTTI we need to write a terminator-
-                Nil pointer as well for objects
+                Nil pointer for initrtti as well for objects
+              - for RTTI consistency for objects we need point from fullrtti
+                to initrtti
               - classes are assumed to have the same INIT RTTI as records
-                (see TObject.CleanupInstance) }
+                (see TObject.CleanupInstance)
-            tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
+              - neither helper nor class type have fullrtti for fields
+            }
+            if (rt=initrtti) then
+              tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
+            else
+              if (def.objecttype=odt_object) then
+                tcb.emit_tai(Tai_const.Create_sym(get_rtti_label(def,initrtti,false)),voidpointertype)
+              else
+                internalerror(2017011801);
+
             tcb.emit_ord_const(def.size, u32inttype);
             { enclosing record takes care of alignment }
             fields_write_rtti_data(tcb,def,rt);

tests/test/trtti16.pp

@@ -0,0 +1,58 @@
+program trtti16;
+
+{$mode delphi}
+
+uses
+  TypInfo;
+
+type
+  TFoo = class
+    B: Byte;
+    W: Word;
+    L: LongWord;
+    S: string;
+    I: IInterface;
+    A: TArray<byte>;
+  end;
+
+  TBoo = object
+    B: Byte;
+    W: Word;
+    L: LongWord;
+    S: string;
+    I: IInterface;
+    A: TArray<byte>;
+  end;
+
+  TBoo2 = object(TBoo)
+    S2: string;
+    B2: Byte;
+  end;
+
+var
+  td: PTypeData;
+  vmt: PVmt;
+  rid: PRecInitData;
+begin
+  td := GetTypeData(TypeInfo(TFoo));
+  vmt := PVmt(td^.ClassType);
+  rid := PRecInitData(GetTypeData(vmt.vInitTable));
+  if rid^.ManagedFieldCount <> 3 then
+    Halt(1);
+
+  td := GetTypeData(TypeInfo(TBoo));
+  if td^.TotalFieldCount <> 6 then
+    Halt(2);
+
+  rid := td.RecInitData;
+  if rid^.ManagedFieldCount <> 3 then
+    Halt(3);
+
+  td := GetTypeData(TypeInfo(TBoo2));
+  if td^.TotalFieldCount <> 3 then
+    Halt(4);
+
+  rid := td.RecInitData;
+  if rid^.ManagedFieldCount <> 2 then
+    Halt(5);
+end.