* implement necessary conversion functionality for anonymous procdefs to function reference interfaces including capturing of variables

compiler/defcmp.pas

@@ -108,7 +108,8 @@ interface
           tc_array_2_dynarray,
           tc_elem_2_openarray,
           tc_arrayconstructor_2_dynarray,
-          tc_arrayconstructor_2_array
+          tc_arrayconstructor_2_array,
+          tc_anonproc_2_funcref
        );
 
     function compare_defs_ext(def_from,def_to : tdef;
@@ -203,6 +204,9 @@ implementation
       end;
 
 
+    function proc_to_funcref_conv(def1:tabstractprocdef;def2:tobjectdef):tequaltype;forward;
+
+
     function compare_defs_ext(def_from,def_to : tdef;
                               fromtreetype : tnodetype;
                               var doconv : tconverttype;
@@ -1867,6 +1871,20 @@ implementation
                    doconv:=tc_char_2_string;
                    eq:=te_convert_l2
                  end
+               else if is_funcref(def_to) and
+                   (def_from.typ=procdef) and
+                   (po_anonymous in tprocdef(def_from).procoptions) then
+                 begin
+                   subeq:=proc_to_funcref_conv(tprocdef(def_from),tobjectdef(def_to));
+                   if subeq>te_incompatible then
+                     begin
+                       doconv:=tc_anonproc_2_funcref;
+                       if subeq>te_convert_l5 then
+                         eq:=pred(subeq)
+                       else
+                         eq:=subeq;
+                     end;
+                 end
                else if is_funcref(def_to) and
                    is_funcref(def_from) and
                    not (cdo_equal_check in cdoptions) then
@@ -2507,6 +2525,7 @@ implementation
         po_comp: tprocoptions;
         pa_comp: tcompare_paras_options;
         captured : tfplist;
+        dstisfuncref : boolean;
       begin
          proc_to_procvar_equal_internal:=te_incompatible;
          if not(assigned(def1)) or not(assigned(def2)) then
@@ -2590,19 +2609,27 @@ implementation
                     if def1.typ<>procdef then
                       internalerror(2021052602);
                     captured:=tprocdef(def1).capturedsyms;
+                    { a function reference can capture anything, but they're
+                      rather expensive, so cheaper overloads are preferred }
+                    dstisfuncref:=assigned(def2.owner) and
+                        assigned(def2.owner.defowner) and
+                        is_funcref(tdef(def2.owner.defowner));
                     { if no symbol was captured an anonymous function is
-                      compatible to all three types of function pointers, but we
+                      compatible to all four types of function pointers, but we
                       might need to generate its code differently (e.g. get rid
                       of parentfp parameter for global functions); the order for
                       this is:
                         - procedure variable
                         - method variable
+                        - function reference
                         - nested procvar }
                     if not assigned(captured) or (captured.count=0) then
                       begin
                         if po_methodpointer in def2.procoptions then
                           eq:=te_convert_l2
                         else if po_delphi_nested_cc in def2.procoptions then
+                          eq:=te_convert_l4
+                        else if dstisfuncref then
                           eq:=te_convert_l3
                         else
                           eq:=te_convert_l1
@@ -2611,21 +2638,27 @@ implementation
                       compatible to normal function pointers; the order for this
                       is:
                         - method variable
+                        - function reference
                         - nested function }
                     else if (captured.count=1) and (vo_is_self in tabstractvarsym(pcapturedsyminfo(captured[0])^.sym).varoptions) then
                       begin
                         if po_methodpointer in def2.procoptions then
                           eq:=te_convert_l1
                         else if po_delphi_nested_cc in def2.procoptions then
+                          eq:=te_convert_l3
+                        else if dstisfuncref then
                           eq:=te_convert_l2
                         else
                           eq:=te_incompatible;
                       end
-                    { otherwise it's compatible to nested function pointers only }
+                    { otherwise it's compatible to nested function pointers and
+                      function references }
                     else
                       begin
-                        if po_delphi_nested_cc in def2.procoptions then
+                        if dstisfuncref then
                           eq:=te_convert_l1
+                        else if po_delphi_nested_cc in def2.procoptions then
+                          eq:=te_convert_l2
                         else
                           eq:=te_incompatible;
                       end;
@@ -2642,7 +2675,7 @@ implementation
       end;
 
 
-    function proc_to_funcref_equal(def1:tabstractprocdef;def2:tobjectdef):tequaltype;
+    function proc_to_funcref_conv(def1:tabstractprocdef;def2:tobjectdef):tequaltype;
       var
         invoke : tprocdef;
       begin
@@ -2653,6 +2686,12 @@ implementation
           internalerror(2022011601);
         invoke:=get_invoke_procdef(def2);
         result:=proc_to_procvar_equal_internal(def1,invoke,false,true);
+      end;
+
+
+    function proc_to_funcref_equal(def1:tabstractprocdef;def2:tobjectdef):tequaltype;
+      begin
+        result:=proc_to_funcref_conv(def1,def2);
         { as long as the two methods are considered convertible we consider the
           procdef and the function reference as equal }
         if result>te_convert_operator then

compiler/ncnv.pas

@@ -120,6 +120,7 @@ interface
           function typecheck_elem_2_openarray : tnode; virtual;
           function typecheck_arrayconstructor_to_dynarray : tnode; virtual;
           function typecheck_arrayconstructor_to_array : tnode; virtual;
+          function typecheck_anonproc_2_funcref : tnode; virtual;
        private
           function _typecheck_int_to_int : tnode;
           function _typecheck_cord_to_pointer : tnode;
@@ -153,6 +154,7 @@ interface
           function _typecheck_elem_2_openarray : tnode;
           function _typecheck_arrayconstructor_to_dynarray : tnode;
           function _typecheck_arrayconstructor_to_array : tnode;
+          function _typecheck_anonproc_to_funcref : tnode;
        protected
           function first_int_to_int : tnode;virtual;
           function first_cstring_to_pchar : tnode;virtual;
@@ -325,7 +327,7 @@ implementation
       ncon,ncal,nset,nadd,nmem,nmat,nbas,nutils,ninl,nflw,
       psub,
       cgbase,procinfo,
-      htypechk,blockutl,pparautl,pass_1,cpuinfo;
+      htypechk,blockutl,pparautl,procdefutil,pass_1,cpuinfo;
 
 
 {*****************************************************************************
@@ -2344,6 +2346,12 @@ implementation
       end;
 
 
+    function ttypeconvnode._typecheck_anonproc_to_funcref : tnode;
+      begin
+        result:=typecheck_anonproc_2_funcref;
+      end;
+
+
     function ttypeconvnode.target_specific_general_typeconv: boolean;
       begin
         result:=false;
@@ -2639,6 +2647,30 @@ implementation
       end;
 
 
+    function ttypeconvnode.typecheck_anonproc_2_funcref : tnode;
+      var
+        capturer : tsym;
+        intfdef : tdef;
+        ldnode : tnode;
+      begin
+        intfdef:=capturer_add_anonymous_proc(current_procinfo,tprocdef(left.resultdef),capturer);
+        if assigned(intfdef) then
+          begin
+            if assigned(capturer) then
+              ldnode:=cloadnode.create(capturer,capturer.owner)
+            else
+              ldnode:=cnilnode.create;
+            result:=ctypeconvnode.create_internal(
+                      ctypeconvnode.create_internal(
+                        ldnode,
+                        intfdef),
+                      totypedef);
+          end
+        else
+          result:=cerrornode.create;
+      end;
+
+
     function ttypeconvnode.typecheck_call_helper(c : tconverttype) : tnode;
       const
          resultdefconvert : array[tconverttype] of pointer = (
@@ -2684,7 +2716,8 @@ implementation
           { array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
           { elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray,
           { arrayconstructor_2_dynarray } @ttypeconvnode._typecheck_arrayconstructor_to_dynarray,
-          { arrayconstructor_2_array } @ttypeconvnode._typecheck_arrayconstructor_to_array
+          { arrayconstructor_2_array } @ttypeconvnode._typecheck_arrayconstructor_to_array,
+          { anonproc_2_funcref } @ttypeconvnode._typecheck_anonproc_to_funcref
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -4392,7 +4425,8 @@ implementation
            nil,
            @ttypeconvnode._first_nothing,
            @ttypeconvnode._first_nothing,
-           @ttypeconvnode._first_nothing
+           @ttypeconvnode._first_nothing,
+           nil
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -4673,7 +4707,8 @@ implementation
            @ttypeconvnode._second_nothing,  { array_2_dynarray }
            @ttypeconvnode._second_elem_to_openarray,  { elem_2_openarray }
            @ttypeconvnode._second_nothing,  { arrayconstructor_2_dynarray }
-           @ttypeconvnode._second_nothing   { arrayconstructor_2_array }
+           @ttypeconvnode._second_nothing,  { arrayconstructor_2_array }
+           @ttypeconvnode._second_nothing   { anonproc_2_funcref }
          );
       type
          tprocedureofobject = procedure of object;