mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-24 13:09:17 +02:00
* fixed calling inherited class methods from a regular method (mantis
#11825) git-svn-id: trunk@12810 -
This commit is contained in:
parent
1dfded8887
commit
5474004dcc
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8703,6 +8703,7 @@ tests/webtbs/tw11762.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw11763.pp svneol=native#text/plain
|
tests/webtbs/tw11763.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11786.pp svneol=native#text/plain
|
tests/webtbs/tw11786.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw1181.pp svneol=native#text/plain
|
tests/webtbs/tw1181.pp svneol=native#text/plain
|
||||||
|
tests/webtbs/tw11825.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11846a.pp svneol=native#text/plain
|
tests/webtbs/tw11846a.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11846b.pp svneol=native#text/plain
|
tests/webtbs/tw11846b.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw11848.pp svneol=native#text/plain
|
tests/webtbs/tw11848.pp svneol=native#text/plain
|
||||||
|
@ -1469,7 +1469,15 @@ implementation
|
|||||||
|
|
||||||
{ inherited }
|
{ inherited }
|
||||||
if (cnf_inherited in callnodeflags) then
|
if (cnf_inherited in callnodeflags) then
|
||||||
selftree:=load_self_node
|
begin
|
||||||
|
selftree:=load_self_node;
|
||||||
|
{ we can call an inherited class static/method from a regular method
|
||||||
|
-> self node must change from instance pointer to vmt pointer)
|
||||||
|
}
|
||||||
|
if (procdefinition.procoptions*[po_classmethod,po_staticmethod] <> []) and
|
||||||
|
(selftree.resultdef.typ<>classrefdef) then
|
||||||
|
selftree:=cloadvmtaddrnode.create(selftree);
|
||||||
|
end
|
||||||
else
|
else
|
||||||
{ constructors }
|
{ constructors }
|
||||||
if (procdefinition.proctypeoption=potype_constructor) then
|
if (procdefinition.proctypeoption=potype_constructor) then
|
||||||
|
54
tests/webtbs/tw11825.pp
Normal file
54
tests/webtbs/tw11825.pp
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
{$MODE objfpc}
|
||||||
|
|
||||||
|
program bug7;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMyObj = class;
|
||||||
|
TMyObjClass = class of TMyObj;
|
||||||
|
|
||||||
|
TMyObj = class(TObject)
|
||||||
|
function ClassType: TMyObjClass; reintroduce;
|
||||||
|
class function test: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TMyObj2 = class(TMyObj)
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
var O: TObject;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function TMyObj.ClassType: TMyObjClass;
|
||||||
|
begin
|
||||||
|
Result := TMyObjClass(inherited ClassType);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function tmyobj.test: string;
|
||||||
|
begin
|
||||||
|
result:=inherited classname;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetObj: TObject;
|
||||||
|
begin
|
||||||
|
Result := O
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetMyObj: TMyObj;
|
||||||
|
begin
|
||||||
|
Result:= TMyObj(GetObj)
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
begin
|
||||||
|
O := TMyObj2.Create;
|
||||||
|
WriteLn(GetMyObj.ClassName);
|
||||||
|
WriteLn(GetMyObj.ClassType.ClassName);
|
||||||
|
if (GetMyObj.ClassName<>'TMyObj2') or
|
||||||
|
(GetMyObj.ClassType.ClassName<>'TMyObj2') then
|
||||||
|
halt(1);
|
||||||
|
writeln(tmyobj.test);
|
||||||
|
if (tmyobj.test<>'TMyObj') then
|
||||||
|
halt(2);
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user