[Ada] Ada_2020: Add aspect Aggregate to standard container units
authorEd Schonberg <schonberg@adacore.com>
Sun, 21 Jun 2020 16:58:55 +0000 (12:58 -0400)
committerPierre-Marie de Rodat <derodat@adacore.com>
Thu, 15 Oct 2020 09:39:07 +0000 (05:39 -0400)
gcc/ada/

* exp_aggr.adb (Expand_N_Aggregate): A record aggregate requires
a non-private type.
* sem_ch13.adb (Valid_Assign_Indexed): New subprogram local to
Resolve_Aspect_Aggregate, to handle the case when the
corresponding name appearing in the aspect specification for an
indexed aggregate is an overloaded operation.
* libgnat/a-convec.ads, libgnat/a-convec.adb,
libgnat/a-coinve.ads, libgnat/a-coinve.adb,
libgnat/a-cobove.ads, libgnat/a-cobove.adb,
libgnat/a-cdlili.ads, libgnat/a-cdlili.adb,
libgnat/a-cbdlli.ads, libgnat/a-cbdlli.adb,
libgnat/a-cohama.ads, libgnat/a-cihama.ads,
libgnat/a-cbhama.ads, libgnat/a-cborma.ads,
libgnat/a-ciorma.ads, libgnat/a-coorma.ads,
libgnat/a-cihase.ads, libgnat/a-cohase.ads,
libgnat/a-cbhase.ads, libgnat/a-cborse.ads,
libgnat/a-ciorse.ads, libgnat/a-coorse.ads: Add Ada_2020 aspect
Aggregate to types declared in standard containers, as well as
new subprograms where required.

24 files changed:
gcc/ada/exp_aggr.adb
gcc/ada/libgnat/a-cbdlli.adb
gcc/ada/libgnat/a-cbdlli.ads
gcc/ada/libgnat/a-cbhama.ads
gcc/ada/libgnat/a-cbhase.ads
gcc/ada/libgnat/a-cborma.ads
gcc/ada/libgnat/a-cborse.ads
gcc/ada/libgnat/a-cdlili.adb
gcc/ada/libgnat/a-cdlili.ads
gcc/ada/libgnat/a-cihama.ads
gcc/ada/libgnat/a-cihase.ads
gcc/ada/libgnat/a-ciorma.ads
gcc/ada/libgnat/a-ciorse.ads
gcc/ada/libgnat/a-cobove.adb
gcc/ada/libgnat/a-cobove.ads
gcc/ada/libgnat/a-cohama.ads
gcc/ada/libgnat/a-cohase.ads
gcc/ada/libgnat/a-coinve.adb
gcc/ada/libgnat/a-coinve.ads
gcc/ada/libgnat/a-convec.adb
gcc/ada/libgnat/a-convec.ads
gcc/ada/libgnat/a-coorma.ads
gcc/ada/libgnat/a-coorse.ads
gcc/ada/sem_ch13.adb

index 168a5923944e034d09bea391dbe62d1a0c4678e1..c24588a4ae704b2a479ee116b327da2e00afd30a 100644 (file)
@@ -6758,7 +6758,9 @@ package body Exp_Aggr is
    begin
       --  Record aggregate case
 
-      if Is_Record_Type (Etype (N)) then
+      if Is_Record_Type (Etype (N))
+        and then not Is_Private_Type (Etype (N))
+      then
          Expand_Record_Aggregate (N);
 
       elsif Has_Aspect (Etype (N), Aspect_Aggregate) then
index 0f0c872e8878226928c8bc3da19c4bfa9ac325eb..8f40d6c0b8d1e60562bf16ef148353f6c7cc7a82 100644 (file)
@@ -204,6 +204,18 @@ is
       Insert (Container, No_Element, New_Item, Count);
    end Append;
 
+   ---------------
+   -- Append_One --
+   ---------------
+
+   procedure Append_One
+     (Container : in out List;
+      New_Item  : Element_Type)
+   is
+   begin
+      Insert (Container, No_Element, New_Item, 1);
+   end Append_One;
+
    ------------
    -- Assign --
    ------------
