From: Eric Botcazou <ebotca...@adacore.com> This avoids repeatedly calling Unqualify on the same node, removes a dead call to Generate_Finalization_Actions, a redundant setting of Assignment_OK and reuses a local variable more consistently. No functional changes.
gcc/ada/ * exp_aggr.adb (Build_Record_Aggr_Code): Add new variable Ancestor_Q to store the result of Unqualify on Ancestor. Remove the dead call to Generate_Finalization_Actions in the case of another aggregate as ancestor part. Remove the redundant setting of Assignment_OK. Use Init_Typ in lieu of Etype (Ancestor) more consistently. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 36 +++++++++++++++--------------------- 1 file changed, 15 insertions(+), 21 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 15230571123..dcbf2c4981d 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2907,12 +2907,14 @@ package body Exp_Aggr is if Nkind (N) = N_Extension_Aggregate then declare - Ancestor : constant Node_Id := Ancestor_Part (N); + Ancestor : constant Node_Id := Ancestor_Part (N); + Ancestor_Q : constant Node_Id := Unqualify (Ancestor); + Adj_Call : Node_Id; Assign : List_Id; begin - -- If the ancestor part is a subtype mark "T", we generate + -- If the ancestor part is a subtype mark T, we generate -- init-proc (T (tmp)); if T is constrained and -- init-proc (S (tmp)); where S applies an appropriate @@ -3036,28 +3038,22 @@ package body Exp_Aggr is -- qualified). elsif Is_Limited_Type (Etype (Ancestor)) - and then Nkind (Unqualify (Ancestor)) in - N_Aggregate | N_Extension_Aggregate + and then Nkind (Ancestor_Q) in N_Aggregate + | N_Extension_Aggregate then - -- Set up finalization data for enclosing record, because - -- controlled subcomponents of the ancestor part will be - -- attached to it. - - Generate_Finalization_Actions; - Append_List_To (L, Build_Record_Aggr_Code - (N => Unqualify (Ancestor), - Typ => Etype (Unqualify (Ancestor)), + (N => Ancestor_Q, + Typ => Etype (Ancestor_Q), Lhs => Target)); - -- If the ancestor part is an expression "E", we generate + -- If the ancestor part is an expression E of type T, we generate -- T (tmp) := E; -- In Ada 2005, this includes the case of a (possibly qualified) - -- limited function call. The assignment will turn into a - -- build-in-place function call (for further details, see + -- limited function call. The assignment will later be turned into + -- a build-in-place function call (for further details, see -- Make_Build_In_Place_Call_In_Assignment). else @@ -3067,15 +3063,13 @@ package body Exp_Aggr is -- If the ancestor part is an aggregate, force its full -- expansion, which was delayed. - if Nkind (Unqualify (Ancestor)) in - N_Aggregate | N_Extension_Aggregate + if Nkind (Ancestor_Q) in N_Aggregate | N_Extension_Aggregate then Set_Analyzed (Ancestor, False); Set_Analyzed (Expression (Ancestor), False); end if; Ref := Convert_To (Init_Typ, New_Copy_Tree (Target)); - Set_Assignment_OK (Ref); -- Make the assignment without usual controlled actions, since -- we only want to Adjust afterwards, but not to Finalize @@ -3112,14 +3106,14 @@ package body Exp_Aggr is -- Call Adjust manually - if Needs_Finalization (Etype (Ancestor)) - and then not Is_Limited_Type (Etype (Ancestor)) + if Needs_Finalization (Init_Typ) + and then not Is_Limited_Type (Init_Typ) and then not Is_Build_In_Place_Function_Call (Ancestor) then Adj_Call := Make_Adjust_Call (Obj_Ref => New_Copy_Tree (Ref), - Typ => Etype (Ancestor)); + Typ => Init_Typ); -- Guard against a missing [Deep_]Adjust when the ancestor -- type was not properly frozen. -- 2.40.0