From: Richard Wai Date: Mon, 15 Mar 2021 10:24:00 +0000 (-0400) Subject: [Ada] Hashed container Cursor type predefined equality non-conformance X-Git-Tag: basepoints/gcc-13~8131 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5b4b66291f2086f56dc3a1d7df494f901cd0b63e;p=thirdparty%2Fgcc.git [Ada] Hashed container Cursor type predefined equality non-conformance gcc/ada/ * libgnat/a-cohase.ads (Cursor): Synchronize comments for the Cursor type definition to be consistent with identical definitions in other container packages. Add additional comments regarding the importance of maintaining the "Position" component for predefined equality. * libgnat/a-cohama.ads (Cursor): Likewise. * libgnat/a-cihama.ads (Cursor): Likewise. * libgnat/a-cohase.adb (Find, Insert): Ensure that Cursor objects always have their "Position" component set to ensure predefined equality works as required. * libgnat/a-cohama.adb (Find, Insert): Likewise. * libgnat/a-cihama.adb (Find, Insert): Likewise. gcc/testsuite/ * gnat.dg/containers2.adb: New test. --- diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb index 7a490d545cdd..50adea1b46aa 100644 --- a/gcc/ada/libgnat/a-cihama.adb +++ b/gcc/ada/libgnat/a-cihama.adb @@ -522,7 +522,8 @@ is return No_Element; end if; - return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last); + return Cursor' + (Container'Unrestricted_Access, Node, HT_Ops.Index (HT, Node)); end Find; -------------------- @@ -748,6 +749,7 @@ is end if; Position.Container := Container'Unchecked_Access; + Position.Position := HT_Ops.Index (HT, Position.Node); end Insert; procedure Insert diff --git a/gcc/ada/libgnat/a-cihama.ads b/gcc/ada/libgnat/a-cihama.ads index ccf5f4e58ec3..f8961671b37b 100644 --- a/gcc/ada/libgnat/a-cihama.ads +++ b/gcc/ada/libgnat/a-cihama.ads @@ -363,8 +363,22 @@ private type Cursor is record Container : Map_Access; + -- Access to this cursor's container + Node : Node_Access; + -- Access to the node pointed to by this cursor + Position : Hash_Type := Hash_Type'Last; + -- Position of the node in the buckets of the container. If this is + -- equal to Hash_Type'Last, then it will not be used. Position is + -- not requried by the implementation, but improves the efficiency + -- of various operations. + -- + -- However, this value must be maintained so that the predefined + -- equality operation acts as required by RM A.18.4-18/2, which + -- states: "The predefined "=" operator for type Cursor returns True + -- if both cursors are No_Element, or designate the same element + -- in the same container." end record; procedure Write diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb index 9c4e51a63922..fb46e0742614 100644 --- a/gcc/ada/libgnat/a-cohama.adb +++ b/gcc/ada/libgnat/a-cohama.adb @@ -478,7 +478,8 @@ is return No_Element; end if; - return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last); + return Cursor' + (Container'Unrestricted_Access, Node, HT_Ops.Index (HT, Node)); end Find; -------------------- @@ -635,6 +636,7 @@ is end if; Position.Container := Container'Unrestricted_Access; + Position.Position := HT_Ops.Index (HT, Position.Node); end Insert; procedure Insert @@ -677,6 +679,7 @@ is end if; Position.Container := Container'Unrestricted_Access; + Position.Position := HT_Ops.Index (HT, Position.Node); end Insert; procedure Insert diff --git a/gcc/ada/libgnat/a-cohama.ads b/gcc/ada/libgnat/a-cohama.ads index 21b69354db02..c6e377c6bb13 100644 --- a/gcc/ada/libgnat/a-cohama.ads +++ b/gcc/ada/libgnat/a-cohama.ads @@ -465,7 +465,15 @@ private Position : Hash_Type := Hash_Type'Last; -- Position of the node in the buckets of the container. If this is - -- equal to Hash_Type'Last, then it will not be used. + -- equal to Hash_Type'Last, then it will not be used. Position is + -- not requried by the implementation, but improves the efficiency + -- of various operations. + -- + -- However, this value must be maintained so that the predefined + -- equality operation acts as required by RM A.18.4-18/2, which + -- states: "The predefined "=" operator for type Cursor returns True + -- if both cursors are No_Element, or designate the same element + -- in the same container." end record; procedure Read diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb index 0131f73eb7a3..aac5b1b3cf21 100644 --- a/gcc/ada/libgnat/a-cohase.adb +++ b/gcc/ada/libgnat/a-cohase.adb @@ -605,13 +605,13 @@ is is HT : Hash_Table_Type renames Container'Unrestricted_Access.HT; Node : constant Node_Access := Element_Keys.Find (HT, Item); - begin if Node = null then return No_Element; end if; - return Cursor'(Container'Unrestricted_Access, Node, Hash_Type'Last); + return Cursor' + (Container'Unrestricted_Access, Node, HT_Ops.Index (HT, Node)); end Find; -------------------- @@ -763,9 +763,11 @@ is Position : out Cursor; Inserted : out Boolean) is + HT : Hash_Table_Type renames Container'Unrestricted_Access.HT; begin Insert (Container.HT, New_Item, Position.Node, Inserted); Position.Container := Container'Unchecked_Access; + Position.Position := HT_Ops.Index (HT, Position.Node); end Insert; procedure Insert @@ -1998,7 +2000,7 @@ is return No_Element; else return Cursor' - (Container'Unrestricted_Access, Node, Hash_Type'Last); + (Container'Unrestricted_Access, Node, HT_Ops.Index (HT, Node)); end if; end Find; diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads index a0aca526db96..c1415b57ff8f 100644 --- a/gcc/ada/libgnat/a-cohase.ads +++ b/gcc/ada/libgnat/a-cohase.ads @@ -537,8 +537,22 @@ private type Cursor is record Container : Set_Access; + -- Access to this cursor's container + Node : Node_Access; + -- Access to the node pointed to by this cursor + Position : Hash_Type := Hash_Type'Last; + -- Position of the node in the buckets of the container. If this is + -- equal to Hash_Type'Last, then it will not be used. Position is + -- not requried by the implementation, but improves the efficiency + -- of various operations. + -- + -- However, this value must be maintained so that the predefined + -- equality operation acts as required by RM A.18.7-17/2, which + -- states: "The predefined "=" operator for type Cursor returns True + -- if both cursors are No_Element, or designate the same element + -- in the same container." end record; procedure Write diff --git a/gcc/testsuite/gnat.dg/containers2.adb b/gcc/testsuite/gnat.dg/containers2.adb new file mode 100644 index 000000000000..9c5dc0f434f4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/containers2.adb @@ -0,0 +1,158 @@ +-- { dg-do run } +-- { dg-options "-gnata" } + +with Ada.Strings.Hash; +with Ada.Containers.Hashed_Sets; +with Ada.Containers.Hashed_Maps; +with Ada.Containers.Indefinite_Hashed_Sets; +with Ada.Containers.Indefinite_Hashed_Maps; + +procedure Containers2 is + -- Check that Cursors of the hashed containers follow the correct + -- predefined equality rules - that two Cursors to the same element + -- are equal, one one is obtained through, for example, iteration, + -- and the other is obtained through a search + + subtype Definite_Name is String (1 .. 5); + + type Named_Item is + record + Name : Definite_Name; + Item : Integer := 0; + end record; + + + function Equivalent_Item (Left, Right: Named_Item) return Boolean + is (Left.Name = Right.Name); + + function DI_Hash (Item: Named_Item) return Ada.Containers.Hash_Type + is (Ada.Strings.Hash (Item.Name)); + + package HS is new Ada.Containers.Hashed_Sets + (Element_Type => Named_Item, + Hash => DI_Hash, + Equivalent_Elements => Equivalent_Item); + + package IHS is new Ada.Containers.Indefinite_Hashed_Sets + (Element_Type => Named_Item, + Hash => DI_Hash, + Equivalent_Elements => Equivalent_Item); + + package HM is new Ada.Containers.Hashed_Maps + (Key_Type => Definite_Name, + Element_Type => Integer, + Hash => Ada.Strings.Hash, + Equivalent_Keys => "="); + + package IHM is new Ada.Containers.Indefinite_Hashed_Maps + (Key_Type => Definite_Name, + Element_Type => Integer, + Hash => Ada.Strings.Hash, + Equivalent_Keys => "="); + + Item_Data : constant array (1 .. 5) of Named_Item + := ((Name => "ABCDE", others => <>), + (Name => "FGHIJ", others => <>), + (Name => "KLMNO", others => <>), + (Name => "PQRST", others => <>), + (Name => "UVWXY", others => <>)); + + use type HS.Cursor; + use type IHS.Cursor; + use type HM.Cursor; + use type IHM.Cursor; + + type HS_Cursor_Vec is array (Item_Data'Range) of HS.Cursor; + type IHS_Cursor_Vec is array (Item_Data'Range) of IHS.Cursor; + type HM_Cursor_Vec is array (Item_Data'Range) of HM.Cursor; + type IHM_Cursor_Vec is array (Item_Data'Range) of IHM.Cursor; + + HSC : HS.Set; + IHSC : IHS.Set; + HMC : HM.Map; + IHMC : IHM.Map; + + HS_Create_Cursors : HS_Cursor_Vec; + IHS_Create_Cursors : IHS_Cursor_Vec; + HM_Create_Cursors : HM_Cursor_Vec; + IHM_Create_Cursors : IHM_Cursor_Vec; + + HS_Index : HS.Cursor; + IHS_Index : IHS.Cursor; + HM_Index : HM.Cursor; + IHM_Index : IHM.Cursor; + + HS_Find : HS.Cursor; + IHS_Find : IHS.Cursor; + HM_Find : HM.Cursor; + IHM_Find : IHM.Cursor; + + + Inserted : Boolean; + +begin + + for I in Item_Data'Range loop + HSC.Insert (New_Item => Item_Data(I), + Position => HS_Create_Cursors(I), + Inserted => Inserted); + + pragma Assert (Inserted); + + + IHSC.Insert (New_Item => Item_Data(I), + Position => IHS_Create_Cursors(I), + Inserted => Inserted); + + pragma Assert (Inserted); + + HMC.Insert (New_Item => Item_Data(I).Item, + Key => Item_Data(I).Name, + Position => HM_Create_Cursors(I), + Inserted => Inserted); + + pragma Assert (Inserted); + + IHMC.Insert (New_Item => Item_Data(I).Item, + Key => Item_Data(I).Name, + Position => IHM_Create_Cursors(I), + Inserted => Inserted); + + pragma Assert (Inserted); + + end loop; + + HS_Index := HSC.First; + IHS_Index := IHSC.First; + HM_Index := HMC.First; + IHM_Index := IHMC.First; + + for I in Item_Data'Range loop + pragma Assert (HS.Has_Element (HS_Index)); + pragma Assert (IHS.Has_Element (IHS_Index)); + pragma Assert (HM.Has_Element (HM_Index)); + pragma Assert (IHM.Has_Element (IHM_Index)); + + HS_Find := HSC.Find (Item_Data(I)); + pragma Assert (HS_Create_Cursors(I) = HS_Index); + pragma Assert (HS_Find = HS_Index); + + IHS_Find := IHSC.Find (Item_Data(I)); + pragma Assert (IHS_Create_Cursors(I) = IHS_Index); + pragma Assert (IHS_Find = IHS_Index); + + HM_Find := HMC.Find (Item_Data(I).Name); + pragma Assert (HM_Create_Cursors(I) = HM_Index); + pragma Assert (HM_Find = HM_Index); + + IHM_Find := IHMC.Find (Item_Data(I).Name); + pragma Assert (IHM_Create_Cursors(I) = IHM_Index); + pragma Assert (IHM_Find = IHM_Index); + + HS.Next (HS_Index); + IHS.Next (IHS_Index); + HM.Next (HM_Index); + IHM.Next (IHM_Index); + end loop; + +end;