From e67df677b4d7672f0e3d1055ec0443fafb3e9aee Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 6 Mar 2020 21:58:39 +0100 Subject: [PATCH] [Ada] Improve code generated for dynamic discriminated aggregate 2020-06-10 Eric Botcazou gcc/ada/ * exp_aggr.adb (In_Place_Assign_OK): Do not necessarily return false for a type with discriminants. (Convert_To_Assignments): Use Parent_Node and Parent_Kind more consistently. In the in-place assignment case, first apply a discriminant check if need be, and be prepared for a rewritten aggregate as a result. --- gcc/ada/exp_aggr.adb | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 3a74d06..c537bac 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4283,12 +4283,9 @@ package body Exp_Aggr is -- Start of processing for In_Place_Assign_OK begin - -- By-copy semantic cannot be guaranteed for controlled objects or - -- objects with discriminants. + -- By-copy semantic cannot be guaranteed for controlled objects - if Needs_Finalization (Etype (N)) - or else Has_Discriminants (Etype (N)) - then + if Needs_Finalization (Etype (N)) then return False; elsif Is_Array and then Present (Component_Associations (N)) then @@ -4465,26 +4462,40 @@ package body Exp_Aggr is -- assignment. if Is_Limited_Type (Typ) - and then Nkind (Parent (N)) = N_Assignment_Statement + and then Parent_Kind = N_Assignment_Statement then - Target_Expr := New_Copy_Tree (Name (Parent (N))); - Insert_Actions (Parent (N), + Target_Expr := New_Copy_Tree (Name (Parent_Node)); + Insert_Actions (Parent_Node, Build_Record_Aggr_Code (N, Typ, Target_Expr)); - Rewrite (Parent (N), Make_Null_Statement (Loc)); + Rewrite (Parent_Node, Make_Null_Statement (Loc)); -- Do not declare a temporary to initialize an aggregate assigned to an -- identifier when in-place assignment is possible, preserving the -- by-copy semantic of aggregates. This avoids large stack usage and -- generates more efficient code. - elsif Nkind (Parent (N)) = N_Assignment_Statement - and then Nkind (Name (Parent (N))) = N_Identifier + elsif Parent_Kind = N_Assignment_Statement + and then Nkind (Name (Parent_Node)) = N_Identifier and then In_Place_Assign_OK (N) then - Target_Expr := New_Copy_Tree (Name (Parent (N))); - Insert_Actions (Parent (N), - Build_Record_Aggr_Code (N, Typ, Target_Expr)); - Rewrite (Parent (N), Make_Null_Statement (Loc)); + declare + Lhs : constant Node_Id := Name (Parent_Node); + begin + -- Apply discriminant check if required + + if Has_Discriminants (Etype (N)) then + Apply_Discriminant_Check (N, Etype (Lhs), Lhs); + end if; + + -- The check just above may have replaced the aggregate with a CE + + if Nkind_In (N, N_Aggregate, N_Extension_Aggregate) then + Target_Expr := New_Copy_Tree (Lhs); + Insert_Actions (Parent_Node, + Build_Record_Aggr_Code (N, Typ, Target_Expr)); + Rewrite (Parent_Node, Make_Null_Statement (Loc)); + end if; + end; else Temp := Make_Temporary (Loc, 'A', N); -- 2.7.4