[gcc(refs/users/aoliva/heads/testbase)] [Ada] Improve code generated for dynamic discriminated aggregate

[Alexandre Oliva]

https://gcc.gnu.org/g:e67df677b4d7672f0e3d1055ec0443fafb3e9aee

commit e67df677b4d7672f0e3d1055ec0443fafb3e9aee
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Fri Mar 6 21:58:39 2020 +0100

    [Ada] Improve code generated for dynamic discriminated aggregate
    
    2020-06-10  Eric Botcazou  <ebotcazou@adacore.com>
    
    gcc/ada/
    
            * exp_aggr.adb (In_Place_Assign_OK): Do not necessarily return
            false for a type with discriminants.
            (Convert_To_Assignments): Use Parent_Node and Parent_Kind more
            consistently.  In the in-place assignment case, first apply a
            discriminant check if need be, and be prepared for a rewritten
            aggregate as a result.

Diff:
---
 gcc/ada/exp_aggr.adb | 41 ++++++++++++++++++++++++++---------------
 1 file changed, 26 insertions(+), 15 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 3a74d0679f0..c537bac0e01 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4283,12 +4283,9 @@ package body Exp_Aggr is
    --  Start of processing for In_Place_Assign_OK
 
    begin
-      --  By-copy semantic cannot be guaranteed for controlled objects or
-      --  objects with discriminants.
+      --  By-copy semantic cannot be guaranteed for controlled objects
 
-      if Needs_Finalization (Etype (N))
-        or else Has_Discriminants (Etype (N))
-      then
+      if Needs_Finalization (Etype (N)) then
          return False;
 
       elsif Is_Array and then Present (Component_Associations (N)) then
@@ -4465,26 +4462,40 @@ package body Exp_Aggr is
       --  assignment.
 
       if Is_Limited_Type (Typ)
-        and then Nkind (Parent (N)) = N_Assignment_Statement
+        and then Parent_Kind = N_Assignment_Statement
       then
-         Target_Expr := New_Copy_Tree (Name (Parent (N)));
-         Insert_Actions (Parent (N),
+         Target_Expr := New_Copy_Tree (Name (Parent_Node));
+         Insert_Actions (Parent_Node,
            Build_Record_Aggr_Code (N, Typ, Target_Expr));
-         Rewrite (Parent (N), Make_Null_Statement (Loc));
+         Rewrite (Parent_Node, Make_Null_Statement (Loc));
 
       --  Do not declare a temporary to initialize an aggregate assigned to an
       --  identifier when in-place assignment is possible, preserving the
       --  by-copy semantic of aggregates. This avoids large stack usage and
       --  generates more efficient code.
 
-      elsif Nkind (Parent (N)) = N_Assignment_Statement
-        and then Nkind (Name (Parent (N))) = N_Identifier
+      elsif Parent_Kind = N_Assignment_Statement
+        and then Nkind (Name (Parent_Node)) = N_Identifier
         and then In_Place_Assign_OK (N)
       then
-         Target_Expr := New_Copy_Tree (Name (Parent (N)));
-         Insert_Actions (Parent (N),
-           Build_Record_Aggr_Code (N, Typ, Target_Expr));
-         Rewrite (Parent (N), Make_Null_Statement (Loc));
+         declare
+            Lhs : constant Node_Id := Name (Parent_Node);
+         begin
+            --  Apply discriminant check if required
+
+            if Has_Discriminants (Etype (N)) then
+               Apply_Discriminant_Check (N, Etype (Lhs), Lhs);
+            end if;
+
+            --  The check just above may have replaced the aggregate with a CE
+
+            if Nkind_In (N, N_Aggregate, N_Extension_Aggregate) then
+               Target_Expr := New_Copy_Tree (Lhs);
+               Insert_Actions (Parent_Node,
+                 Build_Record_Aggr_Code (N, Typ, Target_Expr));
+               Rewrite (Parent_Node, Make_Null_Statement (Loc));
+            end if;
+         end;
 
       else
          Temp := Make_Temporary (Loc, 'A', N);