Ver Fonte

* allow a nested function that calls itself can be converted to a function reference
+ added test

Sven/Sarah Barth há 1 ano atrás
pai
commit
ad61db2ff5
2 ficheiros alterados com 134 adições e 28 exclusões
  1. 102 28
      compiler/procdefutil.pas
  2. 32 0
      tests/test/tfuncref55.pp

+ 102 - 28
compiler/procdefutil.pas

@@ -512,9 +512,11 @@ implementation
     end;
 
 
-  function can_be_captured(sym:tsym):boolean;
+  function can_be_captured(sym:tsym;curpd:tprocdef):boolean;
     begin
       result:=false;
+      if (sym.typ=procsym) and assigned(curpd) and (curpd.procsym=sym) then
+        exit(true);
       if not (sym.typ in [localvarsym,paravarsym]) then
         exit;
       if tabstractnormalvarsym(sym).varoptions*[vo_is_result,vo_is_funcret]<>[] then
@@ -565,7 +567,7 @@ implementation
     end;
 
 
-  procedure capture_captured_syms(pd:tprocdef;owner:tprocinfo;capturedef:tobjectdef);
+  procedure capture_captured_syms(pd:tprocdef;owner:tprocinfo;capturedef:tobjectdef;oldpd:tprocdef);
     var
       curpd : tprocdef;
       subcapturer : tobjectdef;
@@ -583,7 +585,8 @@ implementation
       subcapturer:=capturedef;
       symstodo:=tfplist.create;
       for i:=0 to pd.capturedsyms.count-1 do
