ada: Elide copy for calls as default values of nonlimited by-reference components

This prevents a temporary from being created on the primary stack to hold
the result of the function calls before it is copied to the object being
elaborated in the nonlimited by-reference case.

That's already not done in the nonlimited non-by-reference case and there is
no reason to do it in the former case either.  The main issue are the calls
to Remove_Side_Effects in Expand_Ctrl_Function_Call (controlled case only)
and in Expand_N_Assignment_Statement, which serve various purposes including
very technical ones beside removing side effects.

The change is therefore very conservative and only removes the copy in the
case of a naked function call for the time being.

gcc/ada/ChangeLog:

	* einfo.ads (Returns_By_Ref): Fix description.
	* exp_ch3.adb (Build_Record_Init_Proc.Build_Assignment): Do not
	adjust the component manually (if need be), set No_Finalize_Actions
	instead of No_Ctrl_Actions for this purpose.  Do not adjust when
	the expression is a naked function call.
	* exp_ch5.adb (Make_Tag_Ctrl_Assignment): Document the quirks of
	the function.  Assert that the LHS of the assignment does not have
	side effects and replace calls to Duplicate_Subexpr_No_Checks with
	calls to New_Copy_Tree.  Rename local variable Asn to New_N.
	(Expand_N_Assignment_Statement): In the tagged or controlled record
	case, do remove side effects from both operands on entry.  Remove
	them in the controlled record case, except if the RHS is a function
	call and the assignment has the No_Ctrl_Actions flag set.
	* exp_ch6.adb (Expand_Ctrl_Function_Call): Bail out when the parent
	node is an assignment statement with the No_Ctrl_Actions flag set.
	* sem_util.adb (Statically_Different): Return True for a function
	call that does not return its result by reference.
	* sinfo.ads (No_Ctrl_Actions): Adjust description and add a note for
	the code generator.
	(No_Finalize_Actions): Likewise.

1 files changed, 35 insertions, 45 deletions

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 9419d5d..65d8eb7 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2618,11 +2618,10 @@ package body Exp_Ch3 is
          Default_Loc : constant Source_Ptr := Sloc (Default);
          Typ         : constant Entity_Id  := Underlying_Type (Etype (Id));
 
-         Adj_Call : Node_Id;
-         Exp      : Node_Id;
-         Exp_Q    : Node_Id;
-         Lhs      : Node_Id;
-         Res      : List_Id;
+         Exp   : Node_Id;
+         Exp_Q : Node_Id;
+         Lhs   : Node_Id;
+         Res   : List_Id;
 
       begin
          Lhs :=
@@ -2677,57 +2676,48 @@ package body Exp_Ch3 is
              Name       => Lhs,
              Expression => Exp));
 
-         Set_No_Ctrl_Actions (First (Res));
-
          Exp_Q := Unqualify (Exp);
 
-         --  Adjust the tag if tagged (because of possible view conversions).
-         --  Suppress the tag adjustment when not Tagged_Type_Expansion because
-         --  tags are represented implicitly in objects, and when the record is
-         --  initialized with a raise expression.
-
-         if Is_Tagged_Type (Typ)
-           and then Tagged_Type_Expansion
-           and then Nkind (Exp_Q) /= N_Raise_Expression
-         then
-            --  Get the relevant type for the call to
-            --  Make_Tag_Assignment_From_Type, which, for concurrent types is
-            --  their corresponding record.
-
-            declare
-               T : Entity_Id := Underlying_Type (Typ);
-            begin
-               if Ekind (T) in E_Protected_Type | E_Task_Type then
-                  T := Corresponding_Record_Type (T);
-               end if;
-
-               Append_To (Res,
-                 Make_Tag_Assignment_From_Type
-                   (Default_Loc,
-                    New_Copy_Tree (Lhs, New_Scope => Proc_Id),
-                    T));
-            end;
-         end if;
-
-         --  Adjust the component if controlled except if it is an aggregate
+         --  Adjust the component if controlled, except if it is an aggregate
          --  that will be expanded inline (but note that the case of container
-         --  aggregates does require component adjustment).
+         --  aggregates does require component adjustment), or a function call.
+         --  Note that, when we don't inhibit component adjustment, the tag
+         --  will be automatically inserted by Make_Tag_Ctrl_Assignment in the
+         --  tagged case. Otherwise, we have to generate a tag assignment here.
 
          if Needs_Finalization (Typ)
            and then (Nkind (Exp_Q) not in N_Aggregate | N_Extension_Aggregate
                       or else Is_Container_Aggregate (Exp_Q))
            and then not Is_Build_In_Place_Function_Call (Exp)
+           and then Nkind (Exp) /= N_Function_Call
          then
-            Adj_Call :=
-              Make_Adjust_Call
-                (Obj_Ref => New_Copy_Tree (Lhs),
-                 Typ     => Etype (Id));
+            Set_No_Finalize_Actions (First (Res));
+
+         else
+            Set_No_Ctrl_Actions (First (Res));
+
+            --  Adjust the tag if tagged because of possible view conversions
+
+            if Is_Tagged_Type (Typ)
+              and then Tagged_Type_Expansion
+              and then Nkind (Exp_Q) /= N_Raise_Expression
+            then
+               declare
+                  Utyp : Entity_Id := Underlying_Type (Typ);
+
+               begin
+                  --  Get the relevant type for Make_Tag_Assignment_From_Type,
+                  --  which, for concurrent types is the corresponding record.
 
-            --  Guard against a missing [Deep_]Adjust when the component type
-            --  was not properly frozen.
+                  if Ekind (Utyp) in E_Protected_Type | E_Task_Type then
+                     Utyp := Corresponding_Record_Type (Utyp);
+                  end if;
 
-            if Present (Adj_Call) then
-               Append_To (Res, Adj_Call);
+                  Append_To (Res,
+                    Make_Tag_Assignment_From_Type (Default_Loc,
+                      New_Copy_Tree (Lhs, New_Scope => Proc_Id),
+                      Utyp));
+               end;
             end if;
          end if;