From: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue, 6 Dec 2022 23:56:43 +0000 (+0100)
Subject: ada: Fix detection of function calls in object declarations
X-Git-Tag: basepoints/gcc-14~2246
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7caa68418199bf2116467780d68ba21d49c45cdb;p=thirdparty%2Fgcc.git

ada: Fix detection of function calls in object declarations

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

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 6de5843b4ba4..def63ed0513d 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 c026b63fcf64..0bc2559751b9 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 5ab0d3039ca9..3c68f917ca97 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 a21fb8b5c2a7..0d09d259f8ee 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