mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 11:38:19 +02:00
* allow a nested function that calls itself can be converted to a function reference
+ added test
This commit is contained in:
Sven/Sarah Barth
parent
1853d1ddd8
commit
ad61db2ff5
@ -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
tests/test/tfuncref55.pp
Normal file
32
tests/test/tfuncref55.pp
Normal 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.
|
||||
Loading…
Reference in New Issue
Block a user