index 74639cf07d295746b3c4b3b7650b4f96cf3b48c1..62624f34e074fd37dfab188583498ed7014eee0e 100644 (file)
@@ -54,8 +54,9 @@ is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
-
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty        => Empty_List,
+                            Add_Unnamed  => Append_One);
    pragma Preelaborable_Initialization (List);
 
    type Cursor is private;
@@ -149,6 +150,10 @@ is
       New_Item  : Element_Type;
       Count     : Count_Type := 1);
 
+   procedure Append_One
+     (Container : in out List;
+      New_Item  : Element_Type);
+
    procedure Delete
      (Container : in out List;
       Position  : in out Cursor;
index 86fed4e699758effa9ca9ebfb90a2467de2b58d8..d1225e090a3e613242978383778ef5382e215fb1 100644 (file)
@@ -56,7 +56,9 @@ is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty     => Empty_Map,
+                            Add_Named => Insert);
 
    pragma Preelaborable_Initialization (Map);
 
index 01903c74a0cd05bc75766f312107ada6e8598059..32e9d927e1cb7575b3b5bfd24875869ce4e387cf 100644 (file)
@@ -58,7 +58,9 @@ is
    type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged private
      with Constant_Indexing => Constant_Reference,
           Default_Iterator  => Iterate,
-          Iterator_Element  => Element_Type;
+          Iterator_Element  => Element_Type,
+          Aggregate         => (Empty       => Empty_Set,
+                                Add_Unnamed => Include);
 
    pragma Preelaborable_Initialization (Set);
 
index c199a09efbf99a1deb59d6273eb1b675f4b74ca2..6dac0504e9cbd14df9a18ef14a5ecbafb85b46e4 100644 (file)
@@ -57,7 +57,9 @@ is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty     => Empty_Map,
+                            Add_Named => Insert);
 
    pragma Preelaborable_Initialization (Map);
 
index 52b8786f3c8c89c2e75622ddcbd23d783c7b969c..1b711c413704d5571acedc4a7d10c1a99c5ca705 100644 (file)
@@ -56,7 +56,9 @@ is
    type Set (Capacity : Count_Type) is tagged private
    with Constant_Indexing => Constant_Reference,
         Default_Iterator  => Iterate,
-        Iterator_Element  => Element_Type;
+        Iterator_Element  => Element_Type,
+        Aggregate         => (Empty       => Empty_Set,
+                              Add_Unnamed => Include);
 
    pragma Preelaborable_Initialization (Set);
 
index a668db11bb132c719d75fb699d306c5d86b9b994..0e25418368bfd6fb51cbe095f258e2e9840d40bf 100644 (file)
@@ -163,6 +163,18 @@ is
       Insert (Container, No_Element, New_Item, Count);
    end Append;
 
+   ---------------
+   -- Append_One --
+   ---------------
+
+   procedure Append_One
+     (Container : in out List;
+      New_Item  : Element_Type)
+   is
+   begin
+      Insert (Container, No_Element, New_Item, 1);
+   end Append_One;
+
    ------------
    -- Assign --
    ------------
index 89216e03226b97bf56a963bdab3fedc5d040eae5..6d369c06652e3a39e3966e9d9181b706486c3461 100644 (file)
@@ -55,7 +55,9 @@ is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty       => Empty_List,
+                            Add_Unnamed => Append_One);
 
    pragma Preelaborable_Initialization (List);
 
@@ -152,6 +154,10 @@ is
       New_Item  : Element_Type;
       Count     : Count_Type := 1);
 
+   procedure Append_One
+     (Container : in out List;
+      New_Item  : Element_Type);
+
    procedure Delete
      (Container : in out List;
       Position  : in out Cursor;
index fb6f4e009904211984673631cc0590c98ddb0e6e..d29cbb402f74bf5580e7c2aed73c87f6b20da82c 100644 (file)
@@ -56,7 +56,9 @@ is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty     => Empty_Map,
+                            Add_Named => Insert);
 
    pragma Preelaborable_Initialization (Map);
 
index 926e07f1faa11f19f5d2ded68739e2bd0c983e2b..8af0b7d19e053d395c306ce2f4a9394bbaccdbb4 100644 (file)
@@ -58,7 +58,9 @@ is
    type Set is tagged private
      with Constant_Indexing => Constant_Reference,
           Default_Iterator  => Iterate,
