The predicate function In_Place_Assign_OK is responsible for finding
out whether the in-place assignment of an aggregate is possible; for
array aggregates, it checks among other things whether sliding will
occur during the assignment.
But, in an allocator context, it does so by comparing the bounds of
the aggregate with those of the qualified expression surrounding it.
Now Constraint_Error is already guaranteed to be raised if they do
not match, so there is no point in doing it and the check must be
made against the bounds of the designated type instead.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-19 Eric Botcazou <ebotca...@adacore.com>
gcc/ada/
* exp_aggr.adb (In_Place_Assign_OK): In an allocator context,
check the bounds of an array aggregate against those of the
designated type, except if the latter is unconstrained.--- gcc/ada/exp_aggr.adb
+++ gcc/ada/exp_aggr.adb
@@ -4429,15 +4429,26 @@ package body Exp_Aggr is
then
Aggr_In := First_Index (Etype (N));
+ -- Context is an assignment
+
if Parent_Kind = N_Assignment_Statement then
Obj_In := First_Index (Etype (Name (Parent_Node)));
- else
- -- Context is an allocator. Check bounds of aggregate against
- -- given type in qualified expression.
+ -- Context is an allocator. Check the bounds of the aggregate against
+ -- those of the designated type, except in the case where the type is
+ -- unconstrained (and then we can directly return true, see below).
+
+ else pragma Assert (Parent_Kind = N_Allocator);
+ declare
+ Desig_Typ : constant Entity_Id :=
+ Designated_Type (Etype (Parent_Node));
+ begin
+ if not Is_Constrained (Desig_Typ) then
+ return True;
+ end if;
- pragma Assert (Parent_Kind = N_Allocator);
- Obj_In := First_Index (Etype (Entity (Subtype_Mark (Parent (N)))));
+ Obj_In := First_Index (Desig_Typ);
+ end;
end if;
while Present (Aggr_In) loop
