[Ada] Wrong replacement of Component.Discriminant

gcc/ada/

	* exp_ch3.adb (Replace_Discr_Ref): Removed, no longer needed.
This commit is contained in:
Arnaud Charlet 2020-11-15 11:20:42 -05:00 committed by Pierre-Marie de Rodat
parent 1c4dfafe68
commit 19b95c22c0

View File

@ -2008,47 +2008,6 @@ package body Exp_Ch3 is
Lhs : Node_Id;
Res : List_Id;
function Replace_Discr_Ref (N : Node_Id) return Traverse_Result;
-- Analysis of the aggregate has replaced discriminants by their
-- corresponding discriminals, but these are irrelevant when the
-- component has a mutable type and is initialized with an aggregate.
-- Instead, they must be replaced by the values supplied in the
-- aggregate, that will be assigned during the expansion of the
-- assignment.
-----------------------
-- Replace_Discr_Ref --
-----------------------
function Replace_Discr_Ref (N : Node_Id) return Traverse_Result is
Val : Node_Id;
begin
if Is_Entity_Name (N)
and then Present (Entity (N))
and then Is_Formal (Entity (N))
and then Present (Discriminal_Link (Entity (N)))
then
Val :=
Make_Selected_Component (Default_Loc,
Prefix => New_Copy_Tree (Lhs),
Selector_Name =>
New_Occurrence_Of
(Discriminal_Link (Entity (N)), Default_Loc));
if Present (Val) then
Rewrite (N, New_Copy_Tree (Val));
end if;
end if;
return OK;
end Replace_Discr_Ref;
procedure Replace_Discriminant_References is
new Traverse_Proc (Replace_Discr_Ref);
-- Start of processing for Build_Assignment
begin
Lhs :=
Make_Selected_Component (Default_Loc,
@ -2056,22 +2015,6 @@ package body Exp_Ch3 is
Selector_Name => New_Occurrence_Of (Id, Default_Loc));
Set_Assignment_OK (Lhs);
if Nkind (Exp) = N_Aggregate
and then Has_Discriminants (Typ)
and then not Is_Constrained (Base_Type (Typ))
then
-- The aggregate may provide new values for the discriminants
-- of the component, and other components may depend on those
-- discriminants. Previous analysis of those expressions have
-- replaced the discriminants by the formals of the initialization
-- procedure for the type, but these are irrelevant in the
-- enclosing initialization procedure: those discriminant
-- references must be replaced by the values provided in the
-- aggregate.
Replace_Discriminant_References (Exp);
end if;
-- Case of an access attribute applied to the current instance.
-- Replace the reference to the type by a reference to the actual
-- object. (Note that this handles the case of the top level of