-          Iterator_Element  => Element_Type;
+          Iterator_Element  => Element_Type,
+          Aggregate         => (Empty       => Empty_Set,
+                                Add_Unnamed => Include);
 
    pragma Preelaborable_Initialization (Set);
 
index a7799a613a6f944847f325d6d16c1e2bac39c182..909ab7af9417df0c9cbdfe33e90aef9470a1abb7 100644 (file)
@@ -57,7 +57,9 @@ is
    with Constant_Indexing => Constant_Reference,
         Variable_Indexing => Reference,
         Default_Iterator  => Iterate,
-        Iterator_Element  => Element_Type;
+        Iterator_Element  => Element_Type,
+        Aggregate         => (Empty     => Empty_Map,
+                              Add_Named => Insert);
 
    pragma Preelaborable_Initialization (Map);
 
index 1eb8135ff5cf2e4e5522a2f11ce2c112d1e76313..84c680ac7136fc128bd2f8c859d800eeaf0f231f 100644 (file)
@@ -56,7 +56,9 @@ is
    type Set is tagged private with
       Constant_Indexing => Constant_Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty       => Empty_Set,
+                            Add_Unnamed => Include);
 
    pragma Preelaborable_Initialization (Set);
 
index fe94ea58364d0d4412f633b2d4cc7f0476c7e6eb..410686b42bb8270e8a9eca179c4816c257a73c79 100644 (file)
@@ -350,6 +350,17 @@ package body Ada.Containers.Bounded_Vectors is
       Container.Insert (Container.Last + 1, New_Item, Count);
    end Append;
 
+   ----------------
+   -- Append_One --
+   ----------------
+
+   procedure Append_One (Container : in out Vector;
+                         New_Item  :        Element_Type)
+   is
+   begin
+      Insert (Container, Last_Index (Container) + 1, New_Item, 1);
+   end Append_One;
+
    --------------
    -- Capacity --
    --------------
@@ -824,6 +835,16 @@ package body Ada.Containers.Bounded_Vectors is
       return Index_Type'First;
    end First_Index;
 
+   -----------------
+   -- New_Vector --
+   -----------------
+
+   function New_Vector (First, Last : Index_Type) return Vector
+   is
+   begin
+      return (To_Vector (Count_Type (Last - First + 1)));
+   end New_Vector;
+
    ---------------------
    -- Generic_Sorting --
    ---------------------
index 72da498f42de5302dbde8de06c74374f368a0977..265fd52675a64018f782c45d2fc25b3e42a1e4f1 100644 (file)
@@ -58,7 +58,11 @@ package Ada.Containers.Bounded_Vectors is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty          => Empty_Vector,
+                            Add_Unnamed    => Append_One,
+                            New_Indexed    => New_Vector,
+                            Assign_Indexed => Replace_Element);
 
    pragma Preelaborable_Initialization (Vector);
 
@@ -76,6 +80,10 @@ package Ada.Containers.Bounded_Vectors is
 
    overriding function "=" (Left, Right : Vector) return Boolean;
 
+   function New_Vector (First, Last : Index_Type) return Vector
+     with Pre => First = Index_Type'First;
+   --  Ada_2020 aggregate operation.
+
    function To_Vector (Length : Count_Type) return Vector;
 
    function To_Vector
@@ -243,6 +251,10 @@ package Ada.Containers.Bounded_Vectors is
       New_Item  : Element_Type;
       Count     : Count_Type := 1);
 
+   procedure Append_One (Container : in out Vector;
+                         New_Item  :        Element_Type);
+   --  Ada_2020 aggregate operation.
+
    procedure Insert_Space
      (Container : in out Vector;
       Before    : Extended_Index;
index 9d927bd992b437ffc0fd95e54c5e5e1fa0ef47fd..4c87aeae29436412a07f884d7ee77e8fba86cca3 100644 (file)
@@ -100,7 +100,9 @@ is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty     => Empty_Map,
+                            Add_Named => Insert);
 
    pragma Preelaborable_Initialization (Map);
 
