Browse Source

* Always use parentfp for forward-declared nested procedures.

git-svn-id: trunk@45320 -
yury 5 years ago
parent
commit
a316229ef6
4 changed files with 43 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 3 0
      compiler/ncal.pas
  3. 8 0
      compiler/symdef.pas
  4. 31 0
      tests/test/tnest2.pp

+ 1 - 0
.gitattributes

@@ -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 - 0
compiler/ncal.pas

@@ -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 - 0
compiler/symdef.pas

@@ -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 - 0
tests/test/tnest2.pp

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