aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2020-05-02 17:45:21 +0200
committerPierre-Marie de Rodat <derodat@adacore.com>2020-06-19 04:17:26 -0400
commitd0e9248d9b8cddcf38faa096d62ddb7f129d3431 (patch)
tree9120940fd77d5a98b26a0db51d4a49e76cff9f78
parentce716aaaa3efb464af4caa16d8f75814c401b593 (diff)
downloadgcc-d0e9248d9b8cddcf38faa096d62ddb7f129d3431.zip
gcc-d0e9248d9b8cddcf38faa096d62ddb7f129d3431.tar.gz
gcc-d0e9248d9b8cddcf38faa096d62ddb7f129d3431.tar.bz2
[Ada] Fix check for bounds in aggregate expansion of allocator
2020-06-19 Eric Botcazou <ebotcazou@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.
-rw-r--r--gcc/ada/exp_aggr.adb21
1 files changed, 16 insertions, 5 deletions
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 22ed3ae..95f0dda 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/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