From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 7E0D3385C32D; Mon, 4 Jul 2022 07:50:17 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7E0D3385C32D MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-1427] [Ada] Add Ada 2022 features to sets containers X-Act-Checkin: gcc X-Git-Author: Bob Duff X-Git-Refname: refs/heads/master X-Git-Oldrev: 2e9b2ab3b5bf6e4a0bdabfeb7358206b18253e3c X-Git-Newrev: a8a1da109efe9b12183353faa87b113f6992898f Message-Id: <20220704075017.7E0D3385C32D@sourceware.org> Date: Mon, 4 Jul 2022 07:50:17 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 04 Jul 2022 07:50:17 -0000 https://gcc.gnu.org/g:a8a1da109efe9b12183353faa87b113f6992898f commit r13-1427-ga8a1da109efe9b12183353faa87b113f6992898f Author: Bob Duff Date: Mon May 23 09:47:18 2022 -0400 [Ada] Add Ada 2022 features to sets containers This patch adds some Ada 2022 features to the set children of Ada.Containers. gcc/ada/ * libgnat/a-cbhase.adb, libgnat/a-cbhase.ads, libgnat/a-cborse.adb, libgnat/a-cborse.ads, libgnat/a-cihase.adb, libgnat/a-cihase.ads, libgnat/a-ciorse.adb, libgnat/a-ciorse.ads, libgnat/a-cohase.adb, libgnat/a-cohase.ads, libgnat/a-conhel.adb, libgnat/a-conhel.ads, libgnat/a-coorse.adb, libgnat/a-coorse.ads: Add Has_Element, Element, Query_Element, and Next subprograms that take a Set parameter. Add Tampering_With_Cursors_Prohibited function. These are all new in Ada 2022. Diff: --- gcc/ada/libgnat/a-cbhase.adb | 58 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/a-cbhase.ads | 19 +++++++++++++++ gcc/ada/libgnat/a-cborse.adb | 56 ++++++++++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/a-cborse.ads | 19 +++++++++++++++ gcc/ada/libgnat/a-cihase.adb | 58 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/a-cihase.ads | 19 +++++++++++++++ gcc/ada/libgnat/a-ciorse.adb | 55 +++++++++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/a-ciorse.ads | 19 +++++++++++++++ gcc/ada/libgnat/a-cohase.adb | 58 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/a-cohase.ads | 19 +++++++++++++++ gcc/ada/libgnat/a-conhel.adb | 8 +++--- gcc/ada/libgnat/a-conhel.ads | 28 ++++++++++++++++++--- gcc/ada/libgnat/a-coorse.adb | 55 +++++++++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/a-coorse.ads | 19 +++++++++++++++ 14 files changed, 482 insertions(+), 8 deletions(-) diff --git a/gcc/ada/libgnat/a-cbhase.adb b/gcc/ada/libgnat/a-cbhase.adb index 9076d8e8132..b83ab8038f8 100644 --- a/gcc/ada/libgnat/a-cbhase.adb +++ b/gcc/ada/libgnat/a-cbhase.adb @@ -1599,6 +1599,64 @@ is raise Program_Error with "attempt to stream reference"; end Write; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean is + begin + pragma Assert (Vet (Position), "bad cursor in Has_Element"); + pragma Assert ((Position.Container = null) = (Position.Node = 0), + "bad nullity in Has_Element"); + return Position.Container = Container'Unrestricted_Access; + end Has_Element; + + function Tampering_With_Cursors_Prohibited + (Container : Set) return Boolean + is + begin + return Is_Busy (Container.TC); + end Tampering_With_Cursors_Prohibited; + + function Element (Container : Set; Position : Cursor) return Element_Type is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + return Element (Position); + end Element; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)) is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + Query_Element (Position, Process); + end Query_Element; + + function Next (Container : Set; Position : Cursor) return Cursor is + begin + if Checks and then + not (Position = No_Element or else Has_Element (Container, Position)) + then + raise Program_Error with "Position for wrong Container"; + end if; + + return Next (Position); + end Next; + + procedure Next (Container : Set; Position : in out Cursor) is + begin + Position := Next (Container, Position); + end Next; + + ------------------ + -- Generic_Keys -- + ------------------ + package body Generic_Keys is ----------------------- diff --git a/gcc/ada/libgnat/a-cbhase.ads b/gcc/ada/libgnat/a-cbhase.ads index c30a3644d1b..7079c517418 100644 --- a/gcc/ada/libgnat/a-cbhase.ads +++ b/gcc/ada/libgnat/a-cbhase.ads @@ -369,6 +369,25 @@ is (Container : Set) return Set_Iterator_Interfaces.Forward_Iterator'Class; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean; + + function Tampering_With_Cursors_Prohibited (Container : Set) return Boolean; + + function Element (Container : Set; Position : Cursor) return Element_Type; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)); + + function Next (Container : Set; Position : Cursor) return Cursor; + + procedure Next (Container : Set; Position : in out Cursor); + + ---------------- + generic type Key_Type (<>) is private; diff --git a/gcc/ada/libgnat/a-cborse.adb b/gcc/ada/libgnat/a-cborse.adb index 55eca4077b5..bc52b4553a5 100644 --- a/gcc/ada/libgnat/a-cborse.adb +++ b/gcc/ada/libgnat/a-cborse.adb @@ -688,6 +688,62 @@ is else Cursor'(Container'Unrestricted_Access, Node)); end Floor; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean is + begin + pragma Assert + (Position.Container = null or else Vet (Container, Position.Node), + "bad cursor in Has_Element"); + pragma Assert ((Position.Container = null) = (Position.Node = 0), + "bad nullity in Has_Element"); + return Position.Container = Container'Unrestricted_Access; + end Has_Element; + + function Tampering_With_Cursors_Prohibited + (Container : Set) return Boolean + is + begin + return Is_Busy (Container.TC); + end Tampering_With_Cursors_Prohibited; + + function Element (Container : Set; Position : Cursor) return Element_Type is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + return Element (Position); + end Element; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)) is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + Query_Element (Position, Process); + end Query_Element; + + function Next (Container : Set; Position : Cursor) return Cursor is + begin + if Checks and then + not (Position = No_Element or else Has_Element (Container, Position)) + then + raise Program_Error with "Position for wrong Container"; + end if; + + return Next (Position); + end Next; + + procedure Next (Container : Set; Position : in out Cursor) is + begin + Position := Next (Container, Position); + end Next; + ------------------ -- Generic_Keys -- ------------------ diff --git a/gcc/ada/libgnat/a-cborse.ads b/gcc/ada/libgnat/a-cborse.ads index ceaf8857e43..be22c250714 100644 --- a/gcc/ada/libgnat/a-cborse.ads +++ b/gcc/ada/libgnat/a-cborse.ads @@ -230,6 +230,25 @@ is Start : Cursor) return Set_Iterator_Interfaces.Reversible_Iterator'class; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean; + + function Tampering_With_Cursors_Prohibited (Container : Set) return Boolean; + + function Element (Container : Set; Position : Cursor) return Element_Type; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)); + + function Next (Container : Set; Position : Cursor) return Cursor; + + procedure Next (Container : Set; Position : in out Cursor); + + ---------------- + generic type Key_Type (<>) is private; diff --git a/gcc/ada/libgnat/a-cihase.adb b/gcc/ada/libgnat/a-cihase.adb index 090d01cb472..0a9aabdeaa6 100644 --- a/gcc/ada/libgnat/a-cihase.adb +++ b/gcc/ada/libgnat/a-cihase.adb @@ -2031,6 +2031,64 @@ is Element_Type'Output (Stream, Node.Element.all); end Write_Node; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean is + begin + pragma Assert (Vet (Position), "bad cursor in Has_Element"); + pragma Assert ((Position.Container = null) = (Position.Node = null), + "bad nullity in Has_Element"); + return Position.Container = Container'Unrestricted_Access; + end Has_Element; + + function Tampering_With_Cursors_Prohibited + (Container : Set) return Boolean + is + begin + return Is_Busy (Container.HT.TC); + end Tampering_With_Cursors_Prohibited; + + function Element (Container : Set; Position : Cursor) return Element_Type is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + return Element (Position); + end Element; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)) is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + Query_Element (Position, Process); + end Query_Element; + + function Next (Container : Set; Position : Cursor) return Cursor is + begin + if Checks and then + not (Position = No_Element or else Has_Element (Container, Position)) + then + raise Program_Error with "Position for wrong Container"; + end if; + + return Next (Position); + end Next; + + procedure Next (Container : Set; Position : in out Cursor) is + begin + Position := Next (Container, Position); + end Next; + + ------------------ + -- Generic_Keys -- + ------------------ + package body Generic_Keys is ----------------------- diff --git a/gcc/ada/libgnat/a-cihase.ads b/gcc/ada/libgnat/a-cihase.ads index cff713dc9c2..dcd1d6a86fa 100644 --- a/gcc/ada/libgnat/a-cihase.ads +++ b/gcc/ada/libgnat/a-cihase.ads @@ -355,6 +355,25 @@ is function Iterate (Container : Set) return Set_Iterator_Interfaces.Forward_Iterator'Class; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean; + + function Tampering_With_Cursors_Prohibited (Container : Set) return Boolean; + + function Element (Container : Set; Position : Cursor) return Element_Type; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)); + + function Next (Container : Set; Position : Cursor) return Cursor; + + procedure Next (Container : Set; Position : in out Cursor); + + ---------------- + generic type Key_Type (<>) is private; diff --git a/gcc/ada/libgnat/a-ciorse.adb b/gcc/ada/libgnat/a-ciorse.adb index b23b252057b..d5502eaea46 100644 --- a/gcc/ada/libgnat/a-ciorse.adb +++ b/gcc/ada/libgnat/a-ciorse.adb @@ -721,6 +721,61 @@ is Deallocate (X); end Free; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean is + begin + pragma Assert + (Vet (Container.Tree, Position.Node), "bad cursor in Has_Element"); + pragma Assert ((Position.Container = null) = (Position.Node = null), + "bad nullity in Has_Element"); + return Position.Container = Container'Unrestricted_Access; + end Has_Element; + + function Tampering_With_Cursors_Prohibited + (Container : Set) return Boolean + is + begin + return Is_Busy (Container.Tree.TC); + end Tampering_With_Cursors_Prohibited; + + function Element (Container : Set; Position : Cursor) return Element_Type is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + return Element (Position); + end Element; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)) is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + Query_Element (Position, Process); + end Query_Element; + + function Next (Container : Set; Position : Cursor) return Cursor is + begin + if Checks and then + not (Position = No_Element or else Has_Element (Container, Position)) + then + raise Program_Error with "Position for wrong Container"; + end if; + + return Next (Position); + end Next; + + procedure Next (Container : Set; Position : in out Cursor) is + begin + Position := Next (Container, Position); + end Next; + ------------------ -- Generic_Keys -- ------------------ diff --git a/gcc/ada/libgnat/a-ciorse.ads b/gcc/ada/libgnat/a-ciorse.ads index 13272e2337b..d053ac72649 100644 --- a/gcc/ada/libgnat/a-ciorse.ads +++ b/gcc/ada/libgnat/a-ciorse.ads @@ -238,6 +238,25 @@ is Start : Cursor) return Set_Iterator_Interfaces.Reversible_Iterator'class; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean; + + function Tampering_With_Cursors_Prohibited (Container : Set) return Boolean; + + function Element (Container : Set; Position : Cursor) return Element_Type; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)); + + function Next (Container : Set; Position : Cursor) return Cursor; + + procedure Next (Container : Set; Position : in out Cursor); + + ---------------- + generic type Key_Type (<>) is private; diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb index 986b354ad72..4656868d59c 100644 --- a/gcc/ada/libgnat/a-cohase.adb +++ b/gcc/ada/libgnat/a-cohase.adb @@ -1844,6 +1844,64 @@ is Element_Type'Write (Stream, Node.Element); end Write_Node; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean is + begin + pragma Assert (Vet (Position), "bad cursor in Has_Element"); + pragma Assert ((Position.Container = null) = (Position.Node = null), + "bad nullity in Has_Element"); + return Position.Container = Container'Unrestricted_Access; + end Has_Element; + + function Tampering_With_Cursors_Prohibited + (Container : Set) return Boolean + is + begin + return Is_Busy (Container.HT.TC); + end Tampering_With_Cursors_Prohibited; + + function Element (Container : Set; Position : Cursor) return Element_Type is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + return Element (Position); + end Element; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)) is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + Query_Element (Position, Process); + end Query_Element; + + function Next (Container : Set; Position : Cursor) return Cursor is + begin + if Checks and then + not (Position = No_Element or else Has_Element (Container, Position)) + then + raise Program_Error with "Position for wrong Container"; + end if; + + return Next (Position); + end Next; + + procedure Next (Container : Set; Position : in out Cursor) is + begin + Position := Next (Container, Position); + end Next; + + ------------------ + -- Generic_Keys -- + ------------------ + package body Generic_Keys is ----------------------- diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads index ada212cda8d..9f562d899b9 100644 --- a/gcc/ada/libgnat/a-cohase.ads +++ b/gcc/ada/libgnat/a-cohase.ads @@ -367,6 +367,25 @@ is function Iterate (Container : Set) return Set_Iterator_Interfaces.Forward_Iterator'Class; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean; + + function Tampering_With_Cursors_Prohibited (Container : Set) return Boolean; + + function Element (Container : Set; Position : Cursor) return Element_Type; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)); + + function Next (Container : Set; Position : Cursor) return Cursor; + + procedure Next (Container : Set; Position : in out Cursor); + + ---------------- + generic type Key_Type (<>) is private; diff --git a/gcc/ada/libgnat/a-conhel.adb b/gcc/ada/libgnat/a-conhel.adb index b24be67469a..46f1bcc436b 100644 --- a/gcc/ada/libgnat/a-conhel.adb +++ b/gcc/ada/libgnat/a-conhel.adb @@ -36,8 +36,6 @@ package body Ada.Containers.Helpers is package body Generic_Implementation is - use type SAC.Atomic_Unsigned; - ------------ -- Adjust -- ------------ @@ -133,7 +131,7 @@ package body Ada.Containers.Helpers is procedure TC_Check (T_Counts : Tamper_Counts) is begin if T_Check then - if T_Counts.Busy > 0 then + if Is_Busy (T_Counts) then raise Program_Error with "attempt to tamper with cursors"; end if; @@ -144,7 +142,7 @@ package body Ada.Containers.Helpers is -- Thus if the busy count is zero, then the lock count -- must also be zero. - pragma Assert (T_Counts.Lock = 0); + pragma Assert (not Is_Locked (T_Counts)); end if; end TC_Check; @@ -154,7 +152,7 @@ package body Ada.Containers.Helpers is procedure TE_Check (T_Counts : Tamper_Counts) is begin - if T_Check and then T_Counts.Lock > 0 then + if T_Check and then Is_Locked (T_Counts) then raise Program_Error with "attempt to tamper with elements"; end if; diff --git a/gcc/ada/libgnat/a-conhel.ads b/gcc/ada/libgnat/a-conhel.ads index 47811f5a78a..92e23d0f6df 100644 --- a/gcc/ada/libgnat/a-conhel.ads +++ b/gcc/ada/libgnat/a-conhel.ads @@ -121,9 +121,31 @@ package Ada.Containers.Helpers is pragma Inline (TE_Check); -- Tampering-with-elements check - ----------------- - -- RAII Types -- - ----------------- + --------------------------------------- + -- Queries of busy and locked status -- + --------------------------------------- + + -- These are never called when tampering checks are suppressed. + + use type SAC.Atomic_Unsigned; + + pragma Warnings (Off); + -- Otherwise, the -gnatw.n switch triggers unwanted warnings on the + -- references to atomic variables below. + + function Is_Busy (T_Counts : Tamper_Counts) return Boolean is + (if T_Check then T_Counts.Busy > 0 else raise Program_Error); + pragma Inline (Is_Busy); + + function Is_Locked (T_Counts : Tamper_Counts) return Boolean is + (if T_Check then T_Counts.Lock > 0 else raise Program_Error); + pragma Inline (Is_Locked); + + pragma Warnings (On); + + ---------------- + -- RAII Types -- + ---------------- -- Initialize of With_Busy increments the Busy count, and Finalize -- decrements it. Thus, to prohibit tampering with elements within a diff --git a/gcc/ada/libgnat/a-coorse.adb b/gcc/ada/libgnat/a-coorse.adb index 7998ee8fe07..848022e1c41 100644 --- a/gcc/ada/libgnat/a-coorse.adb +++ b/gcc/ada/libgnat/a-coorse.adb @@ -643,6 +643,61 @@ is end if; end Free; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean is + begin + pragma Assert + (Vet (Container.Tree, Position.Node), "bad cursor in Has_Element"); + pragma Assert ((Position.Container = null) = (Position.Node = null), + "bad nullity in Has_Element"); + return Position.Container = Container'Unrestricted_Access; + end Has_Element; + + function Tampering_With_Cursors_Prohibited + (Container : Set) return Boolean + is + begin + return Is_Busy (Container.Tree.TC); + end Tampering_With_Cursors_Prohibited; + + function Element (Container : Set; Position : Cursor) return Element_Type is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + return Element (Position); + end Element; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)) is + begin + if Checks and then not Has_Element (Container, Position) then + raise Program_Error with "Position for wrong Container"; + end if; + + Query_Element (Position, Process); + end Query_Element; + + function Next (Container : Set; Position : Cursor) return Cursor is + begin + if Checks and then + not (Position = No_Element or else Has_Element (Container, Position)) + then + raise Program_Error with "Position for wrong Container"; + end if; + + return Next (Position); + end Next; + + procedure Next (Container : Set; Position : in out Cursor) is + begin + Position := Next (Container, Position); + end Next; + ------------------ -- Generic_Keys -- ------------------ diff --git a/gcc/ada/libgnat/a-coorse.ads b/gcc/ada/libgnat/a-coorse.ads index 18333364ab2..9619599a5b7 100644 --- a/gcc/ada/libgnat/a-coorse.ads +++ b/gcc/ada/libgnat/a-coorse.ads @@ -231,6 +231,25 @@ is Start : Cursor) return Set_Iterator_Interfaces.Reversible_Iterator'class; + -- Ada 2022 features: + + function Has_Element (Container : Set; Position : Cursor) return Boolean; + + function Tampering_With_Cursors_Prohibited (Container : Set) return Boolean; + + function Element (Container : Set; Position : Cursor) return Element_Type; + + procedure Query_Element + (Container : Set; + Position : Cursor; + Process : not null access procedure (Element : Element_Type)); + + function Next (Container : Set; Position : Cursor) return Cursor; + + procedure Next (Container : Set; Position : in out Cursor); + + ---------------- + generic type Key_Type (<>) is private;