ada: Allow making empty aggregates positional

This patch makes Exp_Aggr.Convert_To_Positional accepts appropriate
empty aggregates. The end goal is to remove violations of the
No_Elaboration_Code restriction in some cases of library-level array
objects.

gcc/ada/

	* exp_aggr.adb (Flatten): Do not reject empty aggregates. Adjust
	criterion for emitting warning about ineffective others clause.
	* sem_aggr.adb (Array_Aggr_Subtype): Fix typo. Add handling of
	aggregates that were converted to positional form.
	(Resolve_Aggregate): Tweak criterion for transforming into a
	string literal.
	(Resolve_Array_Aggregate): Tweak criterion for reusing existing
	bounds of aggregate.
	(Retrieve_Aggregate_Bounds): New procedure.
	* sem_util.adb (Has_Static_Empty_Array_Bounds): New function.
	* sem_util.ads (Has_Static_Empty_Array_Bounds): Likewise.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index df228713a28fb37b4ca73163791ded90b3b0d598..419a98c681a6dae74e028859e1c28c82b53e25de 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4657,8 +4657,7 @@ package body Exp_Aggr is
          --  present we can proceed since the bounds can be obtained from the
          --  aggregate.
 
-         if Hiv < Lov
-           or else (not Compile_Time_Known_Value (Blo) and then Others_Present)
+         if not Compile_Time_Known_Value (Blo) and then Others_Present
          then
             return False;
          end if;
@@ -4801,6 +4800,9 @@ package body Exp_Aggr is
 
                      if Rep_Count = 0
                        and then Warn_On_Redundant_Constructs
+                       -- We don't emit warnings on null arrays initialized
+                       -- with an aggregate of the form "(others => ...)".
+                       and then Vals'Length > 0
                      then
                         Error_Msg_N ("there are no others?r?", Elmt);
                      end if;

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index bc53ea904a3b049b1c5a922dd2f88b5bb84122c4..bddfbecf46dc768783c628230e35c3255e9e7289 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -468,6 +468,12 @@ package body Sem_Aggr is
       --  corresponding to the same dimension are static and found to differ,
       --  then emit a warning, and mark N as raising Constraint_Error.
 
+      procedure Retrieve_Aggregate_Bounds (This_Range : Node_Id);
+      --  In some cases, an appropriate list of aggregate bounds has been
+      --  created during resolution. Populate Aggr_Range with that list, and
+      --  remove the elements from the list so they can be added to another
+      --  list later.
+
       -------------------------
       -- Collect_Aggr_Bounds --
       -------------------------
@@ -631,6 +637,24 @@ package body Sem_Aggr is
          end if;
       end Collect_Aggr_Bounds;
 
+      -------------------------------
+      -- Retrieve_Aggregate_Bounds --
+      -------------------------------
+
+      procedure Retrieve_Aggregate_Bounds (This_Range : Node_Id) is
+         R : Node_Id := This_Range;
+      begin
+         for J in 1 .. Aggr_Dimension loop
+            Aggr_Range (J) := R;
+            Next_Index (R);
+
+            --  Remove bounds from the list, so they can be reattached as
+            --  the First_Index/Next_Index again.
+
+            Remove (Aggr_Range (J));
+         end loop;
+      end Retrieve_Aggregate_Bounds;
+
       --  Array_Aggr_Subtype variables
 
       Itype : Entity_Id;
@@ -655,25 +679,17 @@ package body Sem_Aggr is
 
       Set_Parent (Index_Constraints, N);
 
+      if Is_Rewrite_Substitution (N)
+        and then Present (Component_Associations (Original_Node (N)))
+      then
+         Retrieve_Aggregate_Bounds (First_Index (Etype (Original_Node (N))));
+
       --  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;
+      elsif Is_Null_Aggregate (N) then
+         Retrieve_Aggregate_Bounds (Aggregate_Bounds (N));
       else
          Collect_Aggr_Bounds (N, 1);
       end if;
@@ -1378,6 +1394,7 @@ package body Sem_Aggr is
            and then Is_OK_Static_Subtype (Component_Type (Typ))
            and then Base_Type (Etype (First_Index (Typ))) =
                       Base_Type (Standard_Integer)
+           and then not Has_Static_Empty_Array_Bounds (Typ)
          then
             declare
                Expr : Node_Id;
@@ -3595,10 +3612,12 @@ package body Sem_Aggr is
       --  If the aggregate already has bounds attached to it, it means this is
       --  a positional aggregate created as an optimization by
       --  Exp_Aggr.Convert_To_Positional, so we don't want to change those
-      --  bounds.
+      --  bounds, unless they depend on discriminants. If they do, we have to
+      --  perform analysis in the current context.
 
       if Present (Aggregate_Bounds (N))
-        and then not Others_Allowed
+        and then No (Others_N)
+        and then not Depends_On_Discriminant (Aggregate_Bounds (N))
         and then not Comes_From_Source (N)
       then
          Aggr_Low  := Low_Bound  (Aggregate_Bounds (N));

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 9d4fd74b98fe0e5e84f5e24e4e1333675853d9b6..19941ae3060f931880280d051e4695e0b8e25022 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -13250,6 +13250,20 @@ package body Sem_Util is
       return All_Static;
    end Has_Static_Array_Bounds;
 
+   -----------------------------------
+   -- Has_Static_Empty_Array_Bounds --
+   -----------------------------------
+
+   function Has_Static_Empty_Array_Bounds (Typ : Node_Id) return Boolean is
+      All_Static : Boolean;
+      Has_Empty  : Boolean;
+
+   begin
+      Examine_Array_Bounds (Typ, All_Static, Has_Empty);
+
+      return Has_Empty;
+   end Has_Static_Empty_Array_Bounds;
+
    ---------------------------------------
    -- Has_Static_Non_Empty_Array_Bounds --
    ---------------------------------------

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 21e90dcf53bdfe741d0ad05eee22e3d274f10b21..eccbd4351d017c5c07e7501c165765cdd4be8551 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1531,6 +1531,9 @@ package Sem_Util is
    function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean;
    --  Return whether an array type has static bounds
 
+   function Has_Static_Empty_Array_Bounds (Typ : Node_Id) return Boolean;
+   --  Return whether array type Typ has static empty bounds
+
    function Has_Static_Non_Empty_Array_Bounds (Typ : Node_Id) return Boolean;
    --  Determine whether array type Typ has static non-empty bounds