* class helpers: fix calling virtual methods of the extended type using inherited

git-svn-id: trunk@37060 -
This commit is contained in:
svenbarth 2017-08-25 19:36:56 +00:00
parent 597cf52a3a
commit 6acba684d4
3 changed files with 61 additions and 5 deletions

1
.gitattributes vendored
View File

@ -12466,6 +12466,7 @@ tests/test/tchlp55.pp svneol=native#text/pascal
tests/test/tchlp56.pp svneol=native#text/pascal tests/test/tchlp56.pp svneol=native#text/pascal
tests/test/tchlp57.pp svneol=native#text/pascal tests/test/tchlp57.pp svneol=native#text/pascal
tests/test/tchlp58.pp svneol=native#text/pascal tests/test/tchlp58.pp svneol=native#text/pascal
tests/test/tchlp59.pp svneol=native#text/pascal
tests/test/tchlp6.pp svneol=native#text/pascal tests/test/tchlp6.pp svneol=native#text/pascal
tests/test/tchlp7.pp svneol=native#text/pascal tests/test/tchlp7.pp svneol=native#text/pascal
tests/test/tchlp8.pp svneol=native#text/pascal tests/test/tchlp8.pp svneol=native#text/pascal

View File

@ -3355,6 +3355,7 @@ implementation
filepos : tfileposinfo; filepos : tfileposinfo;
callflags : tcallnodeflags; callflags : tcallnodeflags;
idstr : tidstring; idstr : tidstring;
useself,
dopostfix, dopostfix,
again, again,
updatefpos, updatefpos,
@ -3513,6 +3514,7 @@ implementation
case srsym.typ of case srsym.typ of
procsym: procsym:
begin begin
useself:=false;
if is_objectpascal_helper(current_structdef) then if is_objectpascal_helper(current_structdef) then
begin begin
{ for a helper load the procdef either from the { for a helper load the procdef either from the
@ -3526,19 +3528,32 @@ implementation
assigned(tobjectdef(current_structdef).childof) then assigned(tobjectdef(current_structdef).childof) then
hdef:=tobjectdef(current_structdef).childof hdef:=tobjectdef(current_structdef).childof
else else
hdef:=tobjectdef(srsym.Owner.defowner).extendeddef begin
hdef:=tobjectdef(srsym.Owner.defowner).extendeddef;
useself:=true;
end
else else
begin
hdef:=tdef(srsym.Owner.defowner); hdef:=tdef(srsym.Owner.defowner);
useself:=true;
end;
end end
else else
hdef:=hclassdef; hdef:=hclassdef;
if (po_classmethod in current_procinfo.procdef.procoptions) or if (po_classmethod in current_procinfo.procdef.procoptions) or
(po_staticmethod in current_procinfo.procdef.procoptions) then (po_staticmethod in current_procinfo.procdef.procoptions) then
hdef:=cclassrefdef.create(hdef); hdef:=cclassrefdef.create(hdef);
if useself then
begin
p1:=ctypeconvnode.create_internal(load_self_node,hdef);
end
else
begin
p1:=ctypenode.create(hdef); p1:=ctypenode.create(hdef);
{ we need to allow helpers here } { we need to allow helpers here }
ttypenode(p1).helperallowed:=true; ttypenode(p1).helperallowed:=true;
end; end;
end;
propertysym: propertysym:
; ;
else else

40
tests/test/tchlp59.pp Normal file
View File

@ -0,0 +1,40 @@
program tchlp42;
{$mode objfpc}
type
TTest = class
function Test: LongInt; virtual;
end;
TTestSub = class(TTest)
function Test: LongInt; override;
end;
TTestHelper = class helper for TTest
function Test: LongInt;
end;
function TTestHelper.Test: LongInt;
begin
Result := inherited Test * 10;
end;
function TTestSub.Test: LongInt;
begin
Result := 2;
end;
function TTest.Test: LongInt;
begin
Result := 1;
end;
var
t: TTest;
begin
t := TTestSub.Create;
if t.Test <> 20 then
Halt(1);
Writeln('ok');
end.