paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 11:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
+ added test
This commit is contained in:
Sven/Sarah Barth 2023-12-30 14:47:38 +01:00
parent 1853d1ddd8
commit ad61db2ff5
2 changed files with 134 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
compiler/procdefutil.pas
View File

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

32
tests/test/tfuncref55.pp Normal file
View File

@ -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.