paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 21:07:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

* 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

Browse Source 
+ added test

git-svn-id: trunk@39715 -
This commit is contained in:
svenbarth 2018-09-08 14:56:09 +00:00
parent 4b227de02e
commit 00663728b5
3 changed files with 31 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

7
packages/rtl-extra/src/inc/objects.pp
View File

@ -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;

25
tests/webtbs/tw34239.pp Normal file
View File

@ -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.