-        if can_be_captured(pcapturedsyminfo(pd.capturedsyms[i])^.sym) then
+        if can_be_captured(pcapturedsyminfo(pd.capturedsyms[i])^.sym,oldpd) and
+            (pcapturedsyminfo(pd.capturedsyms[i])^.sym.typ<>procsym) then
           symstodo.add(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
       while symstodo.count>0 do
         begin
@@ -630,6 +633,9 @@ implementation
                     internalerror(2022011602);
                   symstodo.delete(i);
                 end
+              else if sym=pd.procsym then
+                { no explicit capturing needed here }
+                symstodo.delete(i)
               else
                 inc(i);
             end;
@@ -852,6 +858,7 @@ implementation
 
     var
       ps : tprocsym;
+      oldpd,
       pd : tprocdef;
       pinested,
       pi : tcgprocinfo;
@@ -875,6 +882,7 @@ implementation
       capturer:=nil;
       capturen:=nil;
       pinested:=nil;
+      oldpd:=nil;
 
       { determine a unique name for the variable, field for function of the
         node we're trying to load }
@@ -905,7 +913,7 @@ implementation
             for i:=0 to capturesyms.count-1 do
               begin
                 captured:=pcapturedsyminfo(capturesyms[i]);
-                if not can_be_captured(captured^.sym) then
+                if not can_be_captured(captured^.sym,pd) then
                   MessagePos1(captured^.fileinfo,sym_e_symbol_no_capture,captured^.sym.realname);
               end;
           if not (df_generic in owner.procdef.defoptions) then
@@ -913,6 +921,7 @@ implementation
               pinested:=find_nested_procinfo(pd);
               if not assigned(pinested) then
                 internalerror(2022041803);
+              oldpd:=pd;
               if pinested.parent<>owner then
                 begin
                   { we need to capture this into the owner of the nested function
@@ -1137,7 +1146,7 @@ implementation
 
       implintf.AddMapping(upcase(result.objrealname^+'.')+method_name_funcref_invoke_find,upcase(invokename));
 
-      capture_captured_syms(pd,owner,capturedef);
+      capture_captured_syms(pd,owner,capturedef,oldpd);
     end;
 
 
@@ -1172,7 +1181,7 @@ implementation
               for i:=0 to pd.capturedsyms.count-1 do
                 begin
                   info:=pcapturedsyminfo(pd.capturedsyms[i]);
-                  if not can_be_captured(info^.sym) then
+                  if not can_be_captured(info^.sym,pd) then
                     MessagePos1(info^.fileinfo,sym_e_symbol_no_capture,info^.sym.realname)
                 end;
             end;
@@ -1239,7 +1248,7 @@ implementation
               for i:=0 to pd.capturedsyms.count-1 do
                 begin
                   info:=pcapturedsyminfo(pd.capturedsyms[i]);
-                  if not can_be_captured(info^.sym) then
+                  if not can_be_captured(info^.sym,pd) then
                     MessagePos1(info^.fileinfo,sym_e_symbol_no_capture,info^.sym.realname)
                   else if info^.sym=selfsym then
                     begin
@@ -1289,7 +1298,7 @@ implementation
         internalerror(2022022201);
       implintf.AddMapping(upcase(result.objrealname^+'.')+method_name_funcref_invoke_find,upcase(invokename));
 
-      capture_captured_syms(pd,owner,capturedef);
+      capture_captured_syms(pd,owner,capturedef,nil);
     end;
 
 
@@ -1448,6 +1457,7 @@ implementation
     tconvert_mapping=record
       oldsym:tsym;
       newsym:tsym;
+      olddef:tdef;
       selfnode:tnode;
     end;
     pconvert_mapping=^tconvert_mapping;
@@ -1460,29 +1470,76 @@ implementation
       i : longint;
       old_filepos : tfileposinfo;
       loadprocvar : boolean;
+      paras,
+      mp : tnode;
+      cnf : tcallnodeflags;
+      paraold,
+      paranew : tcallparanode;
     begin
       result:=fen_true;
-      if n.nodetype<>loadn then
+      if not (n.nodetype in [loadn,calln]) then
         exit;
       for i:=0 to convertarg^.mappings.count-1 do
         begin
           mapping:=convertarg^.mappings[i];
-          if tloadnode(n).symtableentry<>mapping^.oldsym then
-            continue;
-          old_filepos:=current_filepos;
-          current_filepos:=n.fileinfo;
-          loadprocvar:=nf_load_procvar in n.flags;
-          n.free;
-          n:=csubscriptnode.create(mapping^.newsym,mapping^.selfnode.getcopy);
-          if loadprocvar then
-            include(n.flags,nf_load_procvar);
-          if (mapping^.oldsym.typ=paravarsym) and
-              (vo_is_self in tparavarsym(mapping^.oldsym).varoptions) and
-              not is_implicit_pointer_object_type(tparavarsym(mapping^.oldsym).vardef) then
-            n:=cderefnode.create(n);
-          typecheckpass(n);
-          current_filepos:=old_filepos;
-          break;
+          case n.nodetype of
+            loadn:
+              begin
+                if tloadnode(n).symtableentry<>mapping^.oldsym then
+                  continue;
+                old_filepos:=current_filepos;
+                current_filepos:=n.fileinfo;
+                loadprocvar:=nf_load_procvar in n.flags;
+                n.free;
+                n:=csubscriptnode.create(mapping^.newsym,mapping^.selfnode.getcopy);
+                if loadprocvar then
+                  include(n.flags,nf_load_procvar);
+                if (mapping^.oldsym.typ=paravarsym) and
+                    (vo_is_self in tparavarsym(mapping^.oldsym).varoptions) and
+                    not is_implicit_pointer_object_type(tparavarsym(mapping^.oldsym).vardef) then
+                  n:=cderefnode.create(n);
+                typecheckpass(n);
+                current_filepos:=old_filepos;
+                break;
+              end;
+            calln:
+              begin
+                if mapping^.oldsym.typ<>procsym then
+                  continue;
+                if tcallnode(n).symtableprocentry<>tprocsym(mapping^.oldsym) then
+                  continue;
+                if tcallnode(n).procdefinition<>tprocdef(mapping^.olddef) then
+                  continue;
+                old_filepos:=current_filepos;
+                current_filepos:=n.fileinfo;
+                loadprocvar:=nf_load_procvar in n.flags;
+                paras:=tcallnode(n).left;
+                paraold:=tcallparanode(paras);
+                paranew:=nil;
+                while assigned(paraold) do
+                  begin
+                    if not (vo_is_hidden_para in paraold.parasym.varoptions) then
+                      begin
+                        paranew:=ccallparanode.create(paraold.left,paranew);
+                        paraold.left:=nil;
+                      end;
+                    paraold:=tcallparanode(paraold.right);
+                  end;
+                reverseparameters(paranew);
+                if assigned(tcallnode(n).methodpointer) then
+                  internalerror(2023120802);
+                cnf:=tcallnode(n).callnodeflags;
+                n.free;
+                n:=ccallnode.create(paranew,tprocsym(mapping^.newsym),mapping^.newsym.owner,mapping^.selfnode.getcopy,cnf,nil);
+                if loadprocvar then
+                  include(n.flags,nf_load_procvar);
+                typecheckpass(n);
+                current_filepos:=old_filepos;
+                break;
+              end;
+            else
+              internalerror(2023120801);
+          end;
         end;
     end;
 
@@ -1540,12 +1597,26 @@ implementation
           for i:=0 to pd.capturedsyms.count-1 do
             begin
               sym:=tsym(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
-              if not can_be_captured(sym) then
+              if not can_be_captured(sym,pd) and
+                  not (
+                    (sym.typ=procsym) and
+                    assigned(pd.copied_from) and
+                    (pd.copied_from.procsym=sym)
+                  ) then
                 continue;
               {$ifdef DEBUG_CAPTURER}writeln('Replacing symbol ',sym.Name);{$endif}
               new(mapping);
               mapping^.oldsym:=sym;
-              mapping^.newsym:=tabstractnormalvarsym(sym).capture_sym;
+              if sym.typ=procsym then
+                begin
+                  if not assigned(pd.copied_from) or
+                      (pd.copied_from.procsym<>sym) then
+                    internalerror(2023123001);
+                  mapping^.newsym:=pd.procsym;
+                end
+              else
+                mapping^.newsym:=tabstractnormalvarsym(sym).capture_sym;
+              mapping^.olddef:=pcapturedsyminfo(pd.capturedsyms[i])^.def;
               if not assigned(mapping^.newsym) then
                 internalerror(2022010810);
               mapping^.selfnode:=self_tree_for_sym(selfsym,mapping^.newsym);
@@ -1569,12 +1640,15 @@ implementation
           for i:=0 to pd.capturedsyms.count-1 do
             begin
               sym:=tsym(pcapturedsyminfo(pd.capturedsyms[i])^.sym);
-              if not can_be_captured(sym) or not assigned(tabstractnormalvarsym(sym).capture_sym) then
+              if not can_be_captured(sym,pd) or
+                  (sym.typ=procsym) or
+                  not assigned(tabstractnormalvarsym(sym).capture_sym) then
                 continue;
               {$ifdef DEBUG_CAPTURER}writeln('Replacing symbol ',sym.Name);{$endif}
               new(mapping);
               mapping^.oldsym:=sym;
               mapping^.newsym:=tabstractnormalvarsym(sym).capture_sym;
+              mapping^.olddef:=pcapturedsyminfo(pd.capturedsyms[i])^.def;
               capturer:=tobjectdef(mapping^.newsym.owner.defowner);
               if not is_class(capturer) then
                 internalerror(2022012701);

+ 32 - 0
tests/test/tfuncref55.pp

@@ -0,0 +1,32 @@
+program tfuncref55;
+
+{$mode objfpc}
+{$modeswitch functionreferences}
+
+procedure Test;
+var
+  a: Char;
+
+  function DoTest(aArg: LongInt): String;
+  begin
+    if aArg > 0 then
+      Result := DoTest(aArg - 1) + a
+    else
+      Result := a;
+  end;
+
+var
+  func: reference to function(aArg: LongInt): String;
+begin
+  a := 'a';
+  func := @DoTest;
+  if func(4) <> 'aaaaa' then
+    Halt(1);
+  a := 'b';
+  if func(6) <> 'bbbbbbb' then
+    Halt(2);
+end;
+
+begin
+  Test;
+end.