[COMMITTED,13/30] ada: Extend expansion delaying mechanism to conditional expressions

Message ID 20240520074858.222435-13-poulhies@adacore.com
State Committed
Headers
Series [COMMITTED,01/30] ada: Rework and augment documentation on strict aliasing |

Commit Message

Marc Poulhiès May 20, 2024, 7:48 a.m. UTC
  From: Eric Botcazou <ebotcazou@adacore.com>

When an aggregate that needs to be converted into a series of assignments is
present in an expression of a parent aggregate, or in the expression of an
allocator, an object declaration, or an assignment in very specific cases,
its expansion is delayed until its parent itself is expanded.  This makes
it possible to avoid creating a superfluous temporary for the aggregate.

This change extends the delaying mechanism in the case of record aggregates
to intermediate conditional expressions, that is to say, to the conditional
expressions that are present between the parent and the aggregate, provided
that the aggregate be a dependent expression, directly or recursively.  This
again makes it possible to avoid creating a temporary for the aggregate.

gcc/ada/

	* exp_aggr.ads (Is_Delayed_Conditional_Expression): New predicate.
	* exp_aggr.adb (Convert_To_Assignments.Known_Size): Likewise.
	(Convert_To_Assignments): Climb the parent chain, looking through
	qualified expressions and dependent expressions of conditional
	expressions, to find out whether the expansion may be delayed.
	Call Known_Size for this in the case of an object declaration.
	If so, set Expansion_Delayed on the aggregate as well as all the
	intermediate conditional expressions.
	(Initialize_Component): Reset the Analyzed flag on an initialization
	expression that is a conditional expression whose expansion has been
	delayed.
	(Is_Delayed_Conditional_Expression): New predicate.
	* exp_ch3.adb (Expand_N_Object_Declaration): Handle initialization
	expressions that are conditional expressions whose expansion has
	been delayed.
	* exp_ch4.adb (Build_Explicit_Assignment): New procedure.
	(Expand_Allocator_Expression): Handle initialization expressions
	that are conditional expressions whose expansion has been delayed.
	(Expand_N_Case_Expression): Deal with expressions whose expansion
	has been delayed by waiting for the rewriting of their parent as
	an assignment statement and then optimizing the assignment.
	(Expand_N_If_Expression): Likewise.
	(Expand_N_Qualified_Expression): Do not apply a predicate check to
	an operand that is a delayed aggregate or conditional expression.
	* gen_il-gen-gen_nodes.adb (N_If_Expression): Add Expansion_Delayed
	semantic flag.
	(N_Case_Expression): Likewise.
	* sinfo.ads (Expansion_Delayed): Document extended usage.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_aggr.adb             | 201 ++++++++++++-----
 gcc/ada/exp_aggr.ads             |   4 +
 gcc/ada/exp_ch3.adb              |  38 ++++
 gcc/ada/exp_ch4.adb              | 363 ++++++++++++++++++++++++-------
 gcc/ada/gen_il-gen-gen_nodes.adb |   4 +-
 gcc/ada/sinfo.ads                |   4 +
 6 files changed, 479 insertions(+), 135 deletions(-)
  

Patch

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 6208b49ffd9..a386aa85ae4 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4216,84 +4216,152 @@  package body Exp_Aggr is
    procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
-      Aggr_Code   : List_Id;
-      Full_Typ    : Entity_Id;
-      Instr       : Node_Id;
-      Parent_Kind : Node_Kind;
-      Parent_Node : Node_Id;
-      Target_Expr : Node_Id;
-      Temp        : Entity_Id;
-      Unc_Decl    : Boolean := False;
+      function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean;
+      --  Decl is an N_Object_Declaration node. Return true if it declares an
+      --  object with a known size; in this context, that is always the case,
+      --  except for a declaration without explicit constraints of an object,
+      --  either whose nominal subtype is class-wide, or whose initialization
+      --  contains a conditional expression and whose nominal subtype is both
+      --  discriminated and unconstrained.
+
+      ----------------
+      -- Known_Size --
+      ----------------
+
+      function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean
+      is
+      begin
+         if Is_Entity_Name (Object_Definition (Decl)) then
+            declare
+               Typ : constant Entity_Id := Entity (Object_Definition (Decl));
+
+            begin
+               return not Is_Class_Wide_Type (Typ)
+                 and then not (Cond_Init
+                                and then Has_Discriminants (Typ)
+                                and then not Is_Constrained (Typ));
+            end;
+
+         else
+            return True;
+         end if;
+      end Known_Size;
+
+      --  Local variables
+
+      Aggr_Code    : List_Id;
+      Full_Typ     : Entity_Id;
+      In_Cond_Expr : Boolean;
+      Instr        : Node_Id;
+      Node         : Node_Id;
+      Parent_Node  : Node_Id;
+      Target_Expr  : Node_Id;
+      Temp         : Entity_Id;
+
+   --  Start of processing for Convert_To_Assignments
 
    begin
       pragma Assert (Nkind (N) in N_Aggregate | N_Extension_Aggregate);
       pragma Assert (not Is_Static_Dispatch_Table_Aggregate (N));
       pragma Assert (Is_Record_Type (Typ));
 