index 3645ed071241b9e29497898dcdf24c6b35d512db..38d079fbbcc6909cb8ac3988bff9baa883cedead 100644 (file)
@@ -59,7 +59,9 @@ is
    with
       Constant_Indexing => Constant_Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty       => Empty_Set,
+                            Add_Unnamed => Include);
 
    pragma Preelaborable_Initialization (Set);
 
index 79e36aea659b0d11e68783d5a4247f2a0fd568b2..19a6659e8947410016ede234dc8ee40fd5aa9299 100644 (file)
@@ -228,6 +228,17 @@ is
       end if;
    end Append;
 
+   ----------------
+   -- Append_One --
+   ----------------
+
+   procedure Append_One (Container : in out Vector;
+                        New_Item   :        Element_Type)
+   is
+   begin
+      Insert (Container, Last_Index (Container) + 1, New_Item, 1);
+   end Append_One;
+
    ----------------------
    -- Append_Slow_Path --
    ----------------------
@@ -871,6 +882,16 @@ is
       end;
    end First_Element;
 
+   -----------------
+   -- New_Vector --
+   -----------------
+
+   function New_Vector (First, Last : Index_Type) return Vector
+   is
+   begin
+      return (To_Vector (Count_Type (Last - First + 1)));
+   end New_Vector;
+
    -----------------
    -- First_Index --
    -----------------
index 075a1843319a7fe76ecd14970cac528e5e8be416..2220d939678f5c5366ef75bd5ffb9c916bcf9908 100644 (file)
@@ -61,7 +61,11 @@ is
      Constant_Indexing => Constant_Reference,
      Variable_Indexing => Reference,
      Default_Iterator  => Iterate,
-     Iterator_Element  => Element_Type;
+     Iterator_Element  => Element_Type,
+     Aggregate         => (Empty          => Empty_Vector,
+                           Add_Unnamed    => Append_One,
+                           New_Indexed    => New_Vector,
+                           Assign_Indexed => Replace_Element);
 
    pragma Preelaborable_Initialization (Vector);
 
@@ -79,6 +83,9 @@ is
 
    overriding function "=" (Left, Right : Vector) return Boolean;
 
+   function New_Vector (First, Last : Index_Type) return Vector
+     with Pre => First = Index_Type'First;
+
    function To_Vector (Length : Count_Type) return Vector;
 
    function To_Vector
@@ -238,6 +245,9 @@ is
       New_Item  : Element_Type;
       Count     : Count_Type := 1);
 
+   procedure Append_One (Container : in out Vector;
+                        New_Item  :        Element_Type);
+
    procedure Insert_Space
      (Container : in out Vector;
       Before    : Extended_Index;
index c2a0a834c4e52aab9ccd37d8c7d5ce816837e50b..0a793763500bd4454666253647c700b931b7d30a 100644 (file)
@@ -210,6 +210,17 @@ is
       end if;
    end Append;
 
+   ----------------
+   -- Append_One --
+   ----------------
+
+   procedure Append_One (Container : in out Vector;
+                         New_Item  :        Element_Type)
+   is
+   begin
+      Insert (Container, Last_Index (Container) + 1, New_Item, 1);
+   end Append_One;
+
    ----------------------
    -- Append_Slow_Path --
    ----------------------
@@ -742,6 +753,16 @@ is
       return Index_Type'First;
    end First_Index;
 
+   -----------------
+   -- New_Vector --
+   -----------------
+
+   function New_Vector (First, Last : Index_Type) return Vector
+   is
+   begin
+      return (To_Vector (Count_Type (Last - First + 1)));
+   end New_Vector;
+
    ---------------------
    -- Generic_Sorting --
    ---------------------
index a12e4568b5655a96c95cf36346cc76cf3a928cbb..ebc90cf576617d669aeaa02791ad445c60830bac 100644 (file)
@@ -93,7 +93,12 @@ is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty          => Empty_Vector,
+                            Add_Unnamed    => Append_One,
+                            New_Indexed    => New_Vector,
+                            Assign_Indexed => Replace_Element);
+
    pragma Preelaborable_Initialization (Vector);
    --  Vector type, to be instantiated by users of this package. If an object
    --  of type Vector is not otherwise initialized, it is initialized to
