1) The attached metaclass_meth_to_procvar-1.patch fixes the internal error
reported for:
[ICE] Assigning class methods, accessed via a class reference type, to
incompatible procvars
-------8<-------
type C = class
class procedure NonStatic;
class procedure Static; static;
end;
class procedure C.NonStatic; begin end;
class procedure C.Static; begin end;
type CC = class of C;
var IncompatWNonStatic: procedure;
var IncompatWStatic: procedure of object;
begin
IncompatWNonStatic := CC.NonStatic; // ICE 200301042
IncompatWStatic := CC.Static // ICE 200301042
end.
-------8<-------
2) The attached metaclass_meth_to_procvar-2.patch fixes the invalid codegen
produced for:
[BadCG] Assigning class non-static methods, accessed via a class reference
type, to method pointers
-------8<-------
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;
writeln( TMethod(Z).Code = @C.Foo ); // "FALSE"
writeln( TMethod(Z).Data = Pointer(C) ); // "FALSE"
end.
-------8<-------
--
βþ
# HG changeset patch
# User Blaise.ru
# Date 1640147566 -10800
# Wed Dec 22 07:32:46 2021 +0300
! avoid ICE when assigning class methods, accessed via a class reference type,
to incompatible procvars
diff -r d880e6695537 -r 250d0d636843 ncnv.pas
--- a/ncnv.pas Mon Dec 20 20:55:22 2021 +0300
+++ b/ncnv.pas Wed Dec 22 07:32:46 2021 +0300
@@ -2494,6 +2494,7 @@
aprocdef : tprocdef;
eq : tequaltype;
cdoptions : tcompare_defs_options;
+ selfnode: tnode;
newblock: tblocknode;
newstatement: tstatementnode;
tempnode: ttempcreatenode;
@@ -2657,8 +2658,13 @@
tprocdef(currprocdef),tcallnode(left).symtableproc);
if
(tcallnode(left).symtableprocentry.owner.symtabletype=ObjectSymtable) then
begin
- if assigned(tcallnode(left).methodpointer) then
-
tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy)
+ selfnode:=tcallnode(left).methodpointer;
+ if assigned(selfnode) then
+ begin
+ if selfnode.nodetype<>typen then
+ tloadnode(hp).set_mp(selfnode.getcopy)
+ // else: TODO: #BUGREPORT/TESTCASE
+ end
else
tloadnode(hp).set_mp(load_self_node);
end;
# HG changeset patch
# User Blaise.ru
# Date 1640149971 -10800
# Wed Dec 22 08:12:51 2021 +0300
! proper codegen for assigning class non-static methods, accessed via a class
reference type, to method pointers
diff -r 250d0d636843 -r 31521fdb081e pexpr.pas
--- a/pexpr.pas Wed Dec 22 07:32:46 2021 +0300
+++ b/pexpr.pas Wed Dec 22 08:12:51 2021 +0300
@@ -1076,7 +1076,13 @@
else
begin
typecheckpass(p1);
- if (p1.resultdef.typ=objectdef) then
+ // TODO: #BUGREPORT/TESTCASE
+ 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
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
