Change the parent reference inside the VMT to an indirect one.

compiler/ncgvmt.pas, TVMTWriter:
  * writevmt: write a reference to the indirect VMT symbol instead of the direct one

rtl/inc/systemh.inc:
  + enable advanced records for system unit
rtl/inc/objpash.inc & rtl/inc/objpas.inc, TVmt:
  * rename vParent to vParentRef and change type to PPVmt for 2.7.1 and newer
  + add new property vParent of type PVmt and which dereferences vParentRef depending on the type
rtl/inc/generic.inc:
  * tobjectvmt: change parent to ppointer for 2.7.1 and newer
  * fpc_check_object_ext: correctly dereference tobjectvmt.parent for 2.7.1 and newer

tests/webtbs/tw16034.pp:
  * adjusted test which directly uses the binary data

git-svn-id: branches/svenbarth/packages@28341 -

compiler/ncgvmt.pas

@@ -870,7 +870,7 @@ implementation
          { it is not written for parents that don't have any vmt !! }
          if assigned(_class.childof) and
             (oo_has_vmt in _class.childof.objectoptions) then
-           current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(_class.childof.vmt_mangledname,AT_DATA,0))
+           current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(_class.childof.vmt_mangledname(true),AT_DATA,0))
          else
            current_asmdata.asmlists[al_globals].concat(Tai_const.Create_nil_dataptr);
 

rtl/inc/generic.inc

@@ -741,7 +741,11 @@ type
   pobjectvmt=^tobjectvmt;
   tobjectvmt=record
     size,msize:sizeuint;
+    {$ifdef ver2_6}
     parent:pointer;
+    {$else}
+    parent:ppointer;
+    {$endif}
   end;
 
 {$ifndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
@@ -846,7 +850,14 @@ begin
      if vmt=expvmt then
        exit
      else
+       {$ifdef ver2_6}
        vmt:=pobjectvmt(vmt)^.parent;
+       {$else}
+       if assigned(pobjectvmt(vmt)^.parent) then
+         vmt:=pobjectvmt(vmt)^.parent^
+       else
+         vmt:=nil;
+       {$endif}
    RunError(219);
 end;
 {$endif not FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}

rtl/inc/objpas.inc

@@ -268,6 +268,24 @@
       end;
 
 
+{****************************************************************************
+                               TOBJECT
+****************************************************************************}
+
+
+      function TVmt.GetvParent: PVmt;
+        begin
+          {$ifdef ver2_6}
+          Result:=vParentRef;
+          {$else}
+          if Assigned(vParentRef) then
+            Result:=vParentRef^
+          else
+            Result:=Nil;
+          {$endif}
+        end;
+
+
 {****************************************************************************
                                TOBJECT
 ****************************************************************************}

rtl/inc/objpash.inc

@@ -97,10 +97,18 @@
        pinterfacetable = ^tinterfacetable;
 
        PVmt = ^TVmt;
+       PPVmt = ^PVmt;
        TVmt = record
+       private
+         function GetvParent: PVmt; inline;
+       public
          vInstanceSize: SizeInt;
          vInstanceSize2: SizeInt;
-         vParent: PVmt;
+         {$ifdef ver2_6}
+         vParentRef: PVmt;
+         {$else}
+         vParentRef: PPVmt;
+         {$endif}
          vClassName: PShortString;
          vDynamicTable: Pointer;
          vMethodTable: Pointer;
@@ -123,6 +131,7 @@
          vEquals: CodePointer;
          vGetHashCode: CodePointer;
          vToString: CodePointer;
+         property vParent: PVmt read GetvParent;
        end;
 
        PGuid = ^TGuid;

rtl/inc/systemh.inc

@@ -20,6 +20,7 @@
 
 {$I-,Q-,H-,R-,V-}
 {$mode objfpc}
+{$modeswitch advancedrecords}
 
 { At least 2.4.0 is required }
 {$if defined(VER1) or defined(VER2_0) or defined(VER2_2) }

tests/webtbs/tw16034.pp

@@ -77,11 +77,12 @@ enD;
 
 type
   pObjVMT = ^TObjVMT;
+  ppObjVMT = ^pObjVMT;
   TObjVMT =
     record
       fInstanceSize: UInt;
       fInstanceSize2: Int;
-      fParent: pObjVMT;
+      fParent: ppObjVMT;
     enD;
 
 Function GetInstanceSize(AVMT: pObjVMT): UInt;
@@ -93,7 +94,7 @@ Function GetVMTPtrOffset(AVMT: pObjVMT): UInt;
 begin
   if (AVMT.fParent = nil) then
     Result := GetInstanceSize(AVMT) - SizeOf(ptr) else
-    Result := GetVMTPtrOffset(AVMT.fParent);
+    Result := GetVMTPtrOffset(AVMT.fParent^);
 enD;
 
 Function SetVMT(Obj: ptr; AVMT: ptr): Bool;