DCC allows the subj (provided that the class type is known at compile time), FPC does not.
The attached init_methptr_with_classmeth.patch implements this feature. -------8<------- type C = class class procedure Foo; end; class procedure C.Foo; begin end; type CC = class of C; type H = class helper for C end; type T = procedure of object; //var aC: C = nil; //var aCC: CC = nil; // Still rejected: //var ViaInstance: T = aC.Foo; //var ViaClassRef: T = aCC.Foo; const ViaClass: T = C.Foo; // NB: This needs metaclass_meth_to_procvar-2.patch // from https://lists.freepascal.org/pipermail/fpc-devel/2021-December/044249.html // Otherwise: AV in FPC var ViaMetaclass: T = CC.Foo; // TODO: Currently, ICE 2021122302 -- needs to be fixed elsewhere. // See https://lists.freepascal.org/pipermail/fpc-devel/2021-December/044251.html //var ViaHelper: T = H.Foo; procedure Report(const s: string; const X: T); var Status: Boolean; begin Status := (TMethod(X).Code = @C.Foo) and (TMethod(X).Data = Pointer(C)); writeln(s, ': ', Status) end; begin Report('via class', ViaClass); Report('via metaclass', ViaMetaclass) end. -------8<------- Proposed new error message for parser_e_no_procvarobj_const: Cannot initialize a method pointer: Self pointer is not known at compile time In order to initialize a method pointer with a method, the value of the Self pointer for calling that method at run time must be known at compile time. Thus, a method pointer can be initialized either with NIL, or with a class method that is accessed via a class type or a class reference type. -- βþ
# HG changeset patch # User Blaise.ru # Date 1640264248 -10800 # Thu Dec 23 15:57:28 2021 +0300 + allow initialisation of method pointers with class methods (when class types are known at compile time) diff -r d8747975e106 -r e77bf4543d51 ngtcon.pas --- a/ngtcon.pas Wed Dec 22 08:12:51 2021 +0300 +++ b/ngtcon.pas Thu Dec 23 15:57:28 2021 +0300 @@ -1455,6 +1455,8 @@ procaddrdef: tprocvardef; havepd, haveblock: boolean; + selfnode: tnode; + selfdef: tdef; begin { Procvars and pointers are no longer compatible. } { under tp: =nil or =var under fpc: =nil or =@var } @@ -1469,12 +1471,6 @@ ftcb.maybe_end_aggregate(def); exit; end; - { you can't assign a value other than NIL to a typed constant } - { which is a "procedure of object", because this also requires } - { address of an object/class instance, which is not known at } - { compile time (JM) } - if (po_methodpointer in def.procoptions) then - Message(parser_e_no_procvarobj_const); { parse the rest too, so we can continue with error checking } getprocvardef:=def; n:=comp_expr([ef_accept_equal]); @@ -1540,10 +1536,35 @@ begin ftcb.queue_emit_staticvar(tstaticvarsym(tloadnode(n).symtableentry)); end; + { the Data field of a method pointer can be initialised + either with NIL (handled above) or with a class type } + if po_methodpointer in def.procoptions then + begin + selfnode:=tloadnode(n).left; + { TODO: Happens for helpers. Needs to be fixed elsewhere. + See https://lists.freepascal.org/pipermail/fpc-devel/2021-December/044251.html } + if selfnode = nil then + internalerror(2021122302); + { class type must be known at compile time } + if (selfnode.nodetype=loadvmtaddrn) + and (tloadvmtaddrnode(selfnode).left.nodetype=typen) + then + begin + selfdef:=selfnode.resultdef; + if selfdef.typ<>classrefdef then + internalerror(2021122301); + selfdef:=tclassrefdef(selfdef).pointeddef; + ftcb.emit_tai(Tai_const.Create_sym( + current_asmdata.RefAsmSymbol(tobjectdef(selfdef).vmt_mangledname,AT_DATA)), + def); + end + else + Message(parser_e_no_procvarobj_const); + end { nested procvar typed consts can only be initialised with nil (checked above) or with a global procedure (checked here), because in other cases we need a valid frame pointer } - if is_nested_pd(def) then + else if is_nested_pd(def) then begin if haveblock or is_nested_pd(pd) then
_______________________________________________ fpc-devel maillist - fpc-devel@lists.freepascal.org https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel