From ad61db2ff592ee455738b159dc415970e76adca1 Mon Sep 17 00:00:00 2001 From: Sven/Sarah Barth Date: Sat, 30 Dec 2023 14:47:38 +0100 Subject: [PATCH] * allow a nested function that calls itself can be converted to a function reference + added test --- compiler/procdefutil.pas | 130 ++++++++++++++++++++++++++++++--------- tests/test/tfuncref55.pp | 32 ++++++++++ 2 files changed, 134 insertions(+), 28 deletions(-) create mode 100644 tests/test/tfuncref55.pp diff --git a/compiler/procdefutil.pas b/compiler/procdefutil.pas index ce0909d8fd..ee086aaab5 100644 --- a/compiler/procdefutil.pas +++ b/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); diff --git a/tests/test/tfuncref55.pp b/tests/test/tfuncref55.pp new file mode 100644 index 0000000000..905811f897 --- /dev/null +++ b/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.