[Ada] Call-initialize all controlled objects in place

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6810,28 +6810,25 @@  package body Exp_Ch3 is
 
          --  If the object declaration appears in the form
 
-         --    Obj : Ctrl_Typ := Func (...);
+         --    Obj : Typ := Func (...);
 
-         --  where Ctrl_Typ is controlled but not immutably limited type, then
-         --  the expansion of the function call should use a dereference of the
-         --  result to reference the value on the secondary stack.
+         --  where Typ both needs finalization and is returned on the secondary
+         --  stack, the object declaration can be rewritten into a dereference
+         --  of the reference to the result built on the secondary stack (see
+         --  Expand_Ctrl_Function_Call for this expansion of the call):
 
-         --    Obj : Ctrl_Typ renames Func (...).all;
+         --    type Axx is access all Typ;
+         --    Rxx : constant Axx := Func (...)'reference;
+         --    Obj : Typ renames Rxx.all;
 
-         --  As a result, the call avoids an extra copy. This an optimization,
-         --  but it is required for passing ACATS tests in some cases where it
-         --  would otherwise make two copies. The RM allows removing redunant
-         --  Adjust/Finalize calls, but does not allow insertion of extra ones.
+         --  This avoids an extra copy and the pair of Adjust/Finalize calls.
 
-         --  This part is disabled for now, because it breaks GNAT Studio
-         --  builds
-
-         (False -- ???
+         (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 Nkind (Object_Definition (N)) in N_Has_Entity
-            and then (Needs_Finalization (Entity (Object_Definition (N)))))
+            and then Needs_Finalization (Typ)
+            and then not Is_Class_Wide_Type (Typ))
 
            --  If the initializing expression is for a variable with attribute
            --  OK_To_Rename set, then transform:
@@ -6843,8 +6840,7 @@  package body Exp_Ch3 is
            --     Obj : Typ renames Expr;
 
            --  provided that Obj is not aliased. The aliased case has to be
-           --  excluded in general because Expr will not be aliased in
-           --  general.
+           --  excluded in general because Expr will not be aliased in general.
 
            or else
              (not Aliased_Present (N)
@@ -6853,7 +6849,7 @@  package body Exp_Ch3 is
                and then OK_To_Rename (Entity (Expr_Q))
                and then Is_Entity_Name (Obj_Def));
       begin
-         --  Return False if there are any aspect specifications, because
+         --  ??? Return False if there are any aspect specifications, because
          --  otherwise we duplicate that corresponding implicit attribute
          --  definition, and call Insert_Action, which has no place to insert
          --  the attribute definition. The attribute definition is stored in
@@ -7423,16 +7419,18 @@  package body Exp_Ch3 is
                end if;
             end if;
 
-            --  If the type is controlled and not inherently limited, then
-            --  the target is adjusted after the copy and attached to the
-            --  finalization list. However, no adjustment is done in the case
-            --  where the object was initialized by a call to a function whose
-            --  result is built in place, since no copy occurred. Similarly, no
-            --  adjustment is required if we are going to rewrite the object
-            --  declaration into a renaming declaration.
+            --  If the type needs finalization and is not inherently limited,
+            --  then the target is adjusted after the copy and attached to the
+            --  finalization list. However, no adjustment is needed in the case
+            --  where the object has been initialized by a call to a function
+            --  returning on the primary stack (see Expand_Ctrl_Function_Call)
+            --  since no copy occurred, given that the type is by-reference.
+            --  Similarly, no adjustment is needed if we are going to rewrite
+            --  the object declaration into a renaming declaration.
 
             if Needs_Finalization (Typ)
               and then not Is_Limited_View (Typ)
+              and then Nkind (Expr_Q) /= N_Function_Call
               and then not Rewrite_As_Renaming
             then
                Adj_Call :=


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
@@ -247,10 +247,10 @@  package body Exp_Ch6 is
    procedure Expand_Call_Helper (N : Node_Id; Post_Call : out List_Id);
    --  Does the main work of Expand_Call. Post_Call is as for Expand_Actuals.
 
-   procedure Expand_Ctrl_Function_Call (N : Node_Id);
+   procedure Expand_Ctrl_Function_Call (N : Node_Id; Use_Sec_Stack : Boolean);
    --  N is a function call which returns a controlled object. Transform the
    --  call into a temporary which retrieves the returned object from the
-   --  secondary stack using 'reference.
+   --  primary or secondary stack (Use_Sec_Stack says which) using 'reference.
 
    procedure Expand_Non_Function_Return (N : Node_Id);
    --  Expand a simple return statement found in a procedure body, entry body,
