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.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;
