diff options
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 90 |
1 files changed, 28 insertions, 62 deletions
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index da31d24..270d3bb 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1060,6 +1060,7 @@ package body Exp_Aggr is Indexes : List_Id := No_List) return List_Id is Loc : constant Source_Ptr := Sloc (N); + Typ : constant Entity_Id := Etype (N); Index_Base : constant Entity_Id := Base_Type (Etype (Index)); Index_Base_L : constant Node_Id := Type_Low_Bound (Index_Base); Index_Base_H : constant Node_Id := Type_High_Bound (Index_Base); @@ -1460,7 +1461,7 @@ package body Exp_Aggr is and then not (Is_Array_Type (Comp_Typ) and then Needs_Finalization (Component_Type (Comp_Typ)) - and then Nkind (Expr) = N_Aggregate) + and then Nkind (Unqualify (Init_Expr)) = N_Aggregate) then Adj_Call := Make_Adjust_Call @@ -1522,9 +1523,10 @@ package body Exp_Aggr is Init_Expr : Node_Id; Stmts : List_Id) is + Init_Expr_Q : constant Node_Id := Unqualify (Init_Expr); + Act_Aggr : Node_Id; Act_Stmts : List_Id; - Expr : Node_Id; Fin_Call : Node_Id; Hook_Clear : Node_Id; @@ -1533,29 +1535,20 @@ package body Exp_Aggr is -- in-place expansion. begin - -- Duplicate the initialization expression in case the context is - -- a multi choice list or an "others" choice which plugs various - -- holes in the aggregate. As a result the expression is no longer - -- shared between the various components and is reevaluated for - -- each such component. - - Expr := New_Copy_Tree (Init_Expr); - Set_Parent (Expr, Parent (Init_Expr)); - -- Perform a preliminary analysis and resolution to determine what -- the initialization expression denotes. An unanalyzed function -- call may appear as an identifier or an indexed component. - if Nkind (Expr) in N_Function_Call - | N_Identifier - | N_Indexed_Component - and then not Analyzed (Expr) + if Nkind (Init_Expr_Q) in N_Function_Call + | N_Identifier + | N_Indexed_Component + and then not Analyzed (Init_Expr) then - Preanalyze_And_Resolve (Expr, Comp_Typ); + Preanalyze_And_Resolve (Init_Expr, Comp_Typ); end if; In_Place_Expansion := - Nkind (Expr) = N_Function_Call + Nkind (Init_Expr_Q) = N_Function_Call and then not Is_Build_In_Place_Result_Type (Comp_Typ); -- The initialization expression is a controlled function call. @@ -1572,7 +1565,7 @@ package body Exp_Aggr is -- generation of a transient scope, which leads to out-of-order -- adjustment and finalization. - Set_No_Side_Effect_Removal (Expr); + Set_No_Side_Effect_Removal (Init_Expr); -- When the transient component initialization is related to a -- range or an "others", keep all generated statements within @@ -1598,7 +1591,7 @@ package body Exp_Aggr is Process_Transient_Component (Loc => Loc, Comp_Typ => Comp_Typ, - Init_Expr => Expr, + Init_Expr => Init_Expr, Fin_Call => Fin_Call, Hook_Clear => Hook_Clear, Aggr => Act_Aggr, @@ -1613,7 +1606,7 @@ package body Exp_Aggr is Initialize_Array_Component (Arr_Comp => Arr_Comp, Comp_Typ => Comp_Typ, - Init_Expr => Expr, + Init_Expr => Init_Expr, Stmts => Stmts); -- At this point the array element is fully initialized. Complete @@ -1676,13 +1669,7 @@ package body Exp_Aggr is -- Ada 2005 (AI-287): In case of default initialized component, Expr -- is not present (and therefore we also initialize Expr_Q to empty). - if No (Expr) then - Expr_Q := Empty; - elsif Nkind (Expr) = N_Qualified_Expression then - Expr_Q := Expression (Expr); - else - Expr_Q := Expr; - end if; + Expr_Q := Unqualify (Expr); if Present (Etype (N)) and then Etype (N) /= Any_Composite then Comp_Typ := Component_Type (Etype (N)); @@ -1815,7 +1802,7 @@ package body Exp_Aggr is if Present (Comp_Typ) and then Needs_Finalization (Comp_Typ) - and then Nkind (Expr) /= N_Aggregate + and then Nkind (Expr_Q) /= N_Aggregate then Initialize_Ctrl_Array_Component (Arr_Comp => Indexed_Comp, @@ -2298,7 +2285,6 @@ package body Exp_Aggr is Assoc : Node_Id; Choice : Node_Id; Expr : Node_Id; - Typ : constant Entity_Id := Etype (N); Bounds : Range_Nodes; Low : Node_Id renames Bounds.First; @@ -3143,6 +3129,8 @@ package body Exp_Aggr is Init_Expr : Node_Id; Stmts : List_Id) is + Init_Expr_Q : constant Node_Id := Unqualify (Init_Expr); + Fin_Call : Node_Id; Hook_Clear : Node_Id; @@ -3155,16 +3143,16 @@ package body Exp_Aggr is -- the initialization expression denotes. Unanalyzed function calls -- may appear as identifiers or indexed components. - if Nkind (Init_Expr) in N_Function_Call - | N_Identifier - | N_Indexed_Component + if Nkind (Init_Expr_Q) in N_Function_Call + | N_Identifier + | N_Indexed_Component and then not Analyzed (Init_Expr) then Preanalyze_And_Resolve (Init_Expr, Comp_Typ); end if; In_Place_Expansion := - Nkind (Init_Expr) = N_Function_Call + Nkind (Init_Expr_Q) = N_Function_Call and then not Is_Build_In_Place_Result_Type (Comp_Typ); -- The initialization expression is a controlled function call. @@ -3919,11 +3907,7 @@ package body Exp_Aggr is Prefix => New_Copy_Tree (Target), Selector_Name => New_Occurrence_Of (Selector, Loc)); - if Nkind (Expression (Comp)) = N_Qualified_Expression then - Expr_Q := Expression (Expression (Comp)); - else - Expr_Q := Expression (Comp); - end if; + Expr_Q := Unqualify (Expression (Comp)); -- Now either create the assignment or generate the code for the -- inner aggregate top-down. @@ -4319,15 +4303,11 @@ package body Exp_Aggr is -------------------------------- procedure Convert_Aggr_In_Assignment (N : Node_Id) is - Aggr : Node_Id := Expression (N); + Aggr : constant Node_Id := Unqualify (Expression (N)); Typ : constant Entity_Id := Etype (Aggr); Occ : constant Node_Id := New_Copy_Tree (Name (N)); begin - if Nkind (Aggr) = N_Qualified_Expression then - Aggr := Expression (Aggr); - end if; - Insert_Actions_After (N, Late_Expansion (Aggr, Typ, Occ)); end Convert_Aggr_In_Assignment; @@ -4337,7 +4317,7 @@ package body Exp_Aggr is procedure Convert_Aggr_In_Object_Decl (N : Node_Id) is Obj : constant Entity_Id := Defining_Identifier (N); - Aggr : Node_Id := Expression (N); + Aggr : constant Node_Id := Unqualify (Expression (N)); Loc : constant Source_Ptr := Sloc (Aggr); Typ : constant Entity_Id := Etype (Aggr); Occ : constant Node_Id := New_Occurrence_Of (Obj, Loc); @@ -4417,10 +4397,6 @@ package body Exp_Aggr is begin Set_Assignment_OK (Occ); - if Nkind (Aggr) = N_Qualified_Expression then - Aggr := Expression (Aggr); - end if; - if Has_Discriminants (Typ) and then Typ /= Etype (Obj) and then Is_Constrained (Etype (Obj)) @@ -8682,11 +8658,7 @@ package body Exp_Aggr is return False; end if; - if Nkind (Expression (C)) = N_Qualified_Expression then - Expr_Q := Expression (Expression (C)); - else - Expr_Q := Expression (C); - end if; + Expr_Q := Unqualify (Expression (C)); -- Return False for array components whose bounds raise -- constraint error. @@ -9085,17 +9057,11 @@ package body Exp_Aggr is -------------------------- function Is_Delayed_Aggregate (N : Node_Id) return Boolean is - Node : Node_Id := N; - Kind : Node_Kind := Nkind (Node); + Unqual_N : constant Node_Id := Unqualify (N); begin - if Kind = N_Qualified_Expression then - Node := Expression (Node); - Kind := Nkind (Node); - end if; - - return Kind in N_Aggregate | N_Extension_Aggregate - and then Expansion_Delayed (Node); + return Nkind (Unqual_N) in N_Aggregate | N_Extension_Aggregate + and then Expansion_Delayed (Unqual_N); end Is_Delayed_Aggregate; -------------------------------- |