From: Eric Botcazou <ebotca...@adacore.com>
The current code has relied on Original_Node to detect rewritten function
calls in object declarations but that's not robust enough in the presence
of function calls written in object notation.
gcc/ada/
* exp_util.ads (Is_Captured_Function_Call): Declare.
* exp_util.adb (Is_Captured_Function_Call): New predicate.
* exp_ch3.adb (Expand_N_Object_Declaration): Use it to detect a
rewritten function call as the initializing expression.
* exp_ch6.adb (Expand_Simple_Function_Return): Use it to detect a
rewritten function call as the returned expression.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch3.adb | 10 ++++------
gcc/ada/exp_ch6.adb | 6 +-----
gcc/ada/exp_util.adb | 24 ++++++++++++++++++++++++
gcc/ada/exp_util.ads | 8 ++++++++
4 files changed, 37 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 6de5843b4ba..def63ed0513 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7901,18 +7901,16 @@ package body Exp_Ch3 is
-- secondary stack, then the declaration can be rewritten as
-- the renaming of this dereference:
- -- type Axx is access all Typ;
- -- Rxx : constant Axx := Func (...)'reference;
- -- Obj : Typ renames Rxx.all;
+ -- type Ann is access all Typ;
+ -- Rnn : constant Axx := Func (...)'reference;
+ -- Obj : Typ renames Rnn.all;
-- This avoids an extra copy and, in the case where Typ needs
-- finalization, a pair of Adjust/Finalize calls (see below).
and then
((not Is_Library_Level_Entity (Def_Id)
- and then Nkind (Expr_Q) = N_Explicit_Dereference
- and then not Comes_From_Source (Expr_Q)
- and then Nkind (Original_Node (Expr_Q)) = N_Function_Call
+ and then Is_Captured_Function_Call (Expr_Q)
and then not Is_Class_Wide_Type (Typ))
-- If the initializing expression is a variable with the
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index c026b63fcf6..0bc2559751b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6440,11 +6440,7 @@ package body Exp_Ch6 is
pragma Assert (Present (Exp));
Exp_Is_Function_Call : constant Boolean :=
- Nkind (Exp) = N_Function_Call
- or else (Nkind (Exp) = N_Explicit_Dereference
- and then Is_Entity_Name (Prefix (Exp))
- and then Ekind (Entity (Prefix (Exp))) = E_Constant
- and then Is_Related_To_Func_Return (Entity (Prefix (Exp))));
+ Nkind (Exp) = N_Function_Call or else Is_Captured_Function_Call (Exp);
Exp_Typ : constant Entity_Id := Etype (Exp);
-- The type of the expression (not necessarily the same as R_Type)
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 5ab0d3039ca..3c68f917ca9 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8160,6 +8160,30 @@ package body Exp_Util is
end if;
end Integer_Type_For;
+ -------------------------------
+ -- Is_Captured_Function_Call --
+ -------------------------------
+
+ function Is_Captured_Function_Call (N : Node_Id) return Boolean is
+ begin
+ if Nkind (N) = N_Explicit_Dereference
+ and then Is_Entity_Name (Prefix (N))
+ and then Ekind (Entity (Prefix (N))) = E_Constant
+ then
+ declare
+ Value : constant Node_Id := Constant_Value (Entity (Prefix (N)));
+
+ begin
+ return Present (Value)
+ and then Nkind (Value) = N_Reference
+ and then Nkind (Prefix (Value)) = N_Function_Call;
+ end;
+
+ else
+ return False;
+ end if;
+ end Is_Captured_Function_Call;
+
--------------------------------------------------
-- Is_Displacement_Of_Object_Or_Function_Result --
--------------------------------------------------
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index a21fb8b5c2a..0d09d259f8e 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -757,6 +757,14 @@ package Exp_Util is
-- Return a suitable standard integer type containing at least S bits and
-- of the signedness given by Uns. See also Small_Integer_Type_For.
+ function Is_Captured_Function_Call (N : Node_Id) return Boolean;
+ -- Return True if N is a captured function call, i.e. the result of calling
+ -- Remove_Side_Effects on an N_Function_Call node:
+
+ -- type Ann is access all Typ;
+ -- Rnn : constant Ann := Func (...)'reference;
+ -- Rnn.all
+
function Is_Displacement_Of_Object_Or_Function_Result
(Obj_Id : Entity_Id) return Boolean;
-- Determine whether Obj_Id is a source entity that has been initialized by
--
2.34.1
