[Ada] Fix expansion of aggregates components rewritten to raise statements

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bde7a0e..afee8f4 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index b8955d7..27aa0d4 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -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.