public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH] Ada: hashed container Cursor type predefined equality non-conformance
@ 2021-03-05 14:25 Richard Wai
  2021-03-09  8:11 ` Arnaud Charlet
  0 siblings, 1 reply; 14+ messages in thread
From: Richard Wai @ 2021-03-05 14:25 UTC (permalink / raw)
  To: gcc-patches; +Cc: 'Eric Botcazou'

[-- Attachment #1: Type: text/plain, Size: 1406 bytes --]

Hi,

 

We discovered an issue with the GNAT implementation of the hashed container
types.

 

The RM states (A.18-4-18/2, A.18.7-17/2, et al) that "the predefined "="
operator for type Cursor returns True if both cursors are No_Element, or
designate the same element in the same container."

 

In some cases, GNAT's implementation violates this requirement. This was due
to the component "Position" of the Cursor type in Hashed_Sets, Hashed_Maps,
and Indefinite_Hashed_Maps (though interestingly not in
Indefinite_Hashed_Sets). The Position component is used to store the
position of a node in a bucket, and is used internally as an optimization.
Since it was viewed as an optimization, it was only updated
opportunistically. However, this effects the predefined equality for the
type. The result was that various Cursor objects could be returned which
designated the same element in the same container, but yet evaluated as
inequal.

 

The attached patch ensures that the Position value is always updated when a
Cursor object is returned or modified. It also synchronizes comments for the
Cursor type definition across the various packages. Additionally, a new
regression test case is added that checks for this issue among all four of
the hashed container packages.

 

This was successfully bootstrapped and tested on trunk,
x86_64-unknown-freebsd12.2.

 

Cheers,

 

Richard Wai

ANNEXI-STRAYLINE


[-- Attachment #2: container_cursor_equality_20210304.patch --]
[-- Type: application/octet-stream, Size: 11517 bytes --]

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;

^ permalink raw reply	[flat|nested] 14+ messages in thread
end of thread, other threads:[~2021-04-09  8:32 UTC | newest]

Thread overview: 14+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-03-05 14:25 [PATCH] Ada: hashed container Cursor type predefined equality non-conformance Richard Wai
2021-03-09  8:11 ` Arnaud Charlet
2021-03-09 15:35   ` Richard Wai
2021-03-09 15:38   ` Richard Wai
2021-03-09 15:51     ` Arnaud Charlet
2021-03-10 15:09       ` Richard Wai
2021-03-10 15:23         ` Arnaud Charlet
2021-03-10 15:59           ` Richard Wai
2021-03-10 16:26             ` Arnaud Charlet
2021-03-10 16:28               ` Richard Wai
2021-03-11 14:13               ` Richard Wai
2021-03-16 18:19               ` Richard Wai
2021-04-09  8:32                 ` Pierre-Marie de Rodat
2021-04-06 17:42               ` Richard Wai

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).