@@ -4916,7 +4916,7 @@  package body Exp_Ch6 is
       --  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 reference to the result that has
-      --  been built either on the return or the secondary stack.
+      --  been built either on the primary or the secondary stack.
 
       if Needs_Finalization (Etype (Subp)) then
          if not Is_Build_In_Place_Function_Call (Call_Node)
@@ -4925,7 +4925,8 @@  package body Exp_Ch6 is
                or else
                  not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
          then
-            Expand_Ctrl_Function_Call (Call_Node);
+            Expand_Ctrl_Function_Call
+              (Call_Node, Needs_Secondary_Stack (Etype (Subp)));
 
          --  Build-in-place function calls which appear in anonymous contexts
          --  need a transient scope to ensure the proper finalization of the
@@ -4956,7 +4957,10 @@  package body Exp_Ch6 is
    -- Expand_Ctrl_Function_Call --
    -------------------------------
 
-   procedure Expand_Ctrl_Function_Call (N : Node_Id) is
+   procedure Expand_Ctrl_Function_Call (N : Node_Id; Use_Sec_Stack : Boolean)
+   is
+      Par : constant Node_Id := Parent (N);
+
       function Is_Element_Reference (N : Node_Id) return Boolean;
       --  Determine whether node N denotes a reference to an Ada 2012 container
       --  element.
@@ -4981,12 +4985,19 @@  package body Exp_Ch6 is
    --  Start of processing for Expand_Ctrl_Function_Call
 
    begin
-      --  Optimization, if the returned value (which is on the sec-stack) is
-      --  returned again, no need to copy/readjust/finalize, we can just pass
-      --  the value thru (see Expand_N_Simple_Return_Statement), and thus no
-      --  attachment is needed.
+      --  Optimization: if the returned value is returned again, then no need
+      --  to copy/readjust/finalize, we can just pass the value through (see
+      --  Expand_N_Simple_Return_Statement), and thus no attachment is needed.
+
+      if Nkind (Par) = N_Simple_Return_Statement then
+         return;
+      end if;
+
+      --  Another optimization: if the returned value is used to initialize an
+      --  object, and the secondary stack is not involved in the call, then no
+      --  need to copy/readjust/finalize, we can just initialize it in place.
 
-      if Nkind (Parent (N)) = N_Simple_Return_Statement then
+      if Nkind (Par) = N_Object_Declaration and then not Use_Sec_Stack then
          return;
       end if;
 


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
@@ -3063,6 +3063,13 @@  package body Exp_Ch7 is
 
                return;
 
+            --  If the initialization is in the declaration, we're done, so
+            --  early return if we have no more statements or they have been
+            --  rewritten, which means that they were in the source code.
+
+            elsif No (Stmt) or else Original_Node (Stmt) /= Stmt then
+               return;
+
             --  In all other cases the initialization calls follow the related
             --  object. The general structure of object initialization built by
             --  routine Default_Initialize_Object is as follows:
@@ -3091,8 +3098,6 @@  package body Exp_Ch7 is
             --  Otherwise the initialization calls follow the related object
 
             else
-               pragma Assert (Present (Stmt));
-
                Stmt_2 := Next_Suitable_Statement (Stmt);
 
                --  Check for an optional call to Deep_Initialize which may


diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5046,21 +5046,21 @@  package body Sem_Ch3 is
       end if;
 
       --  Another optimization: if the nominal subtype is unconstrained and
-      --  the expression is a function call that returns an unconstrained
-      --  type, rewrite the declaration as a renaming of the result of the
+      --  the expression is a function call that returns on the secondary
+      --  stack, rewrite the declaration as a renaming of the result of the
       --  call. The exceptions below are cases where the copy is expected,
       --  either by the back end (Aliased case) or by the semantics, as for
       --  initializing controlled types or copying tags for class-wide types.
+      --  ??? To be moved to Expand_N_Object_Declaration.Rewrite_As_Renaming.
 
       if Present (E)
         and then Nkind (E) = N_Explicit_Dereference
         and then Nkind (Original_Node (E)) = N_Function_Call
         and then not Is_Library_Level_Entity (Id)
-        and then not Is_Constrained (Underlying_Type (T))
         and then not Is_Aliased (Id)
+        and then Needs_Secondary_Stack (T)
         and then not Is_Class_Wide_Type (T)
-        and then not Is_Controlled (T)
-        and then not Has_Controlled_Component (Base_Type (T))
+        and then not Needs_Finalization (T)
         and then Expander_Active
       then
          Rewrite (N,