ada: Elide the copy in aggregate returns for nonlimited types

This implements elision of the copy operation for aggregate returns, i.e.
simple return statements whose expression is an aggregate, in the case of
nonlimited by-reference types (the copy operation is already elided for
limited types), which comprise controlled and tagged types.  This is the
copy operation in the called function, that is to say the copy from the
anonymous object built for the aggregate to the anonymous return object.

The implementation simply extends that of limited types, which rewrites
the simple return statement as an extended return statement internally
and then leverages the built-in-place implementation of return objects
for these statements.

gcc/ada/ChangeLog:

	* exp_aggr.adb (Is_Build_In_Place_Aggregate_Return): Also return
	True for functions returning on the secondary stack or returning
	a by-reference type if the back end exposes its return slot.
	(Expand_Array_Aggregate): Call Is_Build_In_Place_Aggregate_Return
	to spot aggregates to be built in place.
	* exp_ch3.adb (Make_Allocator_For_Return): Add missing condition
	in assertion pragma deduced from Expand_Subtype_From_Expr.
	* exp_ch6.adb (Expand_Simple_Function_Return): Rewrite the statement
	as an extended return statement if the expression is an aggregate
	whose expansion is delayed.  Properly relocate the expression in
	this case.
	* sem_ch6.adb: Add clauses for Exp_Aggr.
	(Analyze_Function_Return): Do not apply the predicate check to an
	aggregate whose expansion is delayed.  Extended the processing of
	case expressions to all conditional expressions.

4 files changed, 48 insertions, 36 deletions

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cadbe78..f4844b7 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -167,8 +167,8 @@ package body Exp_Aggr is
 
    function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean;
    --  True if N is an aggregate (possibly qualified or a dependent expression
-   --  of a conditional expression, and possibly recursively so) that is being
-   --  returned from a build-in-place function. Such qualified and conditional
+   --  of a conditional expression, and possibly recursively so) that needs to
+   --  be built-in-place in the return object. Such qualified and conditional
    --  expressions are transparent for this purpose because an enclosing return
    --  is propagated resp. distributed into these expressions by the expander.
 
@@ -6190,6 +6190,7 @@ package body Exp_Aggr is
                                        (Defining_Identifier (Parent_Node))))
         or else (Parent_Kind = N_Assignment_Statement
                   and then Inside_Init_Proc)
+        or else Is_Build_In_Place_Aggregate_Return (N)
       then
          Set_Expansion_Delayed (N, not Static_Array_Aggregate (N));
          return;
@@ -6296,15 +6297,6 @@ package body Exp_Aggr is
          Set_Expansion_Delayed (N);
          return;
 
-      --  Limited arrays in return statements are expanded when
-      --  enclosing construct is expanded.
-
-      elsif Maybe_In_Place_OK
-        and then Parent_Kind = N_Simple_Return_Statement
-      then
-         Set_Expansion_Delayed (N);
-         return;
-
       --  In the remaining cases the aggregate appears in the RHS of an
       --  assignment, which may be part of the expansion of an object
       --  declaration. If the aggregate is an actual in a call, itself
@@ -8896,9 +8888,11 @@ package body Exp_Aggr is
    ----------------------------------------
 
    function Is_Build_In_Place_Aggregate_Return (N : Node_Id) return Boolean is
-      P : Node_Id := Parent (N);
+      F : Entity_Id;
+      P : Node_Id;
 
    begin
+      P := Parent (N);
       while Nkind (P) in N_Case_Expression
                        | N_Case_Expression_Alternative
                        | N_If_Expression
@@ -8917,9 +8911,17 @@ package body Exp_Aggr is
          return False;
       end if;
 
-      return
-        Is_Build_In_Place_Function
-          (Return_Applies_To (Return_Statement_Entity (P)));
+      F := Return_Applies_To (Return_Statement_Entity (P));
+
+      --  For a build-in-place function, all the returns are done in place
+      --  by definition. We also return aggregates in place in other cases
+      --  as an optimization, and they correspond to the cases where the
+      --  return object is built in place (see Is_Special_Return_Object).
+
+      return Is_Build_In_Place_Function (F)
+        or else Needs_Secondary_Stack (Etype (F))
+        or else (Back_End_Return_Slot
+                  and then Is_By_Reference_Type (Etype (F)));
    end Is_Build_In_Place_Aggregate_Return;
 
    --------------------------
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 139fce8..3dd4d9c 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7351,8 +7351,9 @@ package body Exp_Ch3 is
 
          --  However, there are exceptions in the latter case for interfaces
          --  (see Analyze_Object_Declaration), as well as class-wide types and
