OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Improve code generated for dynamic discriminated aggregate

Browse Source 
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.
This commit is contained in:
Eric Botcazou 2020-03-06 21:58:39 +01:00 committed by Pierre-Marie de Rodat
parent 3aeb5ebe95
commit e67df677b4
1 changed files with 26 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/exp_aggr.adb
View File

@ -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);