From f4c2607769d476af4d340edea2e7c2f15266c3a1 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 17 Jul 2018 08:12:14 +0000 Subject: [PATCH] [Ada] Fix expansion of aggregates components rewritten to raise statements 2018-07-17 Ed Schonberg 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 | 7 +++++++ gcc/ada/exp_aggr.adb | 28 ++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) 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 + + * 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 * 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. -- 2.30.2