diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2020-03-06 21:58:39 +0100 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-10 09:34:59 -0400 |
| commit | e67df677b4d7672f0e3d1055ec0443fafb3e9aee (patch) | |
| tree | 9b66c029cbcbe88d7476b1cad31669dd831e01e4 /gcc/ada/exp_aggr.adb | |
| parent | 3aeb5ebe953a78223ef7ac9abee9b7adb709b29f (diff) | |
| download | gcc-e67df677b4d7672f0e3d1055ec0443fafb3e9aee.zip gcc-e67df677b4d7672f0e3d1055ec0443fafb3e9aee.tar.gz gcc-e67df677b4d7672f0e3d1055ec0443fafb3e9aee.tar.bz2 | |
[Ada] Improve code generated for dynamic discriminated aggregate
2020-06-10 Eric Botcazou <ebotcazou@adacore.com>
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.
Diffstat (limited to 'gcc/ada/exp_aggr.adb')
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 41 |
1 files 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); |