-         --  types with unknown discriminants if they are additionally limited
-         --  (see Expand_Subtype_From_Expr), so we must cope with them.
+         --  types with unknown discriminants if they have no underlying record
+         --  view or are inherently limited (see Expand_Subtype_From_Expr), so
+         --  we must cope with them.
 
          elsif Is_Interface (Typ) then
             pragma Assert (Is_Class_Wide_Type (Typ));
@@ -7384,7 +7385,8 @@ package body Exp_Ch3 is
 
          else pragma Assert (Is_Definite_Subtype (Typ)
            or else (Has_Unknown_Discriminants (Typ)
-                     and then Is_Inherently_Limited_Type (Typ)));
+                     and then (No (Underlying_Record_View (Typ))
+                                or else Is_Inherently_Limited_Type (Typ))));
 
             Alloc_Typ := Typ;
          end if;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 3843244..e84937f 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6621,11 +6621,16 @@ package body Exp_Ch6 is
          end if;
       end if;
 
-      --  For the case of a simple return that does not come from an
-      --  extended return, in the case of build-in-place, we rewrite
-      --  "return <expression>;" to be:
-
-      --    return _anon_ : <return_subtype> := <expression>
+      --  For the case of a simple return that does not come from an extended
+      --  return, and if the function returns in place or the expression is an
+      --  aggregate whose expansion has been delayed to be returned in place
+      --  (see Is_Build_In_Place_Aggregate_Return), we rewrite:
+      --
+      --    return <expression>;
+      --
+      --  into
+      --
+      --    return _anonymous_ : <return_subtype> := <expression>
 
       --  The expansion produced by Expand_N_Extended_Return_Statement will
       --  contain simple return statements (for example, a block containing
@@ -6644,7 +6649,8 @@ package body Exp_Ch6 is
           or else Has_BIP_Formals (Scope_Id));
 
       if not Comes_From_Extended_Return_Statement (N)
-        and then Is_Build_In_Place_Function (Scope_Id)
+        and then (Is_Build_In_Place_Function (Scope_Id)
+                   or else Is_Delayed_Aggregate (Exp))
 
          --  The functionality of interface thunks is simple and it is always
          --  handled by means of simple return statements. This leaves their
@@ -6653,23 +6659,20 @@ package body Exp_Ch6 is
         and then not Is_Thunk (Scope_Id)
       then
          declare
-            Return_Object_Entity : constant Entity_Id :=
-                                     Make_Temporary (Loc, 'R', Exp);
-
             Obj_Decl : constant Node_Id :=
                          Make_Object_Declaration (Loc,
-                           Defining_Identifier => Return_Object_Entity,
+                           Defining_Identifier => Make_Temporary (Loc, 'R'),
                            Object_Definition   => Subtype_Ind,
-                           Expression          => Exp);
+                           Expression          => Relocate_Node (Exp));
 
-            Ext : constant Node_Id :=
-                    Make_Extended_Return_Statement (Loc,
-                      Return_Object_Declarations => New_List (Obj_Decl));
+            Stmt : constant Node_Id :=
+                     Make_Extended_Return_Statement (Loc,
+                       Return_Object_Declarations => New_List (Obj_Decl));
             --  Do not perform this high-level optimization if the result type
             --  is an interface because the "this" pointer must be displaced.
 
          begin
-            Rewrite (N, Ext);
+            Rewrite (N, Stmt);
             Analyze (N);
             return;
          end;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 944f5ca..16f2965 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -35,6 +35,7 @@ with Einfo.Utils;    use Einfo.Utils;
 with Elists;         use Elists;
 with Errout;         use Errout;
 with Expander;       use Expander;
+with Exp_Aggr;       use Exp_Aggr;
 with Exp_Ch3;        use Exp_Ch3;
 with Exp_Ch6;        use Exp_Ch6;
 with Exp_Ch9;        use Exp_Ch9;
@@ -989,13 +990,17 @@ package body Sem_Ch6 is
          --  The return value is converted to the return type of the function,
          --  which implies a predicate check if the return type is predicated.
          --  We do not apply the check for an extended return statement because
-         --  Analyze_Object_Declaration has already done it on Obj_Decl above.
-         --  We do not apply the check to a case expression because it will
-         --  be expanded into a series of return statements, each of which
+         --  Analyze_Object_Declaration has already done it on Obj_Decl above,
+         --  or to a delayed aggregate because the return will be turned into
+         --  an extended return by Expand_Simple_Function_Return in this case.
+         --  We do not apply the check to a conditional expression because it
+         --  will be expanded into a series of return statements, each of which
          --  will receive a predicate check.
 
          if Nkind (N) /= N_Extended_Return_Statement
+           and then not Is_Delayed_Aggregate (Expr)
            and then Nkind (Expr) /= N_Case_Expression
+           and then Nkind (Expr) /= N_If_Expression
          then
             Apply_Predicate_Check (Expr, R_Type);
          end if;