From: Piotr Trojanek <trojanek@adacore.com>
Date: Sun, 31 Jul 2022 20:11:30 +0000 (+0200)
Subject: [Ada] Fix inconsistent building of itypes for null array aggregates
X-Git-Tag: basepoints/gcc-14~4778
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=59a23beb9e71a0259b076693dd1e551500c08f24;p=thirdparty%2Fgcc.git

[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.
---

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index dddc75f3a2ee..8da4f8081b26 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;