[Ada] Avoid copy operation for returns involving function calls

[Ada] Avoid copy operation for returns involving function calls

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 649 bytes --]

The underlying issue is that the front-end does not create transient scopes
for return statements, so objects copied for these statements can never be
finalized properly.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* exp_ch6.adb (Expand_Call_Helper): Adjust comment.
	(Expand_Simple_Function_Return): For the case of a type which needs
	finalization and is returned on the primary stack, do not create a
	copy if the expression originates from a function call.
	* exp_ch7.adb (Transient Scope Management): Adjust comment.
	* exp_util.ads (Is_Related_To_Func_Return): Add WARNING line.
	* fe.h (Is_Related_To_Func_Return): Declare.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 3623 bytes --]

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4899,8 +4899,8 @@ package body Exp_Ch6 is
       --  the return type is limited, then the context is initialization and
       --  different processing applies. If the call is to a protected function,
       --  the expansion above will call Expand_Call recursively. Otherwise the
-      --  function call is transformed into a temporary which obtains the
-      --  result from the secondary stack.
+      --  function call is transformed into a reference to the result that has
+      --  been built either on the return or the secondary stack.
 
       if Needs_Finalization (Etype (Subp)) then
          if not Is_Build_In_Place_Function_Call (Call_Node)
@@ -7369,7 +7369,7 @@ package body Exp_Ch6 is
 
          if Present (Utyp)
            and then Needs_Finalization (Utyp)
-           and then not (Nkind (Exp) = N_Function_Call
+           and then not (Exp_Is_Function_Call
                           and then Needs_Finalization (Exp_Typ))
          then
             declare


diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -109,18 +109,13 @@ package body Exp_Ch7 is
    --  pass the address of a constrained object as the target object for the
    --  function result.
 
-   --  By allocating tagged results in the secondary stack a number of
+   --  By always allocating tagged results in the secondary stack, a couple of
    --  implementation difficulties are avoided:
 
-   --    - If it is a dispatching function call, the computation of the size of
-   --      the result is possible but complex from the outside.
+   --    - If this is a dispatching function call, the computation of the size
+   --      of the result is possible but complex from the outside.
 
-   --    - If the returned type is controlled, the assignment of the returned
-   --      value to the anonymous object involves an Adjust, and we have no
-   --      easy way to access the anonymous object created by the back end.
-
-   --    - If the returned type is class-wide, this is an unconstrained type
-   --      anyway.
+   --    - If the result type is class-wide, it is unconstrained anyway.
 
    --  Furthermore, the small loss in efficiency which is the result of this
    --  decision is not such a big deal because functions returning tagged types


diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -820,6 +820,8 @@ package Exp_Util is
    --  Determine whether object Id is related to an expanded return statement.
    --  The case concerned is "return Id.all;".
 
+   --  WARNING: There is a matching C declaration of this subprogram in fe.h
+
    function Is_Renamed_Object (N : Node_Id) return Boolean;
    --  Returns True if the node N is a renamed object. An expression is
    --  considered to be a renamed object if either it is the Name of an object


diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -183,9 +183,11 @@ extern Boolean Is_Init_Proc		(Entity_Id);
 /* exp_util: */
 
 #define Is_Fully_Repped_Tagged_Type	exp_util__is_fully_repped_tagged_type
+#define Is_Related_To_Func_Return	exp_util__is_related_to_func_return
 #define Find_Interface_Tag		exp_util__find_interface_tag
 
-extern Boolean Is_Fully_Repped_Tagged_Type      (Entity_Id);
+extern Boolean Is_Fully_Repped_Tagged_Type	(Entity_Id);
+extern Boolean Is_Related_To_Func_Return	(Entity_Id);
 extern Entity_Id Find_Interface_Tag		(Entity_Id, Entity_Id);
 
 /* lib: */