* Reworked tprocdef.is_implemented to fix a bug with the parentfp optimization. The bug was detected when using the llvm backend.

+ Added a test.

git-svn-id: trunk@45675 -

.gitattributes

@@ -15229,6 +15229,7 @@ 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/tnest3.pp svneol=native#text/plain
+tests/test/tnest4.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

compiler/ncal.pas

@@ -3517,11 +3517,10 @@ implementation
                     begin
                       if assigned(procdefinition.owner.defowner) then
                         begin
-                          if paramanager.can_opt_unused_para(currpara) and
-                            (procdefinition<>current_procinfo.procdef) then
-                            { If parentfp is unused by the target proc, create loadparentfpnode which loads 
-                              the current frame pointer to prevent generation of unneeded code. }
-                            hiddentree:=cloadparentfpnode.create(current_procinfo.procdef,lpf_forpara)
+                          if paramanager.can_opt_unused_para(currpara) then
+                            { If parentfp is unused by the target proc, create a dummy
+                              pointerconstnode which will be discarded later. }
+                            hiddentree:=cpointerconstnode.create(0,currpara.vardef)
                           else
                             begin
                               hiddentree:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner),lpf_forpara);

compiler/psub.pas

@@ -2405,6 +2405,7 @@ implementation
 
          { the procedure is now defined }
          procdef.forwarddef:=false;
+         procdef.is_implemented:=true;
 
          if assigned(code) then
            begin

compiler/symdef.pas

@@ -768,6 +768,7 @@ interface
           forwarddef,
           interfacedef : boolean;
           hasforward  : boolean;
+          is_implemented : boolean;
        end;
        pimplprocdefinfo = ^timplprocdefinfo;
 
@@ -813,6 +814,8 @@ interface
          procedure SetIsEmpty(AValue: boolean);
          function GetHasInliningInfo: boolean;
          procedure SetHasInliningInfo(AValue: boolean);
+         function Getis_implemented: boolean;
+         procedure Setis_implemented(AValue: boolean);
          function getparentfpsym: tsym;
        public
           messageinf : tmessageinf;
@@ -897,8 +900,6 @@ 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 }
@@ -938,6 +939,8 @@ interface
           property has_inlininginfo: boolean read GetHasInliningInfo write SetHasInliningInfo;
           { returns the $parentfp parameter for nested routines }
           property parentfpsym: tsym read getparentfpsym;
+          { true if the implementation part for this procdef has been handled }
+          property is_implemented: boolean read Getis_implemented write Setis_implemented;
        end;
        tprocdefclass = class of tprocdef;
 
@@ -5856,6 +5859,20 @@ implementation
       end;
 
 
+    function tprocdef.Getis_implemented: boolean;
+      begin
+        result:=not assigned(implprocdefinfo) or implprocdefinfo^.is_implemented;
+      end;
+
+
+    procedure tprocdef.Setis_implemented(AValue: boolean);
+      begin
+        if not assigned(implprocdefinfo) then
+          internalerror(2020062101);
+        implprocdefinfo^.is_implemented:=AValue;
+      end;
+
+
     function tprocdef.store_localst: boolean;
       begin
         result:=has_inlininginfo or (df_generic in defoptions);
@@ -6580,12 +6597,6 @@ 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

tests/test/tnest4.pp

@@ -0,0 +1,54 @@
+{$mode objfpc}
+
+function test: longint;
+
+  function func(aa: integer): integer;
+
+    function func_nested(b: integer): integer;
+    begin
+      if b < 10 then
+        Result:=func_nested(b+1)
+      else
+        Result:=b;
+      Inc(Result, aa);
+    end;
+
+  begin
+    Result:=func_nested(0);
+  end;
+
+begin
+  result:=func(10);
+end;
+
+function test2: longint;
+var
+  i: integer;
+
+  function func(aa: integer): integer;
+
+    function func_nested(b: integer): integer;
+    begin
+      if b < 10 then
+        Result:=func(b+1)
+      else
+        Result:=b;
+    end;
+
+  begin
+    Result:=func_nested(aa);
+    Inc(Result, i);
+  end;
+
+begin
+  i:=100;
+  result:=func(0);
+end;
+
+begin
+  if test <> 120 then
+    halt(1);
+  if test2 <> 1110 then
+    halt(2);
+  writeln('OK');
+end.