瀏覽代碼

* Always use parentfp for forward-declared nested procedures.

git-svn-id: trunk@45320 -
yury 5 年之前
父節點
當前提交
a316229ef6
共有 4 個文件被更改,包括 43 次插入0 次删除
  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/tmt1.pp svneol=native#text/plain
 tests/test/tmul1.pp svneol=native#text/pascal
 tests/test/tmul1.pp svneol=native#text/pascal
 tests/test/tnest1.pp svneol=native#text/plain
 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/tnoext1.pp svneol=native#text/plain
 tests/test/tnoext2.pp svneol=native#text/plain
 tests/test/tnoext2.pp svneol=native#text/plain
 tests/test/tnoext3.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)
                         hiddentree:=cloadparentfpnode.create(current_procinfo.procdef,lpf_forpara)
                       else
                       else
                         internalerror(200309287);
                         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
                     end
                   else if not(po_is_block in procdefinition.procoptions) then
                   else if not(po_is_block in procdefinition.procoptions) then
                     hiddentree:=gen_procvar_context_tree_parentfp
                     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
           { returns whether the mangled name or any of its aliases is equal to
             s }
             s }
           function  has_alias_name(const s: TSymStr):boolean;
           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
           { aliases to fields only required when a function is implemented in
             the current unit }
             the current unit }
@@ -6553,6 +6555,12 @@ implementation
       end;
       end;
 
 
 
 
+    function tprocdef.is_implemented: boolean;
+    begin
+      result:=not assigned(implprocdefinfo) or not implprocdefinfo^.forwarddef;
+    end;
+
+
     function tprocdef.GetSymtable(t:tGetSymtable):TSymtable;
     function tprocdef.GetSymtable(t:tGetSymtable):TSymtable;
       begin
       begin
         case t of
         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.