From c1390b3442585367bc885fc2433cb452cafe5fd4 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Tue, 31 Jan 2017 18:21:53 +0000
Subject: [PATCH] * 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        |  1 +
 compiler/ncgrtti.pas  | 17 ++++++++++---
 tests/test/trtti16.pp | 58 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 73 insertions(+), 3 deletions(-)
 create mode 100644 tests/test/trtti16.pp

diff --git a/.gitattributes b/.gitattributes
index 53c7116d13..a1345725ff 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
index 8a7cc4faa1..9215224a9d 100644
--- a/compiler/ncgrtti.pas
+++ b/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) }
-            tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
+                (see TObject.CleanupInstance)
+              - 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);
diff --git a/tests/test/trtti16.pp b/tests/test/trtti16.pp
new file mode 100644
index 0000000000..ba9da83b76
--- /dev/null
+++ b/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.