* 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/tchlp57.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/tchlp7.pp svneol=native#text/pascal
tests/test/tchlp8.pp svneol=native#text/pascal

View File

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

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.