From: Ed Schonberg <schonberg@adacore.com>
Date: Tue, 17 Jul 2018 08:12:14 +0000 (+0000)
Subject: [Ada] Fix expansion of aggregates components rewritten to raise statements
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f4c2607769d476af4d340edea2e7c2f15266c3a1;p=gcc.git

[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 bde7a0eee81..afee8f4aa85 100644
--- 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 b8955d73dd0..27aa0d4af6c 100644
--- 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.