aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2019-07-22 13:57:18 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-22 13:57:18 +0000
commit2c26d262eb40998040308a57d420849fd764ef53 (patch)
treead86ead6ecaf4265f5c0ca53de99abe66e94e43b
parent2418e23139edd33f1cab2158b46ac9bbd81b8bd7 (diff)
downloadgcc-2c26d262eb40998040308a57d420849fd764ef53.zip
gcc-2c26d262eb40998040308a57d420849fd764ef53.tar.gz
gcc-2c26d262eb40998040308a57d420849fd764ef53.tar.bz2
[Ada] Further fix non-stored discriminant in aggregate for GNATprove
GNATprove expects discriminants appearing in aggregates and their types to be resolved to stored discriminants. This extends the machinery that makes sure this is the case for default initialization expressions so as to also handle component associations in these expressions. 2019-07-22 Eric Botcazou <ebotcazou@adacore.com> gcc/ada/ * sem_aggr.adb (Rewrite_Bound): Be prepared for discriminals too. (Rewrite_Range;): Minor tweak. (Resolve_Record_Aggregate): For a component with default initialization whose expression is an array aggregate, also rewrite the bounds of the component associations, if any. From-SVN: r273679
-rw-r--r--gcc/ada/ChangeLog9
-rw-r--r--gcc/ada/sem_aggr.adb43
2 files changed, 41 insertions, 11 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e9a4cbd..202dfc7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_aggr.adb (Rewrite_Bound): Be prepared for discriminals
+ too.
+ (Rewrite_Range;): Minor tweak.
+ (Resolve_Record_Aggregate): For a component with default
+ initialization whose expression is an array aggregate, also
+ rewrite the bounds of the component associations, if any.
+
2019-07-22 Gary Dismukes <dismukes@adacore.com>
* exp_ch5.adb (Expand_N_Case_Statement): In the case where a
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 2143cc4..7aacc5f 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -4264,8 +4264,15 @@ package body Sem_Aggr is
Expr_Disc : Node_Id)
is
begin
- if Nkind (Bound) = N_Identifier
- and then Entity (Bound) = Disc
+ if Nkind (Bound) /= N_Identifier then
+ return;
+ end if;
+
+ -- We expect either the discriminant or the discriminal
+
+ if Entity (Bound) = Disc
+ or else (Ekind (Entity (Bound)) = E_In_Parameter
+ and then Discriminal_Link (Entity (Bound)) = Disc)
then
Rewrite (Bound, New_Copy_Tree (Expr_Disc));
end if;
@@ -4280,9 +4287,7 @@ package body Sem_Aggr is
-- Start of processing for Rewrite_Range
begin
- if Has_Discriminants (Root_Type)
- and then Nkind (Rge) = N_Range
- then
+ if Has_Discriminants (Root_Type) and then Nkind (Rge) = N_Range then
Low := Low_Bound (Rge);
High := High_Bound (Rge);
@@ -4903,7 +4908,9 @@ package body Sem_Aggr is
-- Root record type whose discriminants may be used as
-- bounds in range nodes.
- Index : Node_Id;
+ Assoc : Node_Id;
+ Choice : Node_Id;
+ Index : Node_Id;
begin
-- Rewrite the range nodes occurring in the indexes
@@ -4919,12 +4926,26 @@ package body Sem_Aggr is
end loop;
-- Rewrite the range nodes occurring as aggregate
- -- bounds.
+ -- bounds and component associations.
- if Nkind (Expr) = N_Aggregate
- and then Present (Aggregate_Bounds (Expr))
- then
- Rewrite_Range (Rec_Typ, Aggregate_Bounds (Expr));
+ if Nkind (Expr) = N_Aggregate then
+ if Present (Aggregate_Bounds (Expr)) then
+ Rewrite_Range (Rec_Typ, Aggregate_Bounds (Expr));
+ end if;
+
+ if Present (Component_Associations (Expr)) then
+ Assoc := First (Component_Associations (Expr));
+ while Present (Assoc) loop
+ Choice := First (Choices (Assoc));
+ while Present (Choice) loop
+ Rewrite_Range (Rec_Typ, Choice);
+
+ Next (Choice);
+ end loop;
+
+ Next (Assoc);
+ end loop;
+ end if;
end if;
end;
end if;