[Ada] Move rewriting of boxes in aggregates from resolution to expansion

[Ada] Move rewriting of boxes in aggregates from resolution to expansion

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 1127 bytes --]

Rewriting of boxes in record aggregates into the corresponding default
values was done in resolution, where we special-cased access types and
scalar types with a Default_Value aspect.

However, this rewriting rather belong to expansion. Also, the
special-casing didn't take Normalize_Scalars nor Initialize_Scalars
pragmas into account and it didn't work for private types.

Now the resolution keeps boxes that require simple initialization, while
expansion reuses existing routines for initialization of record types.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* exp_aggr.adb (Initialize_Record_Component): Add assertion
	about one of the parameters, so that illegal attempts to
	initialize record components with Empty node are detected early
	on.
	(Build_Record_Aggr_Code): Handle boxes in aggregate component
	associations just the components with no initialization in
	Build_Record_Init_Proc.
	* sem_aggr.adb (Resolve_Record_Aggregate): For components that
	require simple initialization carry boxes from resolution to
	expansion.
	* sem_util.adb (Needs_Simple_Initialization): Remove redundant
	paren.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 5632 bytes --]

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -3209,6 +3209,8 @@ package body Exp_Aggr is
          Init_Stmt : Node_Id;
 
       begin
+         pragma Assert (Nkind (Init_Expr) in N_Subexpr);
+
          --  Protect the initialization statements from aborts. Generate:
 
          --    Abort_Defer;
@@ -3793,6 +3795,26 @@ package body Exp_Aggr is
                 With_Default_Init => True,
                 Constructor_Ref   => Expression (Comp)));
 
+         elsif Box_Present (Comp)
+           and then Needs_Simple_Initialization (Etype (Selector))
+         then
+            Comp_Expr :=
+              Make_Selected_Component (Loc,
+                Prefix        => New_Copy_Tree (Target),
+                Selector_Name => New_Occurrence_Of (Selector, Loc));
+
+            Initialize_Record_Component
+              (Rec_Comp  => Comp_Expr,
+               Comp_Typ  => Etype (Selector),
+               Init_Expr => Get_Simple_Init_Val
+                              (Typ  => Etype (Selector),
+                               N    => Comp,
+                               Size =>
+                                 (if Known_Esize (Selector)
+                                  then Esize (Selector)
+                                  else Uint_0)),
+               Stmts     => L);
+
          --  Ada 2005 (AI-287): For each default-initialized component generate
          --  a call to the corresponding IP subprogram if available.
 


diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -5387,74 +5387,12 @@ package body Sem_Aggr is
                      Assoc_List => New_Assoc_List);
                   Set_Has_Self_Reference (N);
 
-               --  A box-defaulted access component gets the value null. Also
-               --  included are components of private types whose underlying
-               --  type is an access type. In either case set the type of the
-               --  literal, for subsequent use in semantic checks.
-
-               elsif Present (Underlying_Type (Ctyp))
-                 and then Is_Access_Type (Underlying_Type (Ctyp))
-               then
-                  --  If the component's type is private with an access type as
-                  --  its underlying type then we have to create an unchecked
-                  --  conversion to satisfy type checking.
-
-                  if Is_Private_Type (Ctyp) then
-                     declare
-                        Qual_Null : constant Node_Id :=
-                                      Make_Qualified_Expression (Sloc (N),
-                                        Subtype_Mark =>
-                                          New_Occurrence_Of
-                                            (Underlying_Type (Ctyp), Sloc (N)),
-                                        Expression   => Make_Null (Sloc (N)));
-
-                        Convert_Null : constant Node_Id :=
-                                         Unchecked_Convert_To
-                                           (Ctyp, Qual_Null);
-
-                     begin
-                        Analyze_And_Resolve (Convert_Null, Ctyp);
-                        Add_Association
-                          (Component  => Component,
-                           Expr       => Convert_Null,
-                           Assoc_List => New_Assoc_List);
-                     end;
-
-                  --  Otherwise the component type is non-private
-
-                  else
-                     Expr := Make_Null (Sloc (N));
-                     Set_Etype (Expr, Ctyp);
-
-                     Add_Association
-                       (Component  => Component,
-                        Expr       => Expr,
-                        Assoc_List => New_Assoc_List);
-                  end if;
-
-               --  Ada 2012: If component is scalar with default value, use it
-               --  by converting it to Ctyp, so that subtype constraints are
-               --  checked.
-
-               elsif Is_Scalar_Type (Ctyp)
-                 and then Has_Default_Aspect (Ctyp)
-               then
-                  declare
-                     Conv : constant Node_Id :=
-                       Convert_To
-                         (Typ  => Ctyp,
-                          Expr =>
-                            New_Copy_Tree
-                              (Default_Aspect_Value
-                                 (First_Subtype (Underlying_Type (Ctyp)))));
-
-                  begin
-                     Analyze_And_Resolve (Conv, Ctyp);
-                     Add_Association
-                       (Component  => Component,
-                        Expr       => Conv,
-                        Assoc_List => New_Assoc_List);
-                  end;
+               elsif Needs_Simple_Initialization (Ctyp) then
+                  Add_Association
+                    (Component      => Component,
+                     Expr           => Empty,
+                     Assoc_List     => New_Assoc_List,
+                     Is_Box_Present => True);
 
                elsif Has_Non_Null_Base_Init_Proc (Ctyp)
                  or else not Expander_Active


diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -23121,7 +23121,7 @@ package body Sem_Util is
       --  types.
 
       elsif Is_Access_Type (Typ)
-        or else (Consider_IS_NS and then (Is_Scalar_Type (Typ)))
+        or else (Consider_IS_NS and then Is_Scalar_Type (Typ))
       then
          return True;