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..68c1824ca03 --- /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;