From patchwork Tue Oct 20 07:23:31 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1384665 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4CFlWw49MVz9sSs for ; Tue, 20 Oct 2020 18:25:16 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 4FEEE3971C12; Tue, 20 Oct 2020 07:23:43 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTP id 13DE73943408 for ; Tue, 20 Oct 2020 07:23:33 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 13DE73943408 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 2AF0B5624B; Tue, 20 Oct 2020 03:23:32 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 1ZHtT5fuknrE; Tue, 20 Oct 2020 03:23:32 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 23CF85624F; Tue, 20 Oct 2020 03:23:31 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 22B2C125; Tue, 20 Oct 2020 03:23:31 -0400 (EDT) Date: Tue, 20 Oct 2020 03:23:31 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] AI12-0339: Empty function for Aggregate aspect of Ada containers Message-ID: <20201020072330.GA31525@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-10.1 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Ed Schonberg Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" The specification of the aspect Aggregate includes a primitive operation Empty that returns the initial value to be used when building an aggregate for the corresponding composite type. For bounded containers, the function Empty includes an explicit parameter that corresponds to the discriminant of the object being built. This patch also implements the uniform resolution rule for aggregates, specified in AI12-0307, so that the ambiguities consequence of the new resolution rule are properly diagnosed by GNAT. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sinfo.ads, sinfo.adb: The flag Box_Present can appear in Iterated_Element_Association nodes. * sem_aggr.adb (Resolve_Aggregate): Call Resolve_Container_Aggregate when type of context has corresponding aspect. * sem_type.adb (Covers): In Ada_2020 an aggregate is compatible with a type that carries the corresponding aspect. * exp_ch3.adb (Make_Controlling_Function_Wrappers): Do not create declarations and bodies for inherited primitive functions of null extensions that dispatch on result, when current scope includes an immediately visible non-overloadable homonym of the function. * libgnat/a-cborse.adb, libgnat/a-cborse.ads, libgnat/a-cbhase.ads, libgnat/a-cbhase.adb, libgnat/a-cborma.adb, libgnat/a-cborma.ads, libgnat/a-cbhama.adb, libgnat/a-cbhama.ads, libgnat/a-cbdlli.adb, libgnat/a-cbdlli.ads, libgnat/a-convec.ads, libgnat/a-ciorse.ads, libgnat/a-cihase.ads, libgnat/a-cihase.adb, libgnat/a-ciorma.ads, libgnat/a-cihama.ads, libgnat/a-cihama.adb, libgnat/a-cidlli.ads, libgnat/a-cidlli.adb, libgnat/a-coinve.adb, libgnat/a-cobove.adb, libgnat/a-cobove.ads, libgnat/a-convec.adb, libgnat/a-coinve.ads, libgnat/a-coorse.ads, libgnat/a-cohase.adb, libgnat/a-cohase.ads, libgnat/a-coorma.ads, libgnat/a-cohama.adb, libgnat/a-cohama.ads, libgnat/a-cdlili.ads: Add primitive function Empty for use in aspect Aggregate, and add corresponding body or expression function. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -9471,6 +9471,31 @@ package body Exp_Ch3 is (Is_Null_Extension (Etype (Subp)) and then Etype (Alias (Subp)) /= Etype (Subp)) then + -- If there is a non-overloadable homonym in the current + -- scope, the implicit declaration remains invisible. + -- We check the current entity with the same name, or its + -- homonym in case the derivation takes place after the + -- hiding object declaration. + + if Present (Current_Entity (Subp)) then + declare + Curr : constant Entity_Id := Current_Entity (Subp); + Prev : constant Entity_Id := Homonym (Curr); + begin + if (Comes_From_Source (Curr) + and then Scope (Curr) = Current_Scope + and then not Is_Overloadable (Curr)) + or else + (Present (Prev) + and then Comes_From_Source (Prev) + and then Scope (Prev) = Current_Scope + and then not Is_Overloadable (Prev)) + then + goto Next_Prim; + end if; + end; + end if; + Formal_List := No_List; Formal := First_Formal (Subp); diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb --- a/gcc/ada/libgnat/a-cbdlli.adb +++ b/gcc/ada/libgnat/a-cbdlli.adb @@ -518,6 +518,17 @@ is return Position.Container.Nodes (Position.Node).Element; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 10) return List is + begin + return Result : List (Capacity) do + null; + end return; + end Empty; + -------------- -- Finalize -- -------------- diff --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads --- a/gcc/ada/libgnat/a-cbdlli.ads +++ b/gcc/ada/libgnat/a-cbdlli.ads @@ -56,7 +56,7 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_List, + Aggregate => (Empty => Empty, Add_Unnamed => Append_One); pragma Preelaborable_Initialization (List); @@ -67,6 +67,8 @@ is No_Element : constant Cursor; + function Empty (Capacity : Count_Type := 10) return List; + function Has_Element (Position : Cursor) return Boolean; package List_Iterator_Interfaces is new diff --git a/gcc/ada/libgnat/a-cbhama.adb b/gcc/ada/libgnat/a-cbhama.adb --- a/gcc/ada/libgnat/a-cbhama.adb +++ b/gcc/ada/libgnat/a-cbhama.adb @@ -364,6 +364,17 @@ is return Position.Container.Nodes (Position.Node).Element; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type) return Map is + begin + return Result : Map (Capacity, 0) do + null; + end return; + end Empty; + ------------------------- -- Equivalent_Key_Node -- ------------------------- diff --git a/gcc/ada/libgnat/a-cbhama.ads b/gcc/ada/libgnat/a-cbhama.ads --- a/gcc/ada/libgnat/a-cbhama.ads +++ b/gcc/ada/libgnat/a-cbhama.ads @@ -58,7 +58,7 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Map, + Aggregate => (Empty => Empty, Add_Named => Insert); pragma Preelaborable_Initialization (Map); @@ -70,6 +70,8 @@ is -- Map objects declared without an initialization expression are -- initialized to the value Empty_Map. + function Empty (Capacity : Count_Type) return Map; + No_Element : constant Cursor; -- Cursor objects declared without an initialization expression are -- initialized to the value No_Element. diff --git a/gcc/ada/libgnat/a-cbhase.adb b/gcc/ada/libgnat/a-cbhase.adb --- a/gcc/ada/libgnat/a-cbhase.adb +++ b/gcc/ada/libgnat/a-cbhase.adb @@ -456,6 +456,17 @@ is end; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 10) return Set is + begin + return Result : Set (Capacity, 0) do + Reserve_Capacity (Result, Capacity); + end return; + end Empty; + --------------------- -- Equivalent_Sets -- --------------------- diff --git a/gcc/ada/libgnat/a-cbhase.ads b/gcc/ada/libgnat/a-cbhase.ads --- a/gcc/ada/libgnat/a-cbhase.ads +++ b/gcc/ada/libgnat/a-cbhase.ads @@ -60,7 +60,7 @@ is with Constant_Indexing => Constant_Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Set, + Aggregate => (Empty => Empty, Add_Unnamed => Include); pragma Preelaborable_Initialization (Set); @@ -72,6 +72,8 @@ is -- Set objects declared without an initialization expression are -- initialized to the value Empty_Set. + function Empty (Capacity : Count_Type := 10) return Set; + No_Element : constant Cursor; -- Cursor objects declared without an initialization expression are -- initialized to the value No_Element. diff --git a/gcc/ada/libgnat/a-cborma.adb b/gcc/ada/libgnat/a-cborma.adb --- a/gcc/ada/libgnat/a-cborma.adb +++ b/gcc/ada/libgnat/a-cborma.adb @@ -573,6 +573,17 @@ is return Container.Nodes (Node).Element; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 10) return Map is + begin + return Result : Map (Capacity) do + null; + end return; + end Empty; + --------------------- -- Equivalent_Keys -- --------------------- diff --git a/gcc/ada/libgnat/a-cborma.ads b/gcc/ada/libgnat/a-cborma.ads --- a/gcc/ada/libgnat/a-cborma.ads +++ b/gcc/ada/libgnat/a-cborma.ads @@ -59,7 +59,7 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Map, + Aggregate => (Empty => Empty, Add_Named => Insert); pragma Preelaborable_Initialization (Map); @@ -69,6 +69,8 @@ is Empty_Map : constant Map; + function Empty (Capacity : Count_Type := 10) return Map; + No_Element : constant Cursor; function Has_Element (Position : Cursor) return Boolean; diff --git a/gcc/ada/libgnat/a-cborse.adb b/gcc/ada/libgnat/a-cborse.adb --- a/gcc/ada/libgnat/a-cborse.adb +++ b/gcc/ada/libgnat/a-cborse.adb @@ -549,6 +549,17 @@ is return Position.Container.Nodes (Position.Node).Element; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 10) return Set is + begin + return Result : Set (Capacity) do + null; + end return; + end Empty; + ------------------------- -- Equivalent_Elements -- ------------------------- diff --git a/gcc/ada/libgnat/a-cborse.ads b/gcc/ada/libgnat/a-cborse.ads --- a/gcc/ada/libgnat/a-cborse.ads +++ b/gcc/ada/libgnat/a-cborse.ads @@ -58,7 +58,7 @@ is with Constant_Indexing => Constant_Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Set, + Aggregate => (Empty => Empty, Add_Unnamed => Include); pragma Preelaborable_Initialization (Set); @@ -68,6 +68,8 @@ is Empty_Set : constant Set; + function Empty (Capacity : Count_Type := 10) return Set; + No_Element : constant Cursor; function Has_Element (Position : Cursor) return Boolean; diff --git a/gcc/ada/libgnat/a-cdlili.ads b/gcc/ada/libgnat/a-cdlili.ads --- a/gcc/ada/libgnat/a-cdlili.ads +++ b/gcc/ada/libgnat/a-cdlili.ads @@ -57,7 +57,7 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_List, + Aggregate => (Empty => Empty, Add_Unnamed => Append_One); pragma Preelaborable_Initialization (List); @@ -66,6 +66,7 @@ is pragma Preelaborable_Initialization (Cursor); Empty_List : constant List; + function Empty return List; No_Element : constant Cursor; @@ -391,6 +392,7 @@ private -- Returns a pointer to the element designated by Position. Empty_List : constant List := (Controlled with others => <>); + function Empty return List is (Empty_List); No_Element : constant Cursor := Cursor'(null, null); diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb --- a/gcc/ada/libgnat/a-cidlli.adb +++ b/gcc/ada/libgnat/a-cidlli.adb @@ -185,6 +185,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-cidlli.ads b/gcc/ada/libgnat/a-cidlli.ads --- a/gcc/ada/libgnat/a-cidlli.ads +++ b/gcc/ada/libgnat/a-cidlli.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, + Add_Unnamed => Append_One); pragma Preelaborable_Initialization (List); @@ -63,6 +65,7 @@ is pragma Preelaborable_Initialization (Cursor); Empty_List : constant List; + function Empty return List; No_Element : constant Cursor; @@ -146,6 +149,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; @@ -376,6 +383,7 @@ private -- Returns a pointer to the element designated by Position. Empty_List : constant List := List'(Controlled with others => <>); + function Empty return List is (Empty_List); No_Element : constant Cursor := Cursor'(null, null); diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb --- a/gcc/ada/libgnat/a-cihama.adb +++ b/gcc/ada/libgnat/a-cihama.adb @@ -385,6 +385,17 @@ is return Position.Node.Element.all; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 1000) return Map is + begin + return Result : Map do + Reserve_Capacity (Result, Capacity); + end return; + end Empty; + ------------------------- -- Equivalent_Key_Node -- ------------------------- diff --git a/gcc/ada/libgnat/a-cihama.ads b/gcc/ada/libgnat/a-cihama.ads --- a/gcc/ada/libgnat/a-cihama.ads +++ b/gcc/ada/libgnat/a-cihama.ads @@ -58,7 +58,7 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Map, + Aggregate => (Empty => Empty, Add_Named => Insert); pragma Preelaborable_Initialization (Map); @@ -70,6 +70,8 @@ is -- Map objects declared without an initialization expression are -- initialized to the value Empty_Map. + function Empty (Capacity : Count_Type := 1000) return Map; + No_Element : constant Cursor; -- Cursor objects declared without an initialization expression are -- initialized to the value No_Element. diff --git a/gcc/ada/libgnat/a-cihase.adb b/gcc/ada/libgnat/a-cihase.adb --- a/gcc/ada/libgnat/a-cihase.adb +++ b/gcc/ada/libgnat/a-cihase.adb @@ -506,6 +506,17 @@ is return Position.Node.Element.all; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 1000) return Set is + begin + return Result : Set do + Reserve_Capacity (Result, Capacity); + end return; + end Empty; + --------------------- -- Equivalent_Sets -- --------------------- diff --git a/gcc/ada/libgnat/a-cihase.ads b/gcc/ada/libgnat/a-cihase.ads --- a/gcc/ada/libgnat/a-cihase.ads +++ b/gcc/ada/libgnat/a-cihase.ads @@ -60,7 +60,7 @@ is with Constant_Indexing => Constant_Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Set, + Aggregate => (Empty => Empty, Add_Unnamed => Include); pragma Preelaborable_Initialization (Set); @@ -72,6 +72,8 @@ is -- Set objects declared without an initialization expression are -- initialized to the value Empty_Set. + function Empty (Capacity : Count_Type := 1000) return Set; + No_Element : constant Cursor; -- Cursor objects declared without an initialization expression are -- initialized to the value No_Element. diff --git a/gcc/ada/libgnat/a-ciorma.ads b/gcc/ada/libgnat/a-ciorma.ads --- a/gcc/ada/libgnat/a-ciorma.ads +++ b/gcc/ada/libgnat/a-ciorma.ads @@ -59,7 +59,7 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Map, + Aggregate => (Empty => Empty, Add_Named => Insert); pragma Preelaborable_Initialization (Map); @@ -69,6 +69,8 @@ is Empty_Map : constant Map; + function Empty return Map; + No_Element : constant Cursor; function Has_Element (Position : Cursor) return Boolean; @@ -369,6 +371,7 @@ private -- Returns a pointer to the element designated by Position. Empty_Map : constant Map := (Controlled with others => <>); + function Empty return Map is (Empty_Map); No_Element : constant Cursor := Cursor'(null, null); diff --git a/gcc/ada/libgnat/a-ciorse.ads b/gcc/ada/libgnat/a-ciorse.ads --- a/gcc/ada/libgnat/a-ciorse.ads +++ b/gcc/ada/libgnat/a-ciorse.ads @@ -58,7 +58,7 @@ is Constant_Indexing => Constant_Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Set, + Aggregate => (Empty => Empty, Add_Unnamed => Include); pragma Preelaborable_Initialization (Set); @@ -67,6 +67,7 @@ is pragma Preelaborable_Initialization (Cursor); Empty_Set : constant Set; + function Empty return Set; No_Element : constant Cursor; @@ -448,6 +449,7 @@ private -- Returns a pointer to the element designated by Position. Empty_Set : constant Set := (Controlled with others => <>); + function Empty return Set is (Empty_Set); No_Element : constant Cursor := Cursor'(null, null); diff --git a/gcc/ada/libgnat/a-cobove.adb b/gcc/ada/libgnat/a-cobove.adb --- a/gcc/ada/libgnat/a-cobove.adb +++ b/gcc/ada/libgnat/a-cobove.adb @@ -708,6 +708,17 @@ package body Ada.Containers.Bounded_Vectors is end if; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 10) return Vector is + begin + return Result : Vector (Capacity) do + Reserve_Capacity (Result, Capacity); + end return; + end Empty; + -------------- -- Finalize -- -------------- diff --git a/gcc/ada/libgnat/a-cobove.ads b/gcc/ada/libgnat/a-cobove.ads --- a/gcc/ada/libgnat/a-cobove.ads +++ b/gcc/ada/libgnat/a-cobove.ads @@ -60,7 +60,7 @@ package Ada.Containers.Bounded_Vectors is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Vector, + Aggregate => (Empty => Empty, Add_Unnamed => Append_One, New_Indexed => New_Vector, Assign_Indexed => Replace_Element); @@ -79,6 +79,8 @@ package Ada.Containers.Bounded_Vectors is package Vector_Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, Has_Element); + function Empty (Capacity : Count_Type := 10) return Vector; + overriding function "=" (Left, Right : Vector) return Boolean; function New_Vector (First, Last : Index_Type) return Vector diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb --- a/gcc/ada/libgnat/a-cohama.adb +++ b/gcc/ada/libgnat/a-cohama.adb @@ -367,6 +367,17 @@ is return Position.Node.Element; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 1000) return Map is + begin + return Result : Map do + Reserve_Capacity (Result, Capacity); + end return; + end Empty; + ------------------------- -- Equivalent_Key_Node -- ------------------------- diff --git a/gcc/ada/libgnat/a-cohama.ads b/gcc/ada/libgnat/a-cohama.ads --- a/gcc/ada/libgnat/a-cohama.ads +++ b/gcc/ada/libgnat/a-cohama.ads @@ -102,7 +102,7 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Map, + Aggregate => (Empty => Empty, Add_Named => Insert); pragma Preelaborable_Initialization (Map); @@ -118,6 +118,8 @@ is -- Cursor objects declared without an initialization expression are -- initialized to the value No_Element. + function Empty (Capacity : Count_Type := 1000) return Map; + function Has_Element (Position : Cursor) return Boolean; -- Returns True if Position designates an element, and returns False -- otherwise. diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb --- a/gcc/ada/libgnat/a-cohase.adb +++ b/gcc/ada/libgnat/a-cohase.adb @@ -468,6 +468,17 @@ is return Position.Node.Element; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 1000) return Set is + begin + return Result : Set do + Reserve_Capacity (Result, Capacity); + end return; + end Empty; + --------------------- -- Equivalent_Sets -- --------------------- diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads --- a/gcc/ada/libgnat/a-cohase.ads +++ b/gcc/ada/libgnat/a-cohase.ads @@ -61,7 +61,7 @@ is Constant_Indexing => Constant_Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Set, + Aggregate => (Empty => Empty, Add_Unnamed => Include); pragma Preelaborable_Initialization (Set); @@ -83,6 +83,8 @@ is package Set_Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, Has_Element); + function Empty (Capacity : Count_Type := 1000) return Set; + function "=" (Left, Right : Set) return Boolean; -- For each element in Left, set equality attempts to find the equal -- element in Right; if a search fails, then set equality immediately diff --git a/gcc/ada/libgnat/a-coinve.adb b/gcc/ada/libgnat/a-coinve.adb --- a/gcc/ada/libgnat/a-coinve.adb +++ b/gcc/ada/libgnat/a-coinve.adb @@ -745,6 +745,17 @@ is end; end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 10) return Vector is + begin + return Result : Vector do + Reserve_Capacity (Result, Capacity); + end return; + end Empty; + -------------- -- Finalize -- -------------- diff --git a/gcc/ada/libgnat/a-coinve.ads b/gcc/ada/libgnat/a-coinve.ads --- a/gcc/ada/libgnat/a-coinve.ads +++ b/gcc/ada/libgnat/a-coinve.ads @@ -77,6 +77,8 @@ is No_Element : constant Cursor; + function Empty (Capacity : Count_Type := 10) return Vector; + function Has_Element (Position : Cursor) return Boolean; package Vector_Iterator_Interfaces is new diff --git a/gcc/ada/libgnat/a-convec.adb b/gcc/ada/libgnat/a-convec.adb --- a/gcc/ada/libgnat/a-convec.adb +++ b/gcc/ada/libgnat/a-convec.adb @@ -614,6 +614,17 @@ is return Position.Container.Elements.EA (Position.Index); end Element; + ----------- + -- Empty -- + ----------- + + function Empty (Capacity : Count_Type := 10) return Vector is + begin + return Result : Vector do + Reserve_Capacity (Result, Capacity); + end return; + end Empty; + -------------- -- Finalize -- -------------- diff --git a/gcc/ada/libgnat/a-convec.ads b/gcc/ada/libgnat/a-convec.ads --- a/gcc/ada/libgnat/a-convec.ads +++ b/gcc/ada/libgnat/a-convec.ads @@ -94,7 +94,7 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Vector, + Aggregate => (Empty => Empty, Add_Unnamed => Append_One, New_Indexed => New_Vector, Assign_Indexed => Replace_Element); @@ -122,6 +122,8 @@ is Empty_Vector : constant Vector; -- Empty_Vector represents the empty vector object. It has a length of 0. + function Empty (Capacity : Count_Type := 10) return Vector; + overriding function "=" (Left, Right : Vector) return Boolean; -- If Left and Right denote the same vector object, then the function -- returns True. If Left and Right have different lengths, then the diff --git a/gcc/ada/libgnat/a-coorma.ads b/gcc/ada/libgnat/a-coorma.ads --- a/gcc/ada/libgnat/a-coorma.ads +++ b/gcc/ada/libgnat/a-coorma.ads @@ -59,13 +59,14 @@ is Variable_Indexing => Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type, - Aggregate => (Empty => Empty_Map, + Aggregate => (Empty => Empty, Add_Named => Insert); type Cursor is private; pragma Preelaborable_Initialization (Cursor); Empty_Map : constant Map; + function Empty return Map; No_Element : constant Cursor; @@ -373,6 +374,7 @@ private -- Returns a pointer to the element designated by Position. Empty_Map : constant Map := (Controlled with others => <>); + function Empty return Map is (Empty_Map); No_Element : constant Cursor := Cursor'(null, null); diff --git a/gcc/ada/libgnat/a-coorse.ads b/gcc/ada/libgnat/a-coorse.ads --- a/gcc/ada/libgnat/a-coorse.ads +++ b/gcc/ada/libgnat/a-coorse.ads @@ -58,7 +58,7 @@ is with Constant_Indexing => Constant_Reference, Default_Iterator => Iterate, Iterator_Element => Element_Type; - -- Aggregate => (Empty => Empty_Set, + -- Aggregate => (Empty => Empty, -- Add_Unnamed => Include); pragma Preelaborable_Initialization (Set); @@ -69,6 +69,7 @@ is function Has_Element (Position : Cursor) return Boolean; Empty_Set : constant Set; + function Empty return Set; No_Element : constant Cursor; @@ -434,6 +435,7 @@ private -- Returns a pointer to the element designated by Position. Empty_Set : constant Set := (Controlled with others => <>); + function Empty return Set is (Empty_Set); No_Element : constant Cursor := Cursor'(null, null); diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -899,6 +899,11 @@ package body Sem_Aggr is elsif Is_Array_Type (Typ) and then Null_Record_Present (N) then Error_Msg_N ("null record forbidden in array aggregate", N); + elsif Present (Find_Aspect (Typ, Aspect_Aggregate)) + and then Ekind (Typ) /= E_Record_Type + then + Resolve_Container_Aggregate (N, Typ); + elsif Is_Record_Type (Typ) then Resolve_Record_Aggregate (N, Typ); diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1009,6 +1009,15 @@ package body Sem_Type is elsif T2 = Any_Composite and then Is_Aggregate_Type (T1) then return True; + -- In Ada_2020, an aggregate is compatible with the type that + -- as the ccorrespoding aspect. + + elsif Ada_Version >= Ada_2020 + and then T2 = Any_Composite + and then Present (Find_Aspect (T1, Aspect_Aggregate)) + then + return True; + -- If the expected type is an anonymous access, the designated type must -- cover that of the expression. Use the base type for this check: even -- though access subtypes are rare in sources, they are generated for diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -368,7 +368,8 @@ package body Sinfo is or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration or else NT (N).Nkind = N_Formal_Package_Declaration or else NT (N).Nkind = N_Generic_Association - or else NT (N).Nkind = N_Iterated_Component_Association); + or else NT (N).Nkind = N_Iterated_Component_Association + or else NT (N).Nkind = N_Iterated_Element_Association); return Flag15 (N); end Box_Present; @@ -3873,7 +3874,8 @@ package body Sinfo is or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration or else NT (N).Nkind = N_Formal_Package_Declaration or else NT (N).Nkind = N_Generic_Association - or else NT (N).Nkind = N_Iterated_Component_Association); + or else NT (N).Nkind = N_Iterated_Component_Association + or else NT (N).Nkind = N_Iterated_Element_Association); Set_Flag15 (N, Val); end Set_Box_Present; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -4251,6 +4251,7 @@ package Sinfo is -- Expression (Node3) -- Loop_Parameter_Specification (Node4) -- Loop_Actions (List5-Sem) + -- Box_Present (Flag15) -- Exactly one of Iterator_Specification or Loop_Parameter_ -- specification is present. If the Key_Expression is absent,