diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2020-05-02 17:45:21 +0200 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-19 04:17:26 -0400 |
commit | d0e9248d9b8cddcf38faa096d62ddb7f129d3431 (patch) | |
tree | 9120940fd77d5a98b26a0db51d4a49e76cff9f78 | |
parent | ce716aaaa3efb464af4caa16d8f75814c401b593 (diff) | |
download | gcc-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.adb | 21 |
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 |