[Ada] Fix expansion of aggregates components rewritten to raise statements
authorEd Schonberg <schonberg@adacore.com>
Tue, 17 Jul 2018 08:12:14 +0000 (08:12 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 17 Jul 2018 08:12:14 +0000 (08:12 +0000)
2018-07-17  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

* exp_aggr.adb (Component_OK_For_Backend): If an array component of the
enclosing record has a bound that is out of range (and that has been
rewritten as a raise statement) the aggregate is not OK for any back
end, and should be expanded into individual assignments.

From-SVN: r262800

gcc/ada/ChangeLog
gcc/ada/exp_aggr.adb

index bde7a0eee81efdd7737b3968cda30b38da3fd9fb..afee8f4aa85bded687ff08541662ba57ee313f58 100644 (file)
@@ -1,3 +1,10 @@
+2018-07-17  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_aggr.adb (Component_OK_For_Backend): If an array component of the
+       enclosing record has a bound that is out of range (and that has been
+       rewritten as a raise statement) the aggregate is not OK for any back
+       end, and should be expanded into individual assignments.
+
 2018-07-17  Piotr Trojanek  <trojanek@adacore.com>
 
        * atree.adb (Relocate_Node): Simplify with Is_Rewrite_Substitution.
index b8955d73dd053856b1d7ef66cd36e3288a18d786..27aa0d4af6c5ec748910cd3e59d8d7ffd9794b08 100644 (file)
@@ -7238,6 +7238,34 @@ package body Exp_Aggr is
                Expr_Q := Expression (C);
             end if;
 
+            --  Return False for array components whose bounds raise
+            --  constraint error.
+
+            declare
+               Comp : Entity_Id;
+               Indx : Node_Id;
+
+            begin
+               Comp := First (Choices (C));
+               if Present (Etype (Comp))
+                 and then Is_Array_Type (Etype (Comp))
+               then
+                  Indx := First_Index (Etype (Comp));
+
+                  while Present (Indx) loop
+                     if Nkind (Type_Low_Bound (Etype (Indx)))
+                       = N_Raise_Constraint_Error
+                     or else Nkind (Type_High_Bound (Etype (Indx)))
+                       = N_Raise_Constraint_Error
+                     then
+                        return False;
+                     end if;
+
+                     Indx := Next_Index (Indx);
+                  end loop;
+               end if;
+            end;
+
             --  Return False if the aggregate has any associations for tagged
             --  components that may require tag adjustment.