ada: Elide copy for calls in allocators for nonlimited by-reference types

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 newly allocated
memory 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 is the call to
Remove_Side_Effects in Expand_Allocator_Expression, but its only purpose is
to cover the problematic processing done in Build_Allocate_Deallocate_Proc
on (part of) the expression; once this is fixed, the call is unnecessary.

The change also contains another small fix to deal with the corner case of
allocators for access-to-access types.

gcc/ada/ChangeLog:

	* exp_ch4.adb (Expand_Allocator_Expression): Do not preventively
	call Remove_Side_Effects on the expression in the nonlimited
	by-reference case.  Always call Build_Allocate_Deallocate_Proc
	in the default case.
	* exp_ch6.adb (Expand_Ctrl_Function_Call): Bail out if the call
	is the qualified expression of an allocator.
	* exp_util.adb (Build_Allocate_Deallocate_Proc): Replace all the
	calls to Relocate_Node by calls to Duplicate_Subexpr_No_Checks.

3 files changed, 36 insertions, 36 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8c1faf4..6d8aa0e 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -820,19 +820,6 @@ package body Exp_Ch4 is
          --  We analyze by hand the new internal allocator to avoid any
          --  recursion and inappropriate call to Initialize.
 
-         --  We don't want to remove side effects when the expression must be
-         --  built in place and we don't need it when there is no storage pool
-         --  or this is a return/secondary stack allocation.
-
-         if not Aggr_In_Place
-           and then not Delayed_Cond_Expr
-           and then Present (Storage_Pool (N))
-           and then not Is_RTE (Storage_Pool (N), RE_RS_Pool)
-           and then not Is_RTE (Storage_Pool (N), RE_SS_Pool)
-         then
-            Remove_Side_Effects (Exp);
-         end if;
-
          Temp := Make_Temporary (Loc, 'P', N);
 
          --  For a class wide allocation generate the following code:
@@ -1079,6 +1066,8 @@ package body Exp_Ch4 is
             Displace_Allocator_Pointer (N);
          end if;
 
+      --  Case of aggregate built in place
+
       elsif Aggr_In_Place then
          Temp := Make_Temporary (Loc, 'P', N);
          Build_Aggregate_In_Place (Temp, PtrT);
@@ -1099,26 +1088,29 @@ package body Exp_Ch4 is
          Analyze_And_Resolve (N, PtrT);
          Apply_Predicate_Check (N, T, Deref => True);
 
-      elsif Is_Access_Type (T) and then Can_Never_Be_Null (T) then
-         Install_Null_Excluding_Check (Exp);
+      --  Default case
 
-      elsif Is_Access_Type (DesigT)
-        and then Nkind (Exp) = N_Allocator
-        and then Nkind (Expression (Exp)) /= N_Qualified_Expression
-      then
-         --  Apply constraint to designated subtype indication
+      else
+         if Is_Access_Type (T) and then Can_Never_Be_Null (T) then
+            Install_Null_Excluding_Check (Exp);
+         end if;
 
-         Apply_Constraint_Check
-           (Expression (Exp), Designated_Type (DesigT), No_Sliding => True);
+         if Is_Access_Type (DesigT)
+           and then Nkind (Exp) = N_Allocator
+           and then Nkind (Expression (Exp)) /= N_Qualified_Expression
+         then
+            --  Apply constraint to designated subtype indication
 
-         if Nkind (Expression (Exp)) = N_Raise_Constraint_Error then
+            Apply_Constraint_Check
+              (Expression (Exp), Designated_Type (DesigT), No_Sliding => True);
 
-            --  Propagate constraint_error to enclosing allocator
+            --  Propagate Constraint_Error to enclosing allocator
 
-            Rewrite (Exp, New_Copy (Expression (Exp)));
+            if Nkind (Expression (Exp)) = N_Raise_Constraint_Error then
+               Rewrite (Exp, New_Copy (Expression (Exp)));
+            end if;
          end if;
 
-      else
          Build_Allocate_Deallocate_Proc (N);
 
          --  For an access-to-unconstrained-packed-array type, build an
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 945f446..751c5f4 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5392,6 +5392,16 @@ package body Exp_Ch6 is
          return;
       end if;
 
+      --  The same optimization: if the returned value is used to initialize a
+      --  dynamically allocated object, then no need to copy/readjust/finalize,
+      --  we can initialize it in place.
+
+      if Nkind (Par) = N_Qualified_Expression
+        and then Nkind (Parent (Par)) = N_Allocator
+      then
+         return;
+      end if;
+
       --  Avoid expansions to catch an error when the function call is on the
       --  left-hand side of an assignment.
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index e9a683f..2417700 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1079,10 +1079,11 @@ package body Exp_Util is
               Unchecked_Convert_To (RTE (RE_Storage_Offset),
                 Make_Attribute_Reference (Loc,
                   Prefix         =>
-                    (if No (Alloc_Expr) then
-                       Make_Explicit_Dereference (Loc, Relocate_Node (Expr))
+                    (if Is_Allocate then
+                       Duplicate_Subexpr_No_Checks (Expression (Alloc_Expr))
                      else
-                       Relocate_Node (Expression (Alloc_Expr))),
+                       Make_Explicit_Dereference (Loc,
+                         Duplicate_Subexpr_No_Checks (Expr))),
                   Attribute_Name => Name_Alignment)));
          end if;
 
@@ -1094,7 +1095,6 @@ package body Exp_Util is
 
                Flag_Expr : Node_Id;
                Param     : Node_Id;
-               Pref      : Node_Id;
                Temp      : Node_Id;
 
             begin
@@ -1136,7 +1136,7 @@ package body Exp_Util is
                   if Is_RTE (Etype (Temp), RE_Tag_Ptr) then
                      Param :=
                        Make_Explicit_Dereference (Loc,
-                         Prefix => Relocate_Node (Temp));
+                         Prefix => Duplicate_Subexpr_No_Checks (Temp));
 
                   --  In the default case, obtain the tag of the object about
                   --  to be allocated / deallocated. Generate:
@@ -1149,16 +1149,14 @@ package body Exp_Util is
                   --  in the code that follows.
 
                   else
-                     Pref := Temp;
-
-                     if Nkind (Parent (Pref)) = N_Unchecked_Type_Conversion
+                     if Nkind (Parent (Temp)) = N_Unchecked_Type_Conversion
                      then
-                        Pref := Parent (Pref);
+                        Temp := Parent (Temp);
                      end if;
 
                      Param :=
                        Make_Attribute_Reference (Loc,
-                         Prefix         => Relocate_Node (Pref),
+                         Prefix         => Duplicate_Subexpr_No_Checks (Temp),
                          Attribute_Name => Name_Tag);
                   end if;