From fe3463cc9884e422f8d9147d2e8b5ef13e336aa6 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Sun, 21 Jun 2020 12:58:55 -0400 Subject: [PATCH] [Ada] Ada_2020: Add aspect Aggregate to standard container units 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. --- gcc/ada/exp_aggr.adb | 4 +++- gcc/ada/libgnat/a-cbdlli.adb | 12 ++++++++++++ gcc/ada/libgnat/a-cbdlli.ads | 9 +++++++-- gcc/ada/libgnat/a-cbhama.ads | 4 +++- gcc/ada/libgnat/a-cbhase.ads | 4 +++- gcc/ada/libgnat/a-cborma.ads | 4 +++- gcc/ada/libgnat/a-cborse.ads | 4 +++- gcc/ada/libgnat/a-cdlili.adb | 12 ++++++++++++ gcc/ada/libgnat/a-cdlili.ads | 8 +++++++- gcc/ada/libgnat/a-cihama.ads | 4 +++- gcc/ada/libgnat/a-cihase.ads | 4 +++- gcc/ada/libgnat/a-ciorma.ads | 4 +++- gcc/ada/libgnat/a-ciorse.ads | 4 +++- gcc/ada/libgnat/a-cobove.adb | 21 +++++++++++++++++++++ gcc/ada/libgnat/a-cobove.ads | 14 +++++++++++++- gcc/ada/libgnat/a-cohama.ads | 4 +++- gcc/ada/libgnat/a-cohase.ads | 4 +++- gcc/ada/libgnat/a-coinve.adb | 21 +++++++++++++++++++++ gcc/ada/libgnat/a-coinve.ads | 12 +++++++++++- gcc/ada/libgnat/a-convec.adb | 21 +++++++++++++++++++++ gcc/ada/libgnat/a-convec.ads | 15 ++++++++++++++- gcc/ada/libgnat/a-coorma.ads | 4 +++- gcc/ada/libgnat/a-coorse.ads | 2 ++ gcc/ada/sem_ch13.adb | 31 +++++++++++++++++++++++-------- 24 files changed, 200 insertions(+), 26 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 168a5923944..c24588a4ae7 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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 diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb index 0f0c872e887..8f40d6c0b8d 100644 --- a/gcc/ada/libgnat/a-cbdlli.adb +++ b/gcc/ada/libgnat/a-cbdlli.adb @@ -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 -- ------------ diff --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads index 74639cf07d2..62624f34e07 100644 --- a/gcc/ada/libgnat/a-cbdlli.ads +++ b/gcc/ada/libgnat/a-cbdlli.ads @@ -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; diff --git a/gcc/ada/libgnat/a-cbhama.ads b/gcc/ada/libgnat/a-cbhama.ads index 86fed4e6997..d1225e090a3 100644 --- a/gcc/ada/libgnat/a-cbhama.ads +++ b/gcc/ada/libgnat/a-cbhama.ads @@ -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); diff --git a/gcc/ada/libgnat/a-cbhase.ads b/gcc/ada/libgnat/a-cbhase.ads index 01903c74a0c..32e9d927e1c 100644 --- a/gcc/ada/libgnat/a-cbhase.ads +++ b/gcc/ada/libgnat/a-cbhase.ads @@ -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); diff --git a/gcc/ada/libgnat/a-cborma.ads b/gcc/ada/libgnat/a-cborma.ads index c199a09efbf..6dac0504e9c 100644 --- a/gcc/ada/libgnat/a-cborma.ads +++ b/gcc/ada/libgnat/a-cborma.ads @@ -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); diff --git a/gcc/ada/libgnat/a-cborse.ads b/gcc/ada/libgnat/a-cborse.ads index 52b8786f3c8..1b711c41370 100644 --- a/gcc/ada/libgnat/a-cborse.ads +++ b/gcc/ada/libgnat/a-cborse.ads @@ -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); diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb index a668db11bb1..0e25418368b 100644 --- a/gcc/ada/libgnat/a-cdlili.adb +++ b/gcc/ada/libgnat/a-cdlili.adb @@ -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 -- ------------ diff --git a/gcc/ada/libgnat/a-cdlili.ads b/gcc/ada/libgnat/a-cdlili.ads index 89216e03226..6d369c06652 100644 --- a/gcc/ada/libgnat/a-cdlili.ads +++ b/gcc/ada/libgnat/a-cdlili.ads @@ -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; diff --git a/gcc/ada/libgnat/a-cihama.ads b/gcc/ada/libgnat/a-cihama.ads index fb6f4e00990..d29cbb402f7 100644 --- a/gcc/ada/libgnat/a-cihama.ads +++ b/gcc/ada/libgnat/a-cihama.ads @@ -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); diff --git a/gcc/ada/libgnat/a-cihase.ads b/gcc/ada/libgnat/a-cihase.ads index 926e07f1faa..8af0b7d19e0 100644 --- a/gcc/ada/libgnat/a-cihase.ads +++ b/gcc/ada/libgnat/a-cihase.ads @@ -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); diff --git a/gcc/ada/libgnat/a-ciorma.ads b/gcc/ada/libgnat/a-ciorma.ads index a7799a613a6..909ab7af941 100644 --- a/gcc/ada/libgnat/a-ciorma.ads +++ b/gcc/ada/libgnat/a-ciorma.ads @@ -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); diff --git a/gcc/ada/libgnat/a-ciorse.ads b/gcc/ada/libgnat/a-ciorse.ads index 1eb8135ff5c..84c680ac713 100644 --- a/gcc/ada/libgnat/a-ciorse.ads +++ b/gcc/ada/libgnat/a-ciorse.ads @@ -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); diff --git a/gcc/ada/libgnat/a-cobove.adb b/gcc/ada/libgnat/a-cobove.adb index fe94ea58364..410686b42bb 100644 --- a/gcc/ada/libgnat/a-cobove.adb +++ b/gcc/ada/libgnat/a-cobove.adb @@ -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 -- --------------------- diff --git a/gcc/ada/libgnat/a-cobove.ads b/gcc/ada/libgnat/a-cobove.ads index 72da498f42d..265fd52675a 100644 --- a/gcc/ada/libgnat/a-cobove.ads +++ b/gcc/ada/libgnat/a-cobove.ads @@ -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; diff --git a/gcc/ada/libgnat/a-cohama.ads b/gcc/ada/libgnat/a-cohama.ads index 9d927bd992b..4c87aeae294 100644 --- a/gcc/ada/libgnat/a-cohama.ads +++ b/gcc/ada/libgnat/a-cohama.ads @@ -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); diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads index 3645ed07124..38d079fbbcc 100644 --- a/gcc/ada/libgnat/a-cohase.ads +++ b/gcc/ada/libgnat/a-cohase.ads @@ -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); diff --git a/gcc/ada/libgnat/a-coinve.adb b/gcc/ada/libgnat/a-coinve.adb index 79e36aea659..19a6659e894 100644 --- a/gcc/ada/libgnat/a-coinve.adb +++ b/gcc/ada/libgnat/a-coinve.adb @@ -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 -- ----------------- diff --git a/gcc/ada/libgnat/a-coinve.ads b/gcc/ada/libgnat/a-coinve.ads index 075a1843319..2220d939678 100644 --- a/gcc/ada/libgnat/a-coinve.ads +++ b/gcc/ada/libgnat/a-coinve.ads @@ -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; diff --git a/gcc/ada/libgnat/a-convec.adb b/gcc/ada/libgnat/a-convec.adb index c2a0a834c4e..0a793763500 100644 --- a/gcc/ada/libgnat/a-convec.adb +++ b/gcc/ada/libgnat/a-convec.adb @@ -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 -- --------------------- diff --git a/gcc/ada/libgnat/a-convec.ads b/gcc/ada/libgnat/a-convec.ads index a12e4568b56..ebc90cf5766 100644 --- a/gcc/ada/libgnat/a-convec.ads +++ b/gcc/ada/libgnat/a-convec.ads @@ -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; diff --git a/gcc/ada/libgnat/a-coorma.ads b/gcc/ada/libgnat/a-coorma.ads index e2d5e1e3e09..524aa048fc0 100644 --- a/gcc/ada/libgnat/a-coorma.ads +++ b/gcc/ada/libgnat/a-coorma.ads @@ -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); diff --git a/gcc/ada/libgnat/a-coorse.ads b/gcc/ada/libgnat/a-coorse.ads index 42e5b4970f0..c08d4957d99 100644 --- a/gcc/ada/libgnat/a-coorse.ads +++ b/gcc/ada/libgnat/a-coorse.ads @@ -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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 30cade8d63b..60660bcbfb7 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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)); -- 2.30.2