[gcc/devel/gccgo] [Ada] Fix check for bounds in aggregate expansion of allocator

Ian Lance Taylor ian@gcc.gnu.org
Sun Jul 12 19:54:22 GMT 2020


https://gcc.gnu.org/g:d0e9248d9b8cddcf38faa096d62ddb7f129d3431

commit d0e9248d9b8cddcf38faa096d62ddb7f129d3431
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Sat May 2 17:45:21 2020 +0200

    [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:
---
 gcc/ada/exp_aggr.adb | 21 ++++++++++++++++-----
 1 file changed, 16 insertions(+), 5 deletions(-)

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


More information about the Gcc-cvs mailing list