mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-06 09:49:27 +01:00
* class helpers: fix calling virtual methods of the extended type using inherited
git-svn-id: trunk@37060 -
This commit is contained in:
parent
597cf52a3a
commit
6acba684d4
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||||
|
|||||||
@ -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
40
tests/test/tchlp59.pp
Normal 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.
|
||||||
Loading…
Reference in New Issue
Block a user