[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 7a490d545cddf795fae806e104bcee472c9f8b62..50adea1b46aafeff1f78017cde6afb5c83d28b28 100644 (file)
--- 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 ccf5f4e58ec3027fc81fd04a7fbd0d8624e02472..f8961671b37be848c7c37bfa72cbe865d955ec85 100644 (file)
--- 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 9c4e51a639229e7b43e0a1843d0d51ef3070632d..fb46e0742614d5687d33db4dd698e57e39dd3f7b 100644 (file)
--- 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 21b69354db0284a53795092837bb589e22eb27e0..c6e377c6bb1342ee1d401c3fbc74de339332d400 100644 (file)
--- 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 0131f73eb7a32f9f7d4f6a7d3bb6054967f60b17..aac5b1b3cf21204b2ee53818d83c9ea1b70ec8fe 100644 (file)
--- 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 a0aca526db96e4a15d228f2bc62f9a3468619d10..c1415b57ff8fb3204cbd313590798d3e3e0d7d1d 100644 (file)
--- 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 (file)
index 0000000..9c5dc0f
--- /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;