From: Piotr Trojanek Date: Wed, 29 Sep 2021 17:51:33 +0000 (+0200) Subject: [Ada] Move rewriting of boxes in aggregates from resolution to expansion X-Git-Tag: basepoints/gcc-13~4015 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=736f9bed34c0420063c3c01b520099711040d345;p=thirdparty%2Fgcc.git [Ada] Move rewriting of boxes in aggregates from resolution to expansion 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 index 572c6c534e52..ebc7a873ee87 100644 --- 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 index b51a3d0c17b5..527342f32d11 100644 --- 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 index 63d0217dc6fb..4f8426ab53f8 100644 --- 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;