From: Eric Botcazou <ebotcazou@adacore.com>
Date: Sat, 2 May 2020 15:45:21 +0000 (+0200)
Subject: [Ada] Fix check for bounds in aggregate expansion of allocator
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d0e9248d9b8cddcf38faa096d62ddb7f129d3431;p=gcc.git

[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.
---

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 22ed3aeddeb..95f0ddad990 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