mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 07:06:08 +02:00
* apply patch by Blaise.ru: proper code generation for assigning class non-static methods, accessed via a class reference type, to method pointers
+ added test
This commit is contained in:
parent
6e7a82440e
commit
bc4eb00a7a
@ -1076,7 +1076,12 @@ implementation
|
||||
else
|
||||
begin
|
||||
typecheckpass(p1);
|
||||
if (p1.resultdef.typ=objectdef) then
|
||||
if (p1.resultdef.typ=classrefdef) and assigned(getprocvardef) then
|
||||
begin
|
||||
p1:=cloadvmtaddrnode.create(p1);
|
||||
tloadnode(p2).set_mp(p1);
|
||||
end
|
||||
else if (p1.resultdef.typ=objectdef) then
|
||||
{ so we can create the correct method pointer again in case
|
||||
this is a "objectprocvar:=@classname.method" expression }
|
||||
tloadnode(p2).symtable:=tobjectdef(p1.resultdef).symtable
|
||||
|
19
tests/test/tprocvar16.pp
Normal file
19
tests/test/tprocvar16.pp
Normal file
@ -0,0 +1,19 @@
|
||||
program tprocvar16;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
type C = class
|
||||
class procedure Foo;
|
||||
end;
|
||||
class procedure C.Foo; begin end;
|
||||
|
||||
type CC = class of C;
|
||||
|
||||
var Z: procedure of object;
|
||||
begin
|
||||
Z := CC.Foo;
|
||||
if TMethod(Z).Code <> @C.Foo then
|
||||
Halt(1);
|
||||
if TMethod(Z).Data <> Pointer(C) then
|
||||
Halt(2);
|
||||
end.
|
Loading…
Reference in New Issue
Block a user