aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2022-07-31 22:11:30 +0200
committerMarc Poulhiès <poulhies@adacore.com>2022-09-05 09:21:07 +0200
commit59a23beb9e71a0259b076693dd1e551500c08f24 (patch)
treede6bb6a37991d0562155dc2dd7904af5ef90f35f
parentb26be61b8d23cc9d7a4e36feeadd9c8f0ec8b909 (diff)
downloadgcc-59a23beb9e71a0259b076693dd1e551500c08f24.zip
gcc-59a23beb9e71a0259b076693dd1e551500c08f24.tar.gz
gcc-59a23beb9e71a0259b076693dd1e551500c08f24.tar.bz2
[Ada] Fix inconsistent building of itypes for null array aggregates
To analyze Ada 2022 null array aggregates we introduced a dedicated routine and bypassed the code for ordinary array aggregates. However, the types for the array indexes created by this dedicated routine differed from the types created for ordinary array aggregates, i.e. itypes for null array aggregates were associated with the array subtype declaration, while itypes for ordinary array aggregates were associated with the aggregate itself. These differences cause trouble for various routines in GNATprove. This patch reduces the special handling of null array aggregates and reuses the building of itypes for ordinary array aggregates. gcc/ada/ * sem_aggr.adb (Array_Aggr_Subtype): Bypass call to Collect_Aggr_Bound with dedicated code for null array aggregates. (Resolve_Array_Aggregate): Remove special handling of null array aggregates. (Resolve_Array_Aggregate): Create bounds, but let Array_Aggr_Subtype create itype entities.
-rw-r--r--gcc/ada/sem_aggr.adb54
1 files changed, 31 insertions, 23 deletions
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index dddc75f..8da4f80 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -567,7 +567,29 @@ package body Sem_Aggr is
end if;
Set_Parent (Index_Constraints, N);
- Collect_Aggr_Bounds (N, 1);
+
+ -- When resolving a null aggregate we created a list of aggregate bounds
+ -- for the consecutive dimensions. The bounds for the first dimension
+ -- are attached as the Aggregate_Bounds of the aggregate node.
+
+ if Is_Null_Aggregate (N) then
+ declare
+ This_Range : Node_Id := Aggregate_Bounds (N);
+ begin
+ for J in 1 .. Aggr_Dimension loop
+ Aggr_Range (J) := This_Range;
+ Next_Index (This_Range);
+
+ -- Remove bounds from the list, so they can be reattached as
+ -- the First_Index/Next_Index again by the code that also
+ -- handles non-null aggregates.
+
+ Remove (Aggr_Range (J));
+ end loop;
+ end;
+ else
+ Collect_Aggr_Bounds (N, 1);
+ end if;
-- Build the list of constrained indexes of our aggregate itype
@@ -1203,9 +1225,6 @@ package body Sem_Aggr is
Aggr_Subtyp := Any_Composite;
- elsif Is_Null_Aggr then
- Aggr_Subtyp := Etype (N);
-
else
Aggr_Subtyp := Array_Aggr_Subtype (N, Typ);
end if;
@@ -4084,16 +4103,16 @@ package body Sem_Aggr is
Typ : constant Entity_Id := Etype (N);
Check : Node_Id;
- Decl : Node_Id;
Index : Node_Id;
Lo, Hi : Node_Id;
Constr : constant List_Id := New_List;
- Subt : constant Entity_Id :=
- Create_Itype (Ekind => E_Array_Subtype,
- Related_Nod => N,
- Suffix => 'S');
begin
+ -- Attach the list of constraints at the location of the aggregate, so
+ -- the individual constraints can be analyzed.
+
+ Set_Parent (Constr, N);
+
-- Create a constrained subtype with null dimensions
Index := First_Index (Typ);
@@ -4120,25 +4139,14 @@ package body Sem_Aggr is
Insert_Action (N, Check);
- Append (Make_Range (Loc, Lo, Hi), Constr);
+ Append (Make_Range (Loc, New_Copy_Tree (Lo), Hi), Constr);
+ Analyze_And_Resolve (Last (Constr), Etype (Index));
Index := Next_Index (Index);
end loop;
- Decl := Make_Subtype_Declaration (Loc,
- Defining_Identifier => Subt,
- Subtype_Indication =>
- Make_Subtype_Indication (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (Base_Type (Typ), Loc),
- Constraint =>
- Make_Index_Or_Discriminant_Constraint (Loc, Constr)));
-
- Insert_Action (N, Decl);
- Analyze (Decl);
- Set_Etype (N, Subt);
Set_Compile_Time_Known_Aggregate (N);
- Set_Aggregate_Bounds (N, New_Copy_Tree (First_Index (Etype (N))));
+ Set_Aggregate_Bounds (N, First (Constr));
return True;
end Resolve_Null_Array_Aggregate;