@@ -323,6 +328,10 @@ is
    --  Source is removed from Source and inserted into Target in the original
    --  order. The length of Source is 0 after a successful call to Move.
 
+   function New_Vector (First, Last : Index_Type) return Vector
+     with Pre => First = Index_Type'First;
+   --  Ada_2020 aggregate operation.
+
    procedure Insert
      (Container : in out Vector;
       Before    : Extended_Index;
@@ -438,6 +447,10 @@ is
    --  Equivalent to Insert (Container, Last_Index (Container) + 1, New_Item,
    --  Count).
 
+   procedure Append_One (Container : in out Vector;
+                         New_Item  :        Element_Type);
+   --  Ada_2020 aggregate operation.
+
    procedure Insert_Space
      (Container : in out Vector;
       Before    : Extended_Index;
index e2d5e1e3e09b43117ae7fddb1ad60a93fbd45197..524aa048fc0d59f15af98862c52739676cb1e098 100644 (file)
@@ -57,7 +57,9 @@ is
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
-      Iterator_Element  => Element_Type;
+      Iterator_Element  => Element_Type,
+      Aggregate         => (Empty     => Empty_Map,
+                            Add_Named => Insert);
 
    type Cursor is private;
    pragma Preelaborable_Initialization (Cursor);
index 42e5b4970f08f50510681c305fe33be31452af95..c08d4957d99e1e7769ff7c710509bcdffe172175 100644 (file)
@@ -57,6 +57,8 @@ is
    with Constant_Indexing => Constant_Reference,
         Default_Iterator  => Iterate,
         Iterator_Element  => Element_Type;
+        --  Aggregate         => (Empty       => Empty_Set,
+        --                        Add_Unnamed => Include);
 
    pragma Preelaborable_Initialization (Set);
 
index 30cade8d63ba59fb80fe68a4fec03b48de2040a1..60660bcbfb797db6c13665363bcb4328b98beffc 100644 (file)
@@ -15142,19 +15142,33 @@ package body Sem_Ch13 is
       --  Predicates that establish the legality of each possible operation in
       --  an Aggregate aspect.
 
-      function Valid_Empty          (E : Entity_Id) return Boolean;
-      function Valid_Add_Named      (E : Entity_Id) return Boolean;
-      function Valid_Add_Unnamed    (E : Entity_Id) return Boolean;
-      function Valid_New_Indexed    (E : Entity_Id) return Boolean;
-
-      --  Note: The legality rules for Assign_Indexed are the same as for
-      --  Add_Named.
+      function Valid_Empty             (E : Entity_Id) return Boolean;
+      function Valid_Add_Named         (E : Entity_Id) return Boolean;
+      function Valid_Add_Unnamed       (E : Entity_Id) return Boolean;
+      function Valid_New_Indexed       (E : Entity_Id) return Boolean;
+      function Valid_Assign_Indexed    (E : Entity_Id) return Boolean;
 
       generic
         with function Pred (Id : Node_Id) return Boolean;
       procedure Resolve_Operation (Subp_Id : Node_Id);
       --  Common processing to resolve each aggregate operation.
 
+      ------------------------
+      -- Valid_Assign_Index --
+      ------------------------
+
+      function Valid_Assign_Indexed (E : Entity_Id) return Boolean is
+      begin
+         --  The profile must be the same as for Add_Named, with the added
+         --  requirement that the key_type be a discrete type.
+
+         if Valid_Add_Named (E) then
+            return Is_Discrete_Type (Etype (Next_Formal (First_Formal (E))));
+         else
+            return False;
+         end if;
+      end Valid_Assign_Indexed;
+
       -----------------
       -- Valid_Emoty --
       -----------------
@@ -15278,7 +15292,8 @@ package body Sem_Ch13 is
       procedure Resolve_Named   is new Resolve_Operation (Valid_Add_Named);
       procedure Resolve_Indexed is new Resolve_Operation (Valid_New_Indexed);
       procedure Resolve_Assign_Indexed
-                                is new Resolve_Operation (Valid_Add_Named);
+                                is new Resolve_Operation
+                                                      (Valid_Assign_Indexed);
    begin
       Assoc := First (Component_Associations (Expr));