-      Parent_Node := Parent (N);
-      Parent_Kind := Nkind (Parent_Node);
+      In_Cond_Expr := False;
+      Node         := N;
+      Parent_Node  := Parent (Node);
 
-      if Parent_Kind = N_Qualified_Expression then
-         --  Check if we are in an unconstrained declaration because in this
-         --  case the current delayed expansion mechanism doesn't work when
-         --  the declared object size depends on the initializing expr.
+      --  First, climb the parent chain, looking through qualified expressions
+      --  and dependent expressions of conditional expressions.
 
-         Parent_Node := Parent (Parent_Node);
-         Parent_Kind := Nkind (Parent_Node);
+      while True loop
+         case Nkind (Parent_Node) is
+            when N_Case_Expression_Alternative =>
+               null;
 
-         if Parent_Kind = N_Object_Declaration then
-            Unc_Decl :=
-              not Is_Entity_Name (Object_Definition (Parent_Node))
-                or else (Nkind (N) = N_Aggregate
-                          and then
-                            Has_Discriminants
-                              (Entity (Object_Definition (Parent_Node))))
-                or else Is_Class_Wide_Type
-                          (Entity (Object_Definition (Parent_Node)));
-         end if;
-      end if;
+            when N_Case_Expression =>
+               exit when Node = Expression (Parent_Node);
+               In_Cond_Expr := True;
+
+            when N_If_Expression =>
+               exit when Node = First (Expressions (Parent_Node));
+               In_Cond_Expr := True;
 
-      --  Just set the Delay flag in the cases where the transformation will be
-      --  done top down from above.
+            when N_Qualified_Expression =>
+               null;
+
+            when others =>
+               exit;
+         end case;
+
+         Node        := Parent_Node;
+         Parent_Node := Parent (Node);
+      end loop;
+
+      --  Set the Expansion_Delayed flag in the cases where the transformation
+      --  will be done top down from above.
 
       if
          --  Internal aggregates (transformed when expanding the parent),
          --  excluding container aggregates as these are transformed into
-         --  subprogram calls later.
+         --  subprogram calls later. So far aggregates with self-references
+         --  are not supported if they appear in a conditional expression.
 
-         (Parent_Kind = N_Component_Association
-           and then not Is_Container_Aggregate (Parent (Parent_Node)))
+         (Nkind (Parent_Node) = N_Component_Association
+           and then not Is_Container_Aggregate (Parent (Parent_Node))
+           and then not (In_Cond_Expr and then Has_Self_Reference (N)))
 
-         or else (Parent_Kind in N_Aggregate | N_Extension_Aggregate
-                   and then not Is_Container_Aggregate (Parent_Node))
+         or else (Nkind (Parent_Node) in N_Aggregate | N_Extension_Aggregate
+                   and then not Is_Container_Aggregate (Parent_Node)
+                   and then not (In_Cond_Expr and then Has_Self_Reference (N)))
 
          --  Allocator (see Convert_Aggr_In_Allocator)
 
-         or else Parent_Kind = N_Allocator
+         or else Nkind (Parent_Node) = N_Allocator
 
-         --  Object declaration (see Convert_Aggr_In_Object_Decl)
+         --  Object declaration (see Convert_Aggr_In_Object_Decl). So far only
+         --  declarations with a known size are supported.
 
-         or else (Parent_Kind = N_Object_Declaration and then not Unc_Decl)
+         or else (Nkind (Parent_Node) = N_Object_Declaration
+                   and then Known_Size (Parent_Node, In_Cond_Expr))
 
          --  Safe assignment (see Convert_Aggr_In_Assignment). So far only the
          --  assignments in init procs are taken into account.
 
