diff options
author | Richard Wai <richard@annexi-strayline.com> | 2021-03-15 06:24:00 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-04-28 05:37:52 -0400 |
commit | 5b4b66291f2086f56dc3a1d7df494f901cd0b63e (patch) | |
tree | 91443a88a83b517dc2d0d808f76c79033c8b35f8 | |
parent | fccc47dddc2ee605dd7fce5c1d1711404e19cd7f (diff) | |
download | gcc-5b4b66291f2086f56dc3a1d7df494f901cd0b63e.tar.gz |
[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.
-rw-r--r-- | gcc/ada/libgnat/a-cihama.adb | 4 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-cihama.ads | 14 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-cohama.adb | 5 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-cohama.ads | 10 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-cohase.adb | 8 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-cohase.ads | 14 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/containers2.adb | 158 |
7 files changed, 207 insertions, 6 deletions
diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb index 7a490d545cd..50adea1b46a 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 ccf5f4e58ec..f8961671b37 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 9c4e51a6392..fb46e074261 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 21b69354db0..c6e377c6bb1 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 0131f73eb7a..aac5b1b3cf2 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 a0aca526db9..c1415b57ff8 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 00000000000..9c5dc0f434f --- /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; |