* [Ada] Further fix non-stored discriminant in aggregate for GNATprove
@ 2019-07-22 14:02 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2019-07-22 14:02 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 669 bytes --]
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.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 3003 bytes --]
--- gcc/ada/sem_aggr.adb
+++ 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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2019-07-22 14:02 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-07-22 14:02 [Ada] Further fix non-stored discriminant in aggregate for GNATprove Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).