-         or else (Parent_Kind = N_Assignment_Statement
+         or else (Nkind (Parent_Node) = N_Assignment_Statement
                    and then Inside_Init_Proc)
-
-         --  (Ada 2005) An inherently limited type in a return statement, which
-         --  will be handled in a build-in-place fashion, and may be rewritten
-         --  as an extended return and have its own finalization machinery.
-         --  In the case of a simple return, the aggregate needs to be delayed
-         --  until the scope for the return statement has been created, so
-         --  that any finalization chain will be associated with that scope.
-         --  For extended returns, we delay expansion to avoid the creation
-         --  of an unwanted transient scope that could result in premature
-         --  finalization of the return object (which is built in place
-         --  within the caller's scope).
-
-         or else Is_Build_In_Place_Aggregate_Return (N)
       then
+         Node := N;
+
+         --  Mark the aggregate, as well as all the intermediate conditional
+         --  expressions, as having expansion delayed. This will block the
+         --  usual (bottom-up) expansion of the marked nodes and replace it
+         --  with a top-down expansion from the parent node.
+
+         while Node /= Parent_Node loop
+            if Nkind (Node) in N_Aggregate
+                             | N_Case_Expression
+                             | N_Extension_Aggregate
+                             | N_If_Expression
+            then
+               Set_Expansion_Delayed (Node);
+            end if;
+
+            Node := Parent (Node);
+         end loop;
+
+         return;
+
+      --  (Ada 2005) An inherently limited type in a return statement, which
+      --  will be handled in a build-in-place fashion, and may be rewritten
+      --  as an extended return and have its own finalization machinery.
+      --  In the case of a simple return, the aggregate needs to be delayed
+      --  until the scope for the return statement has been created, so
+      --  that any finalization chain will be associated with that scope.
+      --  For extended returns, we delay expansion to avoid the creation
+      --  of an unwanted transient scope that could result in premature
+      --  finalization of the return object (which is built in place
+      --  within the caller's scope).
+
+      elsif Is_Build_In_Place_Aggregate_Return (N) then
          Set_Expansion_Delayed (N);
          return;
       end if;
@@ -4304,11 +4372,19 @@  package body Exp_Aggr is
          Establish_Transient_Scope (N, Manage_Sec_Stack => False);
       end if;
 
+      --  Now get back to the immediate parent, modulo qualified expression
+
+      Parent_Node := Parent (N);
+
+      if Nkind (Parent_Node) = N_Qualified_Expression then
+         Parent_Node := Parent (Parent_Node);
+      end if;
+
       --  If the context is an assignment and the aggregate is limited, this
       --  is a subaggregate of an enclosing aggregate being expanded; it must
       --  be built in place, so use the target of the current assignment.
 
-      if Parent_Kind = N_Assignment_Statement
+      if Nkind (Parent_Node) = N_Assignment_Statement
         and then Is_Limited_Type (Typ)
       then
          Target_Expr := New_Copy_Tree (Name (Parent_Node));
@@ -4321,7 +4397,7 @@  package body Exp_Aggr is
       --  by-copy semantics of aggregates. This avoids large stack usage and
       --  generates more efficient code.
 
-      elsif Parent_Kind = N_Assignment_Statement
+      elsif Nkind (Parent_Node) = N_Assignment_Statement
         and then In_Place_Assign_OK (N, Get_Base_Object (Name (Parent_Node)))
       then
          declare
@@ -8678,6 +8754,13 @@  package body Exp_Aggr is
           Name       => New_Copy_Tree (Comp),
           Expression => Relocate_Node (Init_Expr));
 
+      --  If the initialization expression is a conditional expression whose
+      --  expansion has been delayed, analyze it again and expand it.
+
+      if Is_Delayed_Conditional_Expression (Expression (Init_Stmt)) then
+         Set_Analyzed (Expression (Init_Stmt), False);
+      end if;
+
       Append_To (Blk_Stmts, Init_Stmt);
 
       --  Arrange for the component to be adjusted if need be (the call will be
@@ -8796,6 +8879,18 @@  package body Exp_Aggr is
         and then Expansion_Delayed (Unqual_N);
    end Is_Delayed_Aggregate;
 
+   ---------------------------------------
+   -- Is_Delayed_Conditional_Expression --
+   ---------------------------------------
+
+   function Is_Delayed_Conditional_Expression (N : Node_Id) return Boolean is
+      Unqual_N : constant Node_Id := Unqualify (N);
+
+   begin
+      return Nkind (Unqual_N) in N_Case_Expression | N_If_Expression
+        and then Expansion_Delayed (Unqual_N);
+   end Is_Delayed_Conditional_Expression;
+
    --------------------------------
    -- Is_CCG_Supported_Aggregate --
    --------------------------------
diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads
index a9eb0518d7a..17fa38b7ca3 100644
--- a/gcc/ada/exp_aggr.ads
+++ b/gcc/ada/exp_aggr.ads
@@ -54,6 +54,10 @@  package Exp_Aggr is
    --  Returns True if N is an aggregate of some kind whose Expansion_Delayed
    --  flag is set (see sinfo for meaning of flag).
 
+   function Is_Delayed_Conditional_Expression (N : Node_Id) return Boolean;
+   --  Returns True if N is a conditional expression whose Expansion_Delayed
+   --  flag is set (see sinfo for meaning of flag).
+
    function Static_Array_Aggregate (N : Node_Id) return Boolean;
    --  N is an array aggregate that may have a component association with
    --  an others clause and a range. If bounds are static and the expressions
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index f6314dff285..8ddae1eb1be 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7689,10 +7689,48 @@  package body Exp_Ch3 is
                Expander_Mode_Restore;
             end if;
 
+            --  For a special return object, the transformation must wait until
+            --  after the object is turned into an allocator.
+
             if not Special_Ret_Obj then
                Convert_Aggr_In_Object_Decl (N);
             end if;
 
+         --  If the initialization expression is a conditional expression whose
+         --  expansion has been delayed, assign it explicitly to the object but
+         --  only after analyzing it again and expanding it.
+
+         elsif Is_Delayed_Conditional_Expression (Expr_Q) then
+            --  For a special return object, the transformation must wait until
+            --  after the object is turned into an allocator, and will be done
+            --  during the expansion of the allocator.
+
+            if not Special_Ret_Obj then
+               declare
+                  Assign : constant Node_Id :=
+                    Make_Assignment_Statement (Loc,
+                      Name       => New_Occurrence_Of (Def_Id, Loc),
+                      Expression => Relocate_Node (Expr));
+
+               begin
+                  Set_Assignment_OK (Name (Assign));
+                  Set_Analyzed (Expression (Assign), False);
+                  Set_No_Finalize_Actions (Assign);
+                  Insert_Action_After (Init_After, Assign);
+
+                  --  Save the assignment statement when declaring a controlled
+                  --  object. This reference is used later by the finalization
+                  --  machinery to mark the object as successfully initialized
+
+                  if Needs_Finalization (Typ) then
+                     Set_Last_Aggregate_Assignment (Def_Id, Assign);
+                  end if;
+
+                  Set_Expression (N, Empty);
+                  Set_No_Initialization (N);
+               end;
+            end if;
+
          --  Ada 2005 (AI-318-02): If the initialization expression is a call
          --  to a build-in-place function, then access to the declared object
          --  must be passed to the function. Currently we limit such functions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 69a042115c9..6ceffdf8302 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -564,10 +564,16 @@  package body Exp_Ch4 is
 
       procedure Build_Aggregate_In_Place (Temp : Entity_Id; Typ : Entity_Id);
       --  If Exp is an aggregate to build in place, build the declaration of
-      --  Temp with Typ and with expression an uninitialized allocator for
-      --  Etype (Exp), then perform an in-place aggregate assignment of Exp
+      --  Temp with Typ and initializing expression an uninitialized allocator
+      --  for Etype (Exp), then perform an in-place aggregate assignment of Exp
       --  into the allocated memory.
 
+      procedure Build_Explicit_Assignment (Temp : Entity_Id; Typ : Entity_Id);
+      --  If Exp is a conditional expression whose expansion has been delayed,
+      --  build the declaration of Temp with Typ and initializing expression an
+      --  uninitialized allocator for Etype (Exp), then perform an assignment
+      --  of Exp into the allocated memory.
+
       ------------------------------
       -- Build_Aggregate_In_Place --
       ------------------------------
@@ -598,13 +604,58 @@  package body Exp_Ch4 is
          Convert_Aggr_In_Allocator (N, Temp);
       end Build_Aggregate_In_Place;
 
+      -------------------------------
+      -- Build_Explicit_Assignment --
+      -------------------------------
+
+      procedure Build_Explicit_Assignment (Temp : Entity_Id; Typ : Entity_Id)
+      is
+         Assign : constant Node_Id :=
+           Make_Assignment_Statement (Loc,
+             Name       =>
+               Make_Explicit_Dereference (Loc,
+                 New_Occurrence_Of (Temp, Loc)),
+             Expression => Relocate_Node (Exp));
+
+         Temp_Decl : constant Node_Id :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Temp,
+             Object_Definition   => New_Occurrence_Of (Typ, Loc),
+             Expression          =>
+               Make_Allocator (Loc,
+                 Expression => New_Occurrence_Of (Etype (Exp), Loc)));
+
+      begin
+         --  Prevent default initialization of the allocator
+
+         Set_No_Initialization (Expression (Temp_Decl));
+
+         --  Copy the Comes_From_Source flag onto the allocator since logically
+         --  this allocator is a replacement of the original allocator. This is
+         --  for proper handling of restriction No_Implicit_Heap_Allocations.
+
+         Preserve_Comes_From_Source (Expression (Temp_Decl), N);
+
+         --  Insert the declaration
+
+         Insert_Action (N, Temp_Decl);
+
+         --  Arrange for the expression to be analyzed again and expanded
+
+         Set_Assignment_OK (Name (Assign));
+         Set_Analyzed (Expression (Assign), False);
+         Set_No_Finalize_Actions (Assign);
+         Insert_Action (N, Assign);
+      end Build_Explicit_Assignment;
+
       --  Local variables
 
-      Adj_Call      : Node_Id;
-      Aggr_In_Place : Boolean;
-      Node          : Node_Id;
-      Temp          : Entity_Id;
-      Temp_Decl     : Node_Id;
+      Adj_Call          : Node_Id;
+      Aggr_In_Place     : Boolean;
+      Delayed_Cond_Expr : Boolean;
+      Node              : Node_Id;
+      Temp              : Entity_Id;
+      Temp_Decl         : Node_Id;
 
       TagT : Entity_Id := Empty;
       --  Type used as source for tag assignment
@@ -631,13 +682,16 @@  package body Exp_Ch4 is
 
       Apply_Constraint_Check (Exp, T, No_Sliding => True);
 
-      Aggr_In_Place := Is_Delayed_Aggregate (Exp);
+      Aggr_In_Place     := Is_Delayed_Aggregate (Exp);
+      Delayed_Cond_Expr := Is_Delayed_Conditional_Expression (Exp);
 
       --  If the expression is an aggregate to be built in place, then we need
       --  to delay applying predicate checks, because this would result in the
-      --  creation of a temporary, which is illegal for limited types,
+      --  creation of a temporary, which is illegal for limited types and just
+      --  inefficient in the other cases. Likewise for a conditional expression
+      --  whose expansion has been delayed.
 
-      if not Aggr_In_Place then
+      if not Aggr_In_Place and then not Delayed_Cond_Expr then
          Apply_Predicate_Check (Exp, T);
       end if;
 
@@ -741,6 +795,7 @@  package body Exp_Ch4 is
          --  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)
@@ -793,6 +848,9 @@  package body Exp_Ch4 is
             if Aggr_In_Place then
                Build_Aggregate_In_Place (Temp, PtrT);
 
+            elsif Delayed_Cond_Expr then
+               Build_Explicit_Assignment (Temp, PtrT);
+
             else
                Node := Relocate_Node (N);
                Set_Analyzed (Node);
@@ -845,6 +903,9 @@  package body Exp_Ch4 is
                if Aggr_In_Place then
                   Build_Aggregate_In_Place (Temp, Def_Id);
 
+               elsif Delayed_Cond_Expr then
+                  Build_Explicit_Assignment (Temp, Def_Id);
+
                else
                   Node := Relocate_Node (N);
                   Set_Analyzed (Node);
@@ -940,6 +1001,7 @@  package body Exp_Ch4 is
            and then Needs_Finalization (T)
            and then not Is_Inherently_Limited_Type (T)
            and then not Aggr_In_Place
+           and then not Delayed_Cond_Expr
            and then Nkind (Exp) /= N_Function_Call
            and then not Special_Return
          then
@@ -975,7 +1037,7 @@  package body Exp_Ch4 is
          Rewrite (N, New_Occurrence_Of (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
 
-         if Aggr_In_Place then
+         if Aggr_In_Place or else Delayed_Cond_Expr then
             Apply_Predicate_Check (N, T, Deref => True);
          end if;
 
@@ -1003,6 +1065,19 @@  package body Exp_Ch4 is
             Apply_Predicate_Check (N, T, Deref => True);
          end if;
 
+      --  If the initialization expression is a conditional expression whose
+      --  expansion has been delayed, assign it explicitly to the allocator,
+      --  but only after analyzing it again and expanding it.
+
+      elsif Delayed_Cond_Expr then
+         Temp := Make_Temporary (Loc, 'P', N);
+         Build_Explicit_Assignment (Temp, PtrT);
+         Build_Allocate_Deallocate_Proc (Declaration_Node (Temp), Mark => N);
+         Rewrite (N, New_Occurrence_Of (Temp, Loc));
+         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);
 
@@ -4886,6 +4961,32 @@  package body Exp_Ch4 is
    ------------------------------
 
    procedure Expand_N_Case_Expression (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+      Par : constant Node_Id    := Parent (N);
+      Typ : constant Entity_Id  := Etype (N);
+
+      In_Predicate : constant Boolean :=
+        Ekind (Current_Scope) in E_Function | E_Procedure
+          and then Is_Predicate_Function (Current_Scope);
+      --  Flag set when the case expression appears within a predicate
+
+      Optimize_Return_Stmt : constant Boolean :=
+        Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
+      --  Small optimization: when the case expression appears in the context
+      --  of a simple return statement, expand into
+
+      --    case X is
+      --       when A =>
+      --          return AX;
+      --       when B =>
+      --          return BX;
+      --       ...
+      --    end case;
+
+      --  This makes the expansion much easier when expressions are calls to
+      --  a BIP function. But do not perform it when the return statement is
+      --  within a predicate function, as this causes spurious errors.
+
       function Is_Copy_Type (Typ : Entity_Id) return Boolean;
       --  Return True if we can copy objects of this type when expanding a case
       --  expression.
@@ -4909,10 +5010,6 @@  package body Exp_Ch4 is
 
       --  Local variables
 
-      Loc : constant Source_Ptr := Sloc (N);
-      Par : constant Node_Id    := Parent (N);
-      Typ : constant Entity_Id  := Etype (N);
-
       Acts       : List_Id;
       Alt        : Node_Id;
       Case_Stmt  : Node_Id;
@@ -4920,16 +5017,39 @@  package body Exp_Ch4 is
       Target     : Entity_Id := Empty;
       Target_Typ : Entity_Id;
 
-      In_Predicate : Boolean := False;
-      --  Flag set when the case expression appears within a predicate
+      Optimize_Assignment_Stmt : Boolean;
+      --  Small optimization: when the case expression appears in the context
+      --  of a safe assignment statement, expand into
 
-      Optimize_Return_Stmt : Boolean := False;
-      --  Flag set when the case expression can be optimized in the context of
-      --  a simple return statement.
+      --    case X is
+      --       when A =>
+      --          lhs := AX;
+      --       when B =>
+      --          lhs := BX;
+      --       ...
+      --    end case;
+
+      --  This makes the expansion much more efficient in the context of an
+      --  aggregate converted into assignments.
 
    --  Start of processing for Expand_N_Case_Expression
 
    begin
+      --  If the expansion of the expression has been delayed, we wait for the
+      --  rewriting of its parent as an assignment statement; when that's done,
+      --  we optimize the assignment (the very purpose of the manipulation).
+
+      if Expansion_Delayed (N) then
+         if Nkind (Par) /= N_Assignment_Statement then
+            return;
+         end if;
+
+         Optimize_Assignment_Stmt := True;
+
+      else
+         Optimize_Assignment_Stmt := False;
+      end if;
+
       --  Check for MINIMIZED/ELIMINATED overflow mode
 
       if Minimized_Eliminated_Overflow_Check (N) then
@@ -4941,15 +5061,11 @@  package body Exp_Ch4 is
       --  to which it applies has a static predicate aspect, do not expand,
       --  because it will be converted to the proper predicate form later.
 
-      if Ekind (Current_Scope) in E_Function | E_Procedure
-        and then Is_Predicate_Function (Current_Scope)
+      if In_Predicate
+        and then
+          Has_Static_Predicate_Aspect (Etype (First_Entity (Current_Scope)))
       then
-         In_Predicate := True;
-
-         if Has_Static_Predicate_Aspect (Etype (First_Entity (Current_Scope)))
-         then
-            return;
-         end if;
+         return;
       end if;
 
       --  When the type of the case expression is elementary, expand
@@ -5002,24 +5118,6 @@  package body Exp_Ch4 is
       Set_From_Conditional_Expression (Case_Stmt);
       Acts := New_List;
 
-      --  Small optimization: when the case expression appears in the context
-      --  of a simple return statement, expand into
-
-      --    case X is
-      --       when A =>
-      --          return AX;
-      --       when B =>
-      --          return BX;
-      --       ...
-      --    end case;
-
-      --  This makes the expansion much easier when expressions are calls to
-      --  a BIP function. But do not perform it when the return statement is
-      --  within a predicate function, as this causes spurious errors.
-
-      Optimize_Return_Stmt :=
-        Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
-
       --  Scalar/Copy case
 
       if Is_Copy_Type (Typ) then
@@ -5060,7 +5158,10 @@  package body Exp_Ch4 is
       --  Generate:
       --    Target : [Ptr_]Typ;
 
-      if not Optimize_Return_Stmt then
+      if Optimize_Assignment_Stmt then
+         Remove_Side_Effects (Name (Par), Name_Req => True);
+
+      elsif not Optimize_Return_Stmt then
          Target := Make_Temporary (Loc, 'T');
 
          Decl :=
@@ -5077,24 +5178,42 @@  package body Exp_Ch4 is
       Alt := First (Alternatives (N));
       while Present (Alt) loop
          declare
-            Alt_Expr : Node_Id             := Expression (Alt);
+            Alt_Expr : Node_Id             := Relocate_Node (Expression (Alt));
             Alt_Loc  : constant Source_Ptr := Sloc (Alt_Expr);
             LHS      : Node_Id;
             Stmts    : List_Id;
 
          begin
-            --  Take the unrestricted access of the expression value for non-
-            --  scalar types. This approach avoids big copies and covers the
-            --  limited and unconstrained cases.
+            --  Generate:
+            --    lhs := AX;
+
+            if Optimize_Assignment_Stmt then
+               --  We directly copy the parent node to preserve its flags
+
+               Stmts := New_List (New_Copy (Par));
+               Set_Sloc       (First (Stmts), Alt_Loc);
+               Set_Name       (First (Stmts), New_Copy_Tree (Name (Par)));
+               Set_Expression (First (Stmts), Alt_Expr);
+
+               --  If the expression is itself a conditional expression whose
+               --  expansion has been delayed, analyze it again and expand it.
+
+               if Is_Delayed_Conditional_Expression (Alt_Expr) then
+                  Set_Analyzed (Alt_Expr, False);
+               end if;
 
             --  Generate:
-            --    return AX['Unrestricted_Access];
+            --    return AX;
 
-            if Optimize_Return_Stmt then
+            elsif Optimize_Return_Stmt then
                Stmts := New_List (
                  Make_Simple_Return_Statement (Alt_Loc,
                    Expression => Alt_Expr));
 
+            --  Take the unrestricted access of the expression value for non-
+            --  scalar types. This approach avoids big copies and covers the
+            --  limited and unconstrained cases.
+
             --  Generate:
             --    Target := AX['Unrestricted_Access];
 
@@ -5150,9 +5269,9 @@  package body Exp_Ch4 is
          Next (Alt);
       end loop;
 
-      --  Rewrite the parent return statement as a case statement
+      --  Rewrite the parent statement as a case statement
 
-      if Optimize_Return_Stmt then
+      if Optimize_Assignment_Stmt or else Optimize_Return_Stmt then
          Rewrite (Par, Case_Stmt);
          Analyze (Par);
 
@@ -5332,6 +5451,26 @@  package body Exp_Ch4 is
       Par   : constant Node_Id    := Parent (N);
       Typ   : constant Entity_Id  := Etype (N);
 
+      In_Predicate : constant Boolean :=
+        Ekind (Current_Scope) in E_Function | E_Procedure
+          and then Is_Predicate_Function (Current_Scope);
+      --  Flag set when the if expression appears within a predicate
+
+      Optimize_Return_Stmt : constant Boolean :=
+        Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
+      --  Small optimization: when the if expression appears in the context of
+      --  a simple return statement, expand into
+
+      --    if cond then
+      --       return then-expr
+      --    else
+      --       return else-expr;
+      --    end if;
+
+      --  This makes the expansion much easier when expressions are calls to
+      --  a BIP function. But do not perform it when the return statement is
+      --  within a predicate function, as this causes spurious errors.
+
       Force_Expand : constant Boolean := Is_Anonymous_Access_Actual (N);
       --  Determine if we are dealing with a special case of a conditional
       --  expression used as an actual for an anonymous access type which
@@ -5365,18 +5504,44 @@  package body Exp_Ch4 is
       --  Local variables
 
       Actions : List_Id;
-      Decl    : Node_Id;
-      Expr    : Node_Id;
-      New_If  : Node_Id;
-      New_N   : Node_Id;
+      Decl     : Node_Id;
+      Expr     : Node_Id;
+      New_Else : Node_Id;
+      New_If   : Node_Id;
+      New_N    : Node_Id;
+      New_Then : Node_Id;
+
+      Optimize_Assignment_Stmt : Boolean;
+      --  Small optimization: when the if expression appears in the context of
+      --  a safe assignment statement, expand into
+
+      --    if cond then
+      --       lhs := then-expr
+      --    else
+      --       lhs := else-expr;
+      --    end if;
 
-      Optimize_Return_Stmt : Boolean := False;
-      --  Flag set when the if expression can be optimized in the context of
-      --  a simple return statement.
+      --  This makes the expansion much more efficient in the context of an
+      --  aggregate converted into assignments.
 
    --  Start of processing for Expand_N_If_Expression
 
    begin
+      --  If the expansion of the expression has been delayed, we wait for the
+      --  rewriting of its parent as an assignment statement; when that's done,
+      --  we optimize the assignment (the very purpose of the manipulation).
+
+      if Expansion_Delayed (N) then
+         if Nkind (Par) /= N_Assignment_Statement then
+            return;
+         end if;
+
+         Optimize_Assignment_Stmt := True;
+
+      else
+         Optimize_Assignment_Stmt := False;
+      end if;
+
       --  Deal with non-standard booleans
 
       Adjust_Condition (Cond);
@@ -5457,25 +5622,54 @@  package body Exp_Ch4 is
          end;
       end if;
 
-      --  Small optimization: when the if expression appears in the context of
-      --  a simple return statement, expand into
+      if Optimize_Assignment_Stmt then
+         Remove_Side_Effects (Name (Par), Name_Req => True);
 
-      --    if cond then
-      --       return then-expr
-      --    else
-      --       return else-expr;
-      --    end if;
+         --  When the "then" or "else" expressions involve controlled function
+         --  calls, generated temporaries are chained on the corresponding list
+         --  of actions. These temporaries need to be finalized after the if
+         --  expression is evaluated.
 
-      --  This makes the expansion much easier when expressions are calls to
-      --  a BIP function. But do not perform it when the return statement is
-      --  within a predicate function, as this causes spurious errors.
+         Process_Transients_In_Expression (N, Then_Actions (N));
+         Process_Transients_In_Expression (N, Else_Actions (N));
+
+         --  We directly copy the parent node to preserve its flags
+
+         New_Then := New_Copy (Par);
+         Set_Sloc       (New_Then, Sloc (Thenx));
+         Set_Name       (New_Then, New_Copy_Tree (Name (Par)));
+         Set_Expression (New_Then, Relocate_Node (Thenx));
+
+         --  If the expression is itself a conditional expression whose
+         --  expansion has been delayed, analyze it again and expand it.
 
-      Optimize_Return_Stmt :=
-        Nkind (Par) = N_Simple_Return_Statement
-          and then not (Ekind (Current_Scope) in E_Function | E_Procedure
-                         and then Is_Predicate_Function (Current_Scope));
+         if Is_Delayed_Conditional_Expression (Expression (New_Then)) then
+            Set_Analyzed (Expression (New_Then), False);
+         end if;
+
+         New_Else := New_Copy (Par);
+         Set_Sloc       (New_Else, Sloc (Elsex));
+         Set_Name       (New_Else, New_Copy_Tree (Name (Par)));
+         Set_Expression (New_Else, Relocate_Node (Elsex));
+
+         if Is_Delayed_Conditional_Expression (Expression (New_Else)) then
+            Set_Analyzed (Expression (New_Else), False);
+         end if;
 
-      if Optimize_Return_Stmt then
+         New_If :=
+           Make_Implicit_If_Statement (N,
+             Condition       => Relocate_Node (Cond),
+             Then_Statements => New_List (New_Then),
+             Else_Statements => New_List (New_Else));
+
+         --  Preserve the original context for which the if statement is
+         --  being generated. This is needed by the finalization machinery
+         --  to prevent the premature finalization of controlled objects
+         --  found within the if statement.
+
+         Set_From_Conditional_Expression (New_If);
+
+      elsif Optimize_Return_Stmt then
          --  When the "then" or "else" expressions involve controlled function
          --  calls, generated temporaries are chained on the corresponding list
          --  of actions. These temporaries need to be finalized after the if
@@ -6085,9 +6279,9 @@  package body Exp_Ch4 is
          Prepend_List (Else_Actions (N), Else_Statements (New_If));
       end if;
 
-      --  Rewrite the parent return statement as an if statement
+      --  Rewrite the parent statement as an if statement
 
-      if Optimize_Return_Stmt then
+      if Optimize_Assignment_Stmt or else Optimize_Return_Stmt then
          Rewrite (Par, New_If);
          Analyze (Par);
 
@@ -10354,9 +10548,16 @@  package body Exp_Ch4 is
 
       Apply_Constraint_Check (Operand, Target_Type, No_Sliding => True);
 
-      --  Apply possible predicate check
+      --  Apply possible predicate check but, for a delayed aggregate, the
+      --  check is effectively delayed until after the aggregate is expanded
+      --  into a series of assignments. Likewise for a conditional expression
+      --  whose expansion has been delayed.
 
-      Apply_Predicate_Check (Operand, Target_Type);
+      if not Is_Delayed_Aggregate (Operand)
+        and then not Is_Delayed_Conditional_Expression (Operand)
+      then
+         Apply_Predicate_Check (Operand, Target_Type);
+      end if;
 
       if Do_Range_Check (Operand) then
          Generate_Range_Check (Operand, Target_Type, CE_Range_Check_Failed);
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index a7021dc49bb..580723666c5 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -464,6 +464,7 @@  begin -- Gen_IL.Gen.Gen_Nodes
        (Sy (Expressions, List_Id, Default_No_List),
         Sy (Is_Elsif, Flag),
         Sm (Do_Overflow_Check, Flag),
+        Sm (Expansion_Delayed, Flag),
         Sm (Else_Actions, List_Id),
         Sm (Then_Actions, List_Id)));
 
@@ -513,7 +514,8 @@  begin -- Gen_IL.Gen.Gen_Nodes
    Cc (N_Case_Expression, N_Subexpr,
        (Sy (Expression, Node_Id, Default_Empty),
         Sy (Alternatives, List_Id, Default_No_List),
-        Sm (Do_Overflow_Check, Flag)));
+        Sm (Do_Overflow_Check, Flag),
+        Sm (Expansion_Delayed, Flag)));
 
    Cc (N_Delta_Aggregate, N_Subexpr,
        (Sy (Expression, Node_Id, Default_Empty),
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 7cad6cf1d29..228082eb823 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1322,6 +1322,8 @@  package Sinfo is
    --    assignment or initialization. When the full context is known, the
    --    target of the assignment or initialization is used to generate the
    --    left-hand side of individual assignment to each subcomponent.
+   --    Also set on conditional expressions whose dependent expressions are
+   --    nested aggregates, in order to avoid creating a temporary for them.
 
    --  Expression_Copy
    --    Present in N_Pragma_Argument_Association nodes. Contains a copy of the
@@ -4657,6 +4659,7 @@  package Sinfo is
       --  Else_Actions
       --  Is_Elsif (set if comes from ELSIF)
       --  Do_Overflow_Check
+      --  Expansion_Delayed
       --  plus fields for expression
 
       --  Expressions here is a three-element list, whose first element is the
@@ -4695,6 +4698,7 @@  package Sinfo is
       --  Alternatives (the case expression alternatives)
       --  Etype
       --  Do_Overflow_Check
+      --  Expansion_Delayed
 
       ----------------------------------------
       -- 4.5.7  Case Expression Alternative --