paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 15:20:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Always use parentfp for forward-declared nested procedures.

Browse Source 
git-svn-id: trunk@45320 -
This commit is contained in:
yury 2020-05-09 17:52:17 +00:00
parent bdabf674e1
commit a316229ef6
4 changed files with 43 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -15199,6 +15199,7 @@ tests/test/tmshlp9.pp svneol=native#text/pascal
tests/test/tmt1.pp svneol=native#text/plain
tests/test/tmul1.pp svneol=native#text/pascal
tests/test/tnest1.pp svneol=native#text/plain
tests/test/tnest2.pp svneol=native#text/plain
tests/test/tnoext1.pp svneol=native#text/plain
tests/test/tnoext2.pp svneol=native#text/plain
tests/test/tnoext3.pp svneol=native#text/plain

3
compiler/ncal.pas
View File

@ -3522,6 +3522,9 @@ implementation
hiddentree:=cloadparentfpnode.create(current_procinfo.procdef,lpf_forpara)
else
internalerror(200309287);
{ Always use parentfp for forward-declared nested procedures }
if (procdefinition.typ=procdef) and not tprocdef(procdefinition).is_implemented then
include(tprocdef(procdefinition).implprocoptions,pio_needs_parentfp);
end
else if not(po_is_block in procdefinition.procoptions) then
hiddentree:=gen_procvar_context_tree_parentfp

8
compiler/symdef.pas
View File

@ -895,6 +895,8 @@ interface
{ returns whether the mangled name or any of its aliases is equal to
s }
function has_alias_name(const s: TSymStr):boolean;
{ Returns true if the implementation part for this procdef has been handled }
function is_implemented: boolean;
{ aliases to fields only required when a function is implemented in
the current unit }
@ -6553,6 +6555,12 @@ implementation
end;
function tprocdef.is_implemented: boolean;
begin
result:=not assigned(implprocdefinfo) or not implprocdefinfo^.forwarddef;
end;
function tprocdef.GetSymtable(t:tGetSymtable):TSymtable;
begin
case t of

31
tests/test/tnest2.pp Normal file
View File

@ -0,0 +1,31 @@
{$mode objfpc}
procedure outer;
procedure nest2(l: longint); forward;
function nest(l: longint): longint;
begin
if l>1 then
result:=nest(l-1)+nest(l-2)
else
begin
result:=1;
nest2(result);
end;
end;
procedure nest2(l: longint);
begin
writeln(l);
end;
begin
if nest(3) <> 3 then
halt(1);
nest2(4);
end;
begin
outer;
end.