From e63c03125a8b066638cec8593d96eb8eb38ed3d9 Mon Sep 17 00:00:00 2001
From: yury <jura@cp-lab.com>
Date: Sun, 21 Jun 2020 19:52:14 +0000
Subject: [PATCH] * 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 | 1 +
compiler/ncal.pas | 9 ++++----
compiler/psub.pas | 1 +
compiler/symdef.pas | 27 +++++++++++++++-------
tests/test/tnest4.pp | 54 ++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 79 insertions(+), 13 deletions(-)
create mode 100644 tests/test/tnest4.pp
diff --git a/.gitattributes b/.gitattributes
index 3f63ba7163..bd738ebffb 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 1e495e4449..f9aa7588a5 100644
--- a/compiler/ncal.pas
+++ b/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);
diff --git a/compiler/psub.pas b/compiler/psub.pas
index fee63b249c..62372a2c89 100644
--- a/compiler/psub.pas
+++ b/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
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 8f456ad585..0c9bcb6587 100644
--- a/compiler/symdef.pas
+++ b/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
diff --git a/tests/test/tnest4.pp b/tests/test/tnest4.pp
new file mode 100644
index 0000000000..164c7ead9c
--- /dev/null
+++ b/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.