* fix for Mantis #34239: the parent VMT is an indirect reference due to the changes for dynamic packages for quite some time already, so handle that accordingly

+ added test

git-svn-id: trunk@39715 -

.gitattributes

@@ -16247,6 +16247,7 @@ tests/webtbs/tw3411.pp svneol=native#text/plain
 tests/webtbs/tw34124.pp svneol=native#text/pascal
 tests/webtbs/tw3418.pp svneol=native#text/plain
 tests/webtbs/tw3423.pp svneol=native#text/plain
+tests/webtbs/tw34239.pp svneol=native#text/pascal
 tests/webtbs/tw3429.pp svneol=native#text/plain
 tests/webtbs/tw3433.pp svneol=native#text/plain
 tests/webtbs/tw3435.pp svneol=native#text/plain

packages/rtl-extra/src/inc/objects.pp

@@ -1014,7 +1014,7 @@ TYPE
    PPVMT=^PVMT;
    VMT=RECORD
      Size,NegSize:Longint;
-     ParentLink:PVMT;
+     ParentLink:PPVMT;
    END;
 VAR SP:PPVMT; Q:PVMT;
 BEGIN
@@ -1026,7 +1026,10 @@ BEGIN
        Is_Object:=True;
        Break;
      End;
-     Q:=Q^.Parentlink;
+     IF Q^.Parentlink<>Nil THEN
+       Q:=Q^.Parentlink^
+     ELSE
+       Q:=Nil;
    End;
 END;
 

tests/webtbs/tw34239.pp

@@ -0,0 +1,25 @@
+program tw34239;
+uses
+  objects;
+type
+  PTObj=^TObj;
+  TObj=object(TObject)
+  end;
+  TObj2=object(TObj)
+  end;
+  TSuperObj=object(TObj)
+  end;
+
+var
+  t2:TObj2;
+
+begin
+  t2.init;
+  if not t2.Is_Object(TypeOf(TObj)) then
+    Halt(1);
+  if t2.Is_Object(TypeOf(TSuperObj)) then
+    Halt(2);
+  //writeln(t2.Is_Object(TypeOf(TObj)));
+  //writeln(t2.Is_Object(TypeOf(TSuperObj)));
+  //readln;
+end.