[Ada] Dynamically resizable, load factor-based hash table

This patch introduces a dynamically resizable, load factor-based hash
table in unit GNAT.Dynamic_HTables.

2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* libgnat/g-dynhta.adb, libgnat/g-dynhta.ads: New package
	Dynamic_HTable.

gcc/testsuite/

	* gnat.dg/dynhash.adb: New testcase.

git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@263709 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 1870 insertions, 33 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 11613943f99..31420a3d663 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* libgnat/g-dynhta.adb, libgnat/g-dynhta.ads: New package
+	Dynamic_HTable.
+
 2018-08-21  Javier Miranda  <miranda@adacore.com>
 
 	* checks.ads (Determine_Range): Adding documentation.
diff --git a/gcc/ada/libgnat/g-dynhta.adb b/gcc/ada/libgnat/g-dynhta.adb
index a6e2734625d..b093e792891 100644
--- a/gcc/ada/libgnat/g-dynhta.adb
+++ b/gcc/ada/libgnat/g-dynhta.adb
@@ -38,11 +38,10 @@ package body GNAT.Dynamic_HTables is
    -------------------
 
    package body Static_HTable is
-
       function Get_Non_Null (T : Instance) return Elmt_Ptr;
       --  Returns Null_Ptr if Iterator_Started is False or if the Table is
-      --  empty. Returns Iterator_Ptr if non null, or the next non null
-      --  element in table if any.
+      --  empty. Returns Iterator_Ptr if non null, or the next non null element
+      --  in table if any.
 
       ---------
       -- Get --
@@ -363,7 +362,834 @@ package body GNAT.Dynamic_HTables is
       begin
          E.Next := Next;
       end Set_Next;
-
    end Simple_HTable;
 
+   --------------------
+   -- Dynamic_HTable --
+   --------------------
+
+   package body Dynamic_HTable is
+      Minimum_Size : constant Bucket_Range_Type := 32;
+      --  Minimum size of the buckets
+
+      Safe_Compression_Size : constant Bucket_Range_Type :=
+                                Minimum_Size * Compression_Factor;
+      --  Maximum safe size for hash table compression. Beyond this size, a
+      --  compression will violate the minimum size constraint on the buckets.
+
+      Safe_Expansion_Size : constant Bucket_Range_Type :=
+                              Bucket_Range_Type'Last / Expansion_Factor;
+      --  Maximum safe size for hash table expansion. Beyond this size, an
+      --  expansion will overflow the buckets.
+
+      procedure Destroy_Buckets (Bkts : Bucket_Table_Ptr);
+      pragma Inline (Destroy_Buckets);
+      --  Destroy all nodes within buckets Bkts
+
+      procedure Detach (Nod : Node_Ptr);
+      pragma Inline (Detach);
+      --  Detach node Nod from the bucket it resides in
+
+      procedure Ensure_Circular (Head : Node_Ptr);
+      pragma Inline (Ensure_Circular);
+      --  Ensure that dummy head Head is circular with respect to itself
+
+      procedure Ensure_Created (T : Instance);
+      pragma Inline (Ensure_Created);
+      --  Verify that hash table T is created. Raise Not_Created if this is not
+      --  the case.
+
+      procedure Ensure_Unlocked (T : Instance);
+      pragma Inline (Ensure_Unlocked);
+      --  Verify that hash table T is unlocked. Raise Table_Locked if this is
+      --  not the case.
+
+      function Find_Bucket
+        (Bkts : Bucket_Table_Ptr;
+         Key  : Key_Type) return Node_Ptr;
+      pragma Inline (Find_Bucket);
+      --  Find the bucket among buckets Bkts which corresponds to key Key, and
+      --  return its dummy head.
+
+      function Find_Node (Head : Node_Ptr; Key : Key_Type) return Node_Ptr;
+      pragma Inline (Find_Node);
+      --  Traverse a bucket indicated by dummy head Head to determine whether
+      --  there exists a node with key Key. If such a node exists, return it,
+      --  otherwise return null.
+
+      procedure First_Valid_Node
+        (T        : Instance;
+         Low_Bkt  : Bucket_Range_Type;
+         High_Bkt : Bucket_Range_Type;
+         Idx      : out Bucket_Range_Type;
+         Nod      : out Node_Ptr);
+      pragma Inline (First_Valid_Node);
+      --  Find the first valid node in the buckets of hash table T constrained
+      --  by the range Low_Bkt .. High_Bkt. If such a node exists, return its
+      --  bucket index in Idx and reference in Nod. If no such node exists,
+      --  Idx is set to 0 and Nod to null.
+
+      procedure Free is
+        new Ada.Unchecked_Deallocation (Bucket_Table, Bucket_Table_Ptr);
+
+      procedure Free is
+        new Ada.Unchecked_Deallocation (Hash_Table, Instance);
+
+      procedure Free is
+        new Ada.Unchecked_Deallocation (Node, Node_Ptr);
+
+      function Is_Valid (Iter : Iterator) return Boolean;
+      pragma Inline (Is_Valid);
+      --  Determine whether iterator Iter refers to a valid key-value pair
+
+      function Is_Valid (Nod : Node_Ptr; Head : Node_Ptr) return Boolean;
+      pragma Inline (Is_Valid);
+      --  Determine whether node Nod is non-null and does not refer to dummy
+      --  head Head, thus making it valid.
+
+      function Load_Factor (T : Instance) return Threshold_Type;
+      pragma Inline (Load_Factor);
+      --  Calculate the load factor of hash table T
+
+      procedure Lock (T : Instance);
+      pragma Inline (Lock);
+      --  Lock all mutation functionality of hash table T
+
+      procedure Mutate_And_Rehash (T : Instance; Size : Bucket_Range_Type);
+      pragma Inline (Mutate_And_Rehash);
+      --  Replace the buckets of hash table T with a new set of buckets of size
+      --  Size. Rehash all key-value pairs from the old to the new buckets.
+
+      procedure Prepend (Nod : Node_Ptr; Head : Node_Ptr);
+      pragma Inline (Prepend);
+      --  Insert node Nod immediately after dummy head Head
+
+      procedure Unlock (T : Instance);
+      pragma Inline (Unlock);
+      --  Unlock all mutation functionality of hash table T
+
+      ------------
+      -- Create --
+      ------------
+
+      function Create (Initial_Size : Bucket_Range_Type) return Instance is
+         Size : constant Bucket_Range_Type :=
+                           Bucket_Range_Type'Max (Initial_Size, Minimum_Size);
+         --  Ensure that the buckets meet a minimum size
+
+         T : constant Instance := new Hash_Table;
+
+      begin
+         T.Buckets      := new Bucket_Table (0 .. Size - 1);
+         T.Initial_Size := Size;
+
+         return T;
+      end Create;
+
+      ------------
+      -- Delete --
+      ------------
+
+      procedure Delete (T : Instance; Key : Key_Type) is
+         procedure Compress;
+         pragma Inline (Compress);
+         --  Determine whether hash table T requires compression, and if so,
+         --  half its size.
+
+         --------------
+         -- Compress --
+         --------------
+
+         procedure Compress is
+            pragma Assert (T /= null);
+            pragma Assert (T.Buckets /= null);
+
+            Old_Size : constant Bucket_Range_Type := T.Buckets'Length;
+
+         begin
+            --  The ratio of pairs to buckets is under the desited threshold.
+            --  Compress the hash table only when there is still room to do so.
+
+            if Load_Factor (T) < Compression_Threshold
+              and then Old_Size >= Safe_Compression_Size
+            then
+               Mutate_And_Rehash (T, Old_Size / Compression_Factor);
+            end if;
+         end Compress;
+
+         --  Local variables
+
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      --  Start of processing for Delete
+
+      begin
+         Ensure_Created  (T);
+         Ensure_Unlocked (T);
+
+         --  Obtain the dummy head of the bucket which should house the
+         --  key-value pair.
+
+         Head := Find_Bucket (T.Buckets, Key);
+
+         --  Try to find a node in the bucket which matches the key
+
+         Nod := Find_Node (Head, Key);
+
+         --  If such a node exists, remove it from the bucket and deallocate it
+
+         if Is_Valid (Nod, Head) then
+            Detach (Nod);
+            Free   (Nod);
+
+            T.Pairs := T.Pairs - 1;
+
+            --  Compress the hash table if the load factor drops below
+            --  Compression_Threshold.
+
+            Compress;
+         end if;
+      end Delete;
+
+      -------------
+      -- Destroy --
+      -------------
+
+      procedure Destroy (T : in out Instance) is
+      begin
+         Ensure_Created  (T);
+         Ensure_Unlocked (T);
+
+         --  Destroy all nodes in all buckets
+
+         Destroy_Buckets (T.Buckets);
+         Free (T.Buckets);
+         Free (T);
+      end Destroy;
+
+      ---------------------
+      -- Destroy_Buckets --
+      ---------------------
+
+      procedure Destroy_Buckets (Bkts : Bucket_Table_Ptr) is
+         procedure Destroy_Bucket (Head : Node_Ptr);
+         pragma Inline (Destroy_Bucket);
+         --  Destroy all nodes in a bucket with dummy head Head
+
+         --------------------
+         -- Destroy_Bucket --
+         --------------------
+
+         procedure Destroy_Bucket (Head : Node_Ptr) is
+            Nod : Node_Ptr;
+
+         begin
+            --  Destroy all valid nodes which follow the dummy head
+
+            while Is_Valid (Head.Next, Head) loop
+               Nod := Head.Next;
+
+               Detach (Nod);
+               Free   (Nod);
+            end loop;
+         end Destroy_Bucket;
+
+      --  Start of processing for Destroy_Buckets
+
+      begin
+         pragma Assert (Bkts /= null);
+
+         for Scan_Idx in Bkts'Range loop
+            Destroy_Bucket (Bkts (Scan_Idx)'Access);
+         end loop;
+      end Destroy_Buckets;
+
+      ------------
+      -- Detach --
+      ------------
+
+      procedure Detach (Nod : Node_Ptr) is
+         pragma Assert (Nod /= null);
+
+         Next : constant Node_Ptr := Nod.Next;
+         Prev : constant Node_Ptr := Nod.Prev;
+
+      begin
+         pragma Assert (Next /= null);
+         pragma Assert (Prev /= null);
+
+         Prev.Next := Next;
+         Next.Prev := Prev;
+
+         Nod.Next := null;
+         Nod.Prev := null;
+      end Detach;
+
+      ---------------------
+      -- Ensure_Circular --
+      ---------------------
+
+      procedure Ensure_Circular (Head : Node_Ptr) is
+         pragma Assert (Head /= null);
+
+      begin
+         if Head.Next = null and then Head.Prev = null then
+            Head.Next := Head;
+            Head.Prev := Head;
+         end if;
+      end Ensure_Circular;
+
+      --------------------
+      -- Ensure_Created --
+      --------------------
+
+      procedure Ensure_Created (T : Instance) is
+      begin
+         if T = null then
+            raise Not_Created;
+         end if;
+      end Ensure_Created;
+
+      ---------------------
+      -- Ensure_Unlocked --
+      ---------------------
+
+      procedure Ensure_Unlocked (T : Instance) is
+      begin
+         pragma Assert (T /= null);
+
+         --  The hash table has at least one outstanding iterator
+
+         if T.Locked > 0 then
+            raise Table_Locked;
+         end if;
+      end Ensure_Unlocked;
+
+      -----------------
+      -- Find_Bucket --
+      -----------------
+
+      function Find_Bucket
+        (Bkts : Bucket_Table_Ptr;
+         Key  : Key_Type) return Node_Ptr
+      is
+         pragma Assert (Bkts /= null);
+
+         Idx : constant Bucket_Range_Type := Hash (Key) mod Bkts'Length;
+
+      begin
+         return Bkts (Idx)'Access;
+      end Find_Bucket;
+
+      ---------------
+      -- Find_Node --
+      ---------------
+
+      function Find_Node (Head : Node_Ptr; Key : Key_Type) return Node_Ptr is
+         pragma Assert (Head /= null);
+
+         Nod : Node_Ptr;
+
+      begin
+         --  Traverse the nodes of the bucket, looking for a key-value pair
+         --  with the same key.
+
+         Nod := Head.Next;
+         while Is_Valid (Nod, Head) loop
+            if Equivalent_Keys (Nod.Key, Key) then
+               return Nod;
+            end if;
+
+            Nod := Nod.Next;
+         end loop;
+
+         return null;
+      end Find_Node;
+
+      ----------------------
+      -- First_Valid_Node --
+      ----------------------
+
+      procedure First_Valid_Node
+        (T        : Instance;
+         Low_Bkt  : Bucket_Range_Type;
+         High_Bkt : Bucket_Range_Type;
+         Idx      : out Bucket_Range_Type;
+         Nod      : out Node_Ptr)
+      is
+         Head : Node_Ptr;
+
+      begin
+         pragma Assert (T /= null);
+         pragma Assert (T.Buckets /= null);
+
+         --  Assume that no valid node exists
+
+         Idx := 0;
+         Nod := null;
+
+         --  Examine the buckets of the hash table within the requested range,
+         --  looking for the first valid node.
+
+         for Scan_Idx in Low_Bkt .. High_Bkt loop
+            Head := T.Buckets (Scan_Idx)'Access;
+
+            --  The bucket contains at least one valid node, return the first
+            --  such node.
+
+            if Is_Valid (Head.Next, Head) then
+               Idx := Scan_Idx;
+               Nod := Head.Next;
+               return;
+            end if;
+         end loop;
+      end First_Valid_Node;
+
+      ---------
+      -- Get --
+      ---------
+
+      function Get (T : Instance; Key : Key_Type) return Value_Type is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created (T);
+
+         --  Obtain the dummy head of the bucket which should house the
+         --  key-value pair.
+
+         Head := Find_Bucket (T.Buckets, Key);
+
+         --  Try to find a node in the bucket which matches the key
+
+         Nod := Find_Node (Head, Key);
+
+         --  If such a node exists, return the value of the key-value pair
+
+         if Is_Valid (Nod, Head) then
+            return Nod.Value;
+         end if;
+
+         return No_Value;
+      end Get;
+
+      --------------
+      -- Has_Next --
+      --------------
+
+      function Has_Next (Iter : Iterator) return Boolean is
+         Is_OK : constant Boolean  := Is_Valid (Iter);
+         T     : constant Instance := Iter.Table;
+
+      begin
+         pragma Assert (T /= null);
+
+         --  The iterator is no longer valid which indicates that it has been
+         --  exhausted. Unlock all mutation functionality of the hash table
+         --  because the iterator cannot be advanced any further.
+
+         if not Is_OK then
+            Unlock (T);
+         end if;
+
+         return Is_OK;
+      end Has_Next;
+
+      --------------
+      -- Is_Valid --
+      --------------
+
+      function Is_Valid (Iter : Iterator) return Boolean is
+      begin
+         --  The invariant of Iterate and Next ensures that the iterator always
+         --  refers to a valid node if there exists one.
+
+         return Iter.Nod /= null;
+      end Is_Valid;
+
+      --------------
+      -- Is_Valid --
+      --------------
+
+      function Is_Valid (Nod : Node_Ptr; Head : Node_Ptr) return Boolean is
+      begin
+         --  A node is valid if it is non-null, and does not refer to the dummy
+         --  head of some bucket.
+
+         return Nod /= null and then Nod /= Head;
+      end Is_Valid;
+
+      -------------
+      -- Iterate --
+      -------------
+
+      function Iterate (T : Instance) return Iterator is
+         Iter : Iterator;
+
+      begin
+         Ensure_Created (T);
+         pragma Assert (T.Buckets /= null);
+
+         --  Initialize the iterator to reference the first valid node in
+         --  the full range of hash table buckets. If no such node exists,
+         --  the iterator is left in a state which does not allow it to
+         --  advance.
+
+         First_Valid_Node
+           (T        => T,
+            Low_Bkt  => T.Buckets'First,
+            High_Bkt => T.Buckets'Last,
+            Idx      => Iter.Idx,
+            Nod      => Iter.Nod);
+
+         --  Associate the iterator with the hash table to allow for future
+         --  mutation functionality unlocking.
+
+         Iter.Table := T;
+
+         --  Lock all mutation functionality of the hash table while it is
+         --  being iterated on.
+
+         Lock (T);
+
+         return Iter;
+      end Iterate;
+
+      -----------------
+      -- Load_Factor --
+      -----------------
+
+      function Load_Factor (T : Instance) return Threshold_Type is
+         pragma Assert (T /= null);
+         pragma Assert (T.Buckets /= null);
+
+      begin
+         --  The load factor is the ratio of key-value pairs to buckets
+
+         return Threshold_Type (T.Pairs) / Threshold_Type (T.Buckets'Length);
+      end Load_Factor;
+
+      ----------
+      -- Lock --
+      ----------
+
+      procedure Lock (T : Instance) is
+      begin
+         --  The hash table may be locked multiple times if multiple iterators
+         --  are operating over it.
+
+         T.Locked := T.Locked + 1;
+      end Lock;
+
+      -----------------------
+      -- Mutate_And_Rehash --
+      -----------------------
+
+      procedure Mutate_And_Rehash (T : Instance; Size : Bucket_Range_Type) is
+         procedure Rehash (From : Bucket_Table_Ptr; To : Bucket_Table_Ptr);
+         pragma Inline (Rehash);
+         --  Remove all nodes from buckets From and rehash them into buckets To
+
+         procedure Rehash_Bucket (Head : Node_Ptr; To : Bucket_Table_Ptr);
+         pragma Inline (Rehash_Bucket);
+         --  Detach all nodes starting from dummy head Head and rehash them
+         --  into To.
+
+         procedure Rehash_Node (Nod : Node_Ptr; To : Bucket_Table_Ptr);
+         pragma Inline (Rehash_Node);
+         --  Rehash node Nod into To
+
+         ------------
+         -- Rehash --
+         ------------
+
+         procedure Rehash (From : Bucket_Table_Ptr; To : Bucket_Table_Ptr) is
+         begin
+            pragma Assert (From /= null);
+            pragma Assert (To /= null);
+
+            for Scan_Idx in From'Range loop
+               Rehash_Bucket (From (Scan_Idx)'Access, To);
+            end loop;
+         end Rehash;
+
+         -------------------
+         -- Rehash_Bucket --
+         -------------------
+
+         procedure Rehash_Bucket (Head : Node_Ptr; To : Bucket_Table_Ptr) is
+            pragma Assert (Head /= null);
+
+            Nod : Node_Ptr;
+
+         begin
+            --  Detach all nodes which follow the dummy head
+
+            while Is_Valid (Head.Next, Head) loop
+               Nod := Head.Next;
+
+               Detach (Nod);
+               Rehash_Node (Nod, To);
+            end loop;
+         end Rehash_Bucket;
+
+         -----------------
+         -- Rehash_Node --
+         -----------------
+
+         procedure Rehash_Node (Nod : Node_Ptr; To : Bucket_Table_Ptr) is
+            pragma Assert (Nod /= null);
+
+            Head : Node_Ptr;
+
+         begin
+            --  Obtain the dummy head of the bucket which should house the
+            --  key-value pair.
+
+            Head := Find_Bucket (To, Nod.Key);
+
+            --  Ensure that the dummy head of an empty bucket is circular with
+            --  respect to itself.
+
+            Ensure_Circular (Head);
+
+            --  Prepend the node to the bucket
+
+            Prepend (Nod, Head);
+         end Rehash_Node;
+
+         --  Local declarations
+
+         Old_Bkts : Bucket_Table_Ptr;
+
+      --  Start of processing for Mutate_And_Rehash
+
+      begin
+         pragma Assert (T /= null);
+
+         Old_Bkts  := T.Buckets;
+         T.Buckets := new Bucket_Table (0 .. Size - 1);
+
+         --  Transfer and rehash all key-value pairs from the old buckets to
+         --  the new buckets.
+
+         Rehash (From => Old_Bkts, To => T.Buckets);
+         Free (Old_Bkts);
+      end Mutate_And_Rehash;
+
+      ----------
+      -- Next --
+      ----------
+
+      procedure Next (Iter : in out Iterator; Key : out Key_Type) is
+         Is_OK : constant Boolean  := Is_Valid (Iter);
+         Saved : constant Node_Ptr := Iter.Nod;
+         T     : constant Instance := Iter.Table;
+         Head  : Node_Ptr;
+
+      begin
+         pragma Assert (T /= null);
+         pragma Assert (T.Buckets /= null);
+
+         --  The iterator is no longer valid which indicates that it has been
+         --  exhausted. Unlock all mutation functionality of the hash table as
+         --  the iterator cannot be advanced any further.
+
+         if not Is_OK then
+            Unlock (T);
+            raise Iterator_Exhausted;
+         end if;
+
+         --  Advance to the next node along the same bucket
+
+         Iter.Nod := Iter.Nod.Next;
+         Head     := T.Buckets (Iter.Idx)'Access;
+
+         --  If the new node is no longer valid, then this indicates that the
+         --  current bucket has been exhausted. Advance to the next valid node
+         --  within the remaining range of buckets. If no such node exists, the
+         --  iterator is left in a state which does not allow it to advance.
+
+         if not Is_Valid (Iter.Nod, Head) then
+            First_Valid_Node
+              (T      => T,
+               Low_Bkt  => Iter.Idx + 1,
+               High_Bkt => T.Buckets'Last,
+               Idx      => Iter.Idx,
+               Nod      => Iter.Nod);
+         end if;
+
+         Key := Saved.Key;
+      end Next;
+
+      -------------
+      -- Prepend --
+      -------------
+
+      procedure Prepend (Nod : Node_Ptr; Head : Node_Ptr) is
+         pragma Assert (Nod /= null);
+         pragma Assert (Head /= null);
+
+         Next : constant Node_Ptr := Head.Next;
+
+      begin
+         Head.Next := Nod;
+         Next.Prev := Nod;
+
+         Nod.Next := Next;
+         Nod.Prev := Head;
+      end Prepend;
+
+      ---------
+      -- Put --
+      ---------
+
+      procedure Put
+        (T     : Instance;
+         Key   : Key_Type;
+         Value : Value_Type)
+      is
+         procedure Expand;
+         pragma Inline (Expand);
+         --  Determine whether hash table T requires expansion, and if so,
+         --  double its size.
+
+         procedure Prepend_Or_Replace (Head : Node_Ptr);
+         pragma Inline (Prepend_Or_Replace);
+         --  Update the value of a node within a bucket with dummy head Head
+         --  whose key is Key to Value. If there is no such node, prepend a new
+         --  key-value pair to the bucket.
+
+         ------------
+         -- Expand --
+         ------------
+
+         procedure Expand is
+            pragma Assert (T /= null);
+            pragma Assert (T.Buckets /= null);
+
+            Old_Size : constant Bucket_Range_Type := T.Buckets'Length;
+
+         begin
+            --  The ratio of pairs to buckets is over the desited threshold.
+            --  Expand the hash table only when there is still room to do so.
+
+            if Load_Factor (T) > Expansion_Threshold
+              and then Old_Size <= Safe_Expansion_Size
+            then
+               Mutate_And_Rehash (T, Old_Size * Expansion_Factor);
+            end if;
+         end Expand;
+
+         ------------------------
+         -- Prepend_Or_Replace --
+         ------------------------
+
+         procedure Prepend_Or_Replace (Head : Node_Ptr) is
+            pragma Assert (Head /= null);
+
+            Nod : Node_Ptr;
+
+         begin
+            --  If the bucket containst at least one valid node, then there is
+            --  a chance that a node with the same key as Key exists. If this
+            --  is the case, the value of that node must be updated.
+
+            Nod := Head.Next;
+            while Is_Valid (Nod, Head) loop
+               if Equivalent_Keys (Nod.Key, Key) then
+                  Nod.Value := Value;
+                  return;
+               end if;
+
+               Nod := Nod.Next;
+            end loop;
+
+            --  At this point the bucket is either empty, or none of the nodes
+            --  match key Key. Prepend a new key-value pair.
+
+            Nod := new Node'(Key, Value, null, null);
+
+            Prepend (Nod, Head);
+         end Prepend_Or_Replace;
+
+         --  Local variables
+
+         Head : Node_Ptr;
+
+      --  Start of processing for Put
+
+      begin
+         Ensure_Created  (T);
+         Ensure_Unlocked (T);
+
+         --  Obtain the dummy head of the bucket which should house the
+         --  key-value pair.
+
+         Head := Find_Bucket (T.Buckets, Key);
+
+         --  Ensure that the dummy head of an empty bucket is circular with
+         --  respect to itself.
+
+         Ensure_Circular (Head);
+
+         --  In case the bucket already contains a node with the same key,
+         --  replace its value, otherwise prepend a new key-value pair.
+
+         Prepend_Or_Replace (Head);
+
+         T.Pairs := T.Pairs + 1;
+
+         --  Expand the hash table if the ratio of pairs to buckets goes over
+         --  Expansion_Threshold.
+
+         Expand;
+      end Put;
+
+      -----------
+      -- Reset --
+      -----------
+
+      procedure Reset (T : Instance) is
+      begin
+         Ensure_Created  (T);
+         Ensure_Unlocked (T);
+
+         --  Destroy all nodes in all buckets
+
+         Destroy_Buckets (T.Buckets);
+         Free (T.Buckets);
+
+         --  Recreate the buckets using the original size from creation time
+
+         T.Buckets := new Bucket_Table (0 .. T.Initial_Size - 1);
+         T.Pairs   := 0;
+      end Reset;
+
+      ----------
+      -- Size --
+      ----------
+
+      function Size (T : Instance) return Pair_Count_Type is
+      begin
+         Ensure_Created (T);
+
+         return T.Pairs;
+      end Size;
+
+      ------------
+      -- Unlock --
+      ------------
+
+      procedure Unlock (T : Instance) is
+      begin
+         --  The hash table may be locked multiple times if multiple iterators
+         --  are operating over it.
+
+         T.Locked := T.Locked - 1;
+      end Unlock;
+   end Dynamic_HTable;
+
 end GNAT.Dynamic_HTables;
diff --git a/gcc/ada/libgnat/g-dynhta.ads b/gcc/ada/libgnat/g-dynhta.ads
index ea331c04871..41574fd32d0 100644
--- a/gcc/ada/libgnat/g-dynhta.ads
+++ b/gcc/ada/libgnat/g-dynhta.ads
@@ -31,13 +31,11 @@
 
 --  Hash table searching routines
 
---  This package contains three separate packages. The Simple_HTable package
+--  This package contains two separate packages. The Simple_HTable package
 --  provides a very simple abstraction that associates one element to one key
 --  value and takes care of all allocations automatically using the heap. The
 --  Static_HTable package provides a more complex interface that allows full
---  control over allocation. The Load_Factor_HTable package provides a more
---  complex abstraction where collisions are resolved by chaining, and the
---  table grows by a percentage after the load factor has been exceeded.
+--  control over allocation.
 
 --  This package provides a facility similar to that of GNAT.HTable, except
 --  that this package declares types that can be used to define dynamic
@@ -48,6 +46,8 @@
 --  GNAT.HTable to keep as much coherency as possible between these two
 --  related units.
 
+pragma Compiler_Unit_Warning;
+
 package GNAT.Dynamic_HTables is
 
    -------------------
@@ -85,40 +85,38 @@ package GNAT.Dynamic_HTables is
       Null_Ptr : Elmt_Ptr;
       --  The null value of the Elmt_Ptr type
 
+      with function Next (E : Elmt_Ptr) return Elmt_Ptr;
       with procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
-      with function  Next     (E : Elmt_Ptr) return Elmt_Ptr;
       --  The type must provide an internal link for the sake of the
       --  staticness of the HTable.
 
       type Key is limited private;
       with function Get_Key (E : Elmt_Ptr) return Key;
-      with function Hash    (F : Key)      return Header_Num;
-      with function Equal   (F1, F2 : Key) return Boolean;
+      with function Hash (F : Key) return Header_Num;
+      with function Equal (F1 : Key; F2 : Key) return Boolean;
 
    package Static_HTable is
-
       type Instance is private;
       Nil : constant Instance;
 
       procedure Reset (T : in out Instance);
-      --  Resets the hash table by releasing all memory associated with
-      --  it. The hash table can safely be reused after this call. For the
-      --  most common case where Elmt_Ptr is an access type, and Null_Ptr is
-      --  null, this is only needed if the same table is reused in a new
-      --  context. If Elmt_Ptr is other than an access type, or Null_Ptr is
-      --  other than null, then Reset must be called before the first use of
-      --  the hash table.
+      --  Resets the hash table by releasing all memory associated with it. The
+      --  hash table can safely be reused after this call. For the most common
+      --  case where Elmt_Ptr is an access type, and Null_Ptr is null, this is
+      --  only needed if the same table is reused in a new context. If Elmt_Ptr
+      --  is other than an access type, or Null_Ptr is other than null, then
+      --  Reset must be called before the first use of the hash table.
 
       procedure Set (T : in out Instance; E : Elmt_Ptr);
       --  Insert the element pointer in the HTable
 
       function Get (T : Instance; K : Key) return Elmt_Ptr;
-      --  Returns the latest inserted element pointer with the given Key
-      --  or null if none.
+      --  Returns the latest inserted element pointer with the given Key or
+      --  null if none.
 
       procedure Remove (T : Instance; K : Key);
-      --  Removes the latest inserted element pointer associated with the
-      --  given key if any, does nothing if none.
+      --  Removes the latest inserted element pointer associated with the given
+      --  key if any, does nothing if none.
 
       function Get_First (T : Instance) return Elmt_Ptr;
       --  Returns Null_Ptr if the Htable is empty, otherwise returns one
@@ -126,11 +124,11 @@ package GNAT.Dynamic_HTables is
       --  function will return the same element.
 
       function Get_Next (T : Instance) return Elmt_Ptr;
-      --  Returns an unspecified element that has not been returned by the
-      --  same function since the last call to Get_First or Null_Ptr if
-      --  there is no such element or Get_First has never been called. If
-      --  there is no call to 'Set' in between Get_Next calls, all the
-      --  elements of the Htable will be traversed.
+      --  Returns an unspecified element that has not been returned by the same
+      --  function since the last call to Get_First or Null_Ptr if there is no
+      --  such element or Get_First has never been called. If there is no call
+      --  to 'Set' in between Get_Next calls, all the elements of the Htable
+      --  will be traversed.
 
    private
       type Table_Type is array (Header_Num) of Elmt_Ptr;
@@ -169,11 +167,10 @@ package GNAT.Dynamic_HTables is
       --  a given key
 
       type Key is private;
-      with function Hash  (F : Key)      return Header_Num;
-      with function Equal (F1, F2 : Key) return Boolean;
+      with function Hash (F : Key) return Header_Num;
+      with function Equal (F1 : Key; F2 : Key) return Boolean;
 
    package Simple_HTable is
-
       type Instance is private;
       Nil : constant Instance;
 
@@ -233,7 +230,6 @@ package GNAT.Dynamic_HTables is
       --  same restrictions apply as Get_Next.
 
    private
-
       type Element_Wrapper;
       type Elmt_Ptr is access all Element_Wrapper;
       type Element_Wrapper is record
@@ -260,7 +256,263 @@ package GNAT.Dynamic_HTables is
 
       type Instance is new Tab.Instance;
       Nil : constant Instance := Instance (Tab.Nil);
-
    end Simple_HTable;
 
+   --------------------
+   -- Dynamic_HTable --
+   --------------------
+
+   --  The following package offers a hash table abstraction with the following
+   --  characteristics:
+   --
+   --    * Dynamic resizing based on load factor.
+   --    * Creation of multiple instances, of different sizes.
+   --    * Iterable keys.
+   --
+   --  This type of hash table is best used in scenarios where the size of the
+   --  key set is not known. The dynamic resizing aspect allows for performance
+   --  to remain within reasonable bounds as the size of the key set grows.
+   --
+   --  The following use pattern must be employed when operating this table:
+   --
+   --    Table : Instance := Create (<some size>);
+   --
+   --    <various operations>
+   --
+   --    Destroy (Table);
+   --
+   --  The destruction of the table reclaims all storage occupied by it.
+
+   --  The following type denotes the underlying range of the hash table
+   --  buckets.
+
+   type Bucket_Range_Type is mod 2 ** 32;
+
+   --  The following type denotes the multiplicative factor used in expansion
+   --  and compression of the hash table.
+
+   subtype Factor_Type is Bucket_Range_Type range 2 .. 100;
+
+   --  The following type denotes the number of key-value pairs stored in the
+   --  hash table.
+
+   type Pair_Count_Type is range 0 .. 2 ** 31 - 1;
+
+   --  The following type denotes the threshold range used in expansion and
+   --  compression of the hash table.
+
+   subtype Threshold_Type is Long_Float range 0.0 .. Long_Float'Last;
+
+   generic
+      type Key_Type is private;
+      type Value_Type is private;
+      --  The types of the key-value pairs stored in the hash table
+
+      No_Value : Value_Type;
+      --  An indicator for a non-existent value
+
+      Expansion_Threshold : Threshold_Type;
+      Expansion_Factor    : Factor_Type;
+      --  Once the load factor goes over Expansion_Threshold, the size of the
+      --  buckets is increased using the formula
+      --
+      --    New_Size = Old_Size * Expansion_Factor
+      --
+      --  An Expansion_Threshold of 1.5 and Expansion_Factor of 2 indicate that
+      --  the size of the buckets will be doubled once the load factor exceeds
+      --  1.5.
+
+      Compression_Threshold : Threshold_Type;
+      Compression_Factor    : Factor_Type;
+      --  Once the load factor drops below Compression_Threshold, the size of
+      --  the buckets is decreased using the formula
+      --
+      --    New_Size = Old_Size / Compression_Factor
+      --
+      --  A Compression_Threshold of 0.5 and Compression_Factor of 2 indicate
+      --  that the size of the buckets will be halved once the load factor
+      --  drops below 0.5.
+
+      with function Equivalent_Keys
+             (Left  : Key_Type;
+              Right : Key_Type) return Boolean;
+      --  Determine whether two keys are equivalent
+
+      with function Hash (Key : Key_Type) return Bucket_Range_Type;
+      --  Map an arbitrary key into the range of buckets
+
+   package Dynamic_HTable is
+
+      ----------------------
+      -- Table operations --
+      ----------------------
+
+      --  The following type denotes a hash table handle. Each instance must be
+      --  created using routine Create.
+
+      type Instance is private;
+      Nil : constant Instance;
+
+      Not_Created : exception;
+      --  This exception is raised when the hash table has not been created by
+      --  routine Create, and an attempt is made to read or mutate its state.
+
+      Table_Locked : exception;
+      --  This exception is raised when the hash table is being iterated on,
+      --  and an attempt is made to mutate its state.
+
+      function Create (Initial_Size : Bucket_Range_Type) return Instance;
+      --  Create a new table with bucket capacity Initial_Size. This routine
+      --  must be called at the start of a hash table's lifetime.
+
+      procedure Delete (T : Instance; Key : Key_Type);
+      --  Delete the value which corresponds to key Key from hash table T. The
+      --  routine has no effect if the value is not present in the hash table.
+      --  This action will raise Table_Locked if the hash table has outstanding
+      --  iterators. If the load factor drops below Compression_Threshold, the
+      --  size of the buckets is decreased by Copression_Factor.
+
+      procedure Destroy (T : in out Instance);
+      --  Destroy the contents of hash table T, rendering it unusable. This
+      --  routine must be called at the end of a hash table's lifetime. This
+      --  action will raise Table_Locked if the hash table has outstanding
+      --  iterators.
+
+      function Get (T : Instance; Key : Key_Type) return Value_Type;
+      --  Obtain the value which corresponds to key Key from hash table T. If
+      --  the value does not exist, return No_Value.
+
+      procedure Put
+        (T     : Instance;
+         Key   : Key_Type;
+         Value : Value_Type);
+      --  Associate value Value with key Key in hash table T. If the table
+      --  already contains a mapping of the same key to a previous value, the
+      --  previous value is overwritten. This action will raise Table_Locked
+      --  if the hash table has outstanding iterators. If the load factor goes
+      --  over Expansion_Threshold, the size of the buckets is increased by
+      --  Expansion_Factor.
+
+      procedure Reset (T : Instance);
+      --  Destroy the contents of hash table T, and reset it to its initial
+      --  created state. This action will raise Table_Locked if the hash table
+      --  has outstanding iterators.
+
+      function Size (T : Instance) return Pair_Count_Type;
+      --  Obtain the number of key-value pairs in hash table T
+
+      -------------------------
+      -- Iterator operations --
+      -------------------------
+
+      --  The following type represents a key iterator. An iterator locks
+      --  all mutation operations, and unlocks them once it is exhausted.
+      --  The iterator must be used with the following pattern:
+      --
+      --    Iter := Iterate (My_Table);
+      --    while Has_Next (Iter) loop
+      --       Key := Next (Iter);
+      --       . . .
+      --    end loop;
+      --
+      --  It is possible to advance the iterator by using Next only, however
+      --  this risks raising Iterator_Exhausted.
+
+      type Iterator is private;
+
+      Iterator_Exhausted : exception;
+      --  This exception is raised when an iterator is exhausted and further
+      --  attempts to advance it are made by calling routine Next.
+
+      function Iterate (T : Instance) return Iterator;
+      --  Obtain an iterator over the keys of hash table T. This action locks
+      --  all mutation functionality of the associated hash table.
+
+      function Has_Next (Iter : Iterator) return Boolean;
+      --  Determine whether iterator Iter has more keys to examine. If the
+      --  iterator has been exhausted, restore all mutation functionality of
+      --  the associated hash table.
+
+      procedure Next
+        (Iter : in out Iterator;
+         Key  : out Key_Type);
+      --  Return the current key referenced by iterator Iter and advance to
+      --  the next available key. If the iterator has been exhausted and
+      --  further attempts are made to advance it, this routine restores
+      --  mutation functionality of the associated hash table, and then
+      --  raises Iterator_Exhausted.
+
+   private
+      --  The following type represents a doubly linked list node used to
+      --  store a key-value pair. There are several reasons to use a doubly
+      --  linked list:
+      --
+      --    * Most read and write operations utilize the same primitve
+      --      routines to locate, create, and delete a node, allowing for
+      --      greater degree of code sharing.
+      --
+      --    * Special cases are eliminated by maintaining a circular node
+      --      list with a dummy head (see type Bucket_Table).
+      --
+      --  A node is said to be "valid" if it is non-null, and does not refer to
+      --  the dummy head of some bucket.
+
+      type Node;
+      type Node_Ptr is access all Node;
+      type Node is record
+         Key   : Key_Type;
+         Value : Value_Type := No_Value;
+         --  Key-value pair stored in a bucket
+
+         Prev : Node_Ptr := null;
+         Next : Node_Ptr := null;
+      end record;
+
+      --  The following type represents a bucket table. Each bucket contains a
+      --  circular doubly linked list of nodes with a dummy head. Initially,
+      --  the head does not refer to itself. This is intentional because it
+      --  improves the performance of creation, compression, and expansion by
+      --  avoiding a separate pass to link a head to itself. Several routines
+      --  ensure that the head is properly formed.
+
+      type Bucket_Table is array (Bucket_Range_Type range <>) of aliased Node;
+      type Bucket_Table_Ptr is access Bucket_Table;
+
+      --  The following type represents a hash table
+
+      type Hash_Table is record
+         Buckets : Bucket_Table_Ptr := null;
+         --  Reference to the compressing / expanding buckets
+
+         Initial_Size : Bucket_Range_Type := 0;
+         --  The initial size of the buckets as specified at creation time
+
+         Locked : Natural := 0;
+         --  Number of outstanding iterators
+
+         Pairs : Pair_Count_Type := 0;
+         --  Number of key-value pairs in the buckets
+      end record;
+
+      type Instance is access Hash_Table;
+      Nil : constant Instance := null;
+
+      --  The following type represents a key iterator
+
+      type Iterator is record
+         Idx : Bucket_Range_Type := 0;
+         --  Index of the current bucket being examined. This index is always
+         --  kept within the range of the buckets.
+
+         Nod : Node_Ptr := null;
+         --  Reference to the current node being examined within the current
+         --  bucket. The invariant of the iterator requires that this field
+         --  always point to a valid node. A value of null indicates that the
+         --  iterator is exhausted.
+
+         Table : Instance := null;
+         --  Reference to the associated hash table
+      end record;
+   end Dynamic_HTable;
+
 end GNAT.Dynamic_HTables;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 13faad8a1dc..2c02ca1549a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* gnat.dg/dynhash.adb: New testcase.
+
 2018-08-21  Javier Miranda  <miranda@adacore.com>
 
 	* gnat.dg/enum4.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/dynhash.adb b/gcc/testsuite/gnat.dg/dynhash.adb
new file mode 100644
index 00000000000..79e1b984066
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/dynhash.adb
@@ -0,0 +1,750 @@
+--  { dg-do run }
+
+with Ada.Text_IO;          use Ada.Text_IO;
+with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
+
+procedure Dynhash is
+   function Hash (Key : Integer) return Bucket_Range_Type;
+
+   package DHT is new Dynamic_HTable
+     (Key_Type              => Integer,
+      Value_Type            => Integer,
+      No_Value              => 0,
+      Expansion_Threshold   => 1.3,
+      Expansion_Factor      => 2,
+      Compression_Threshold => 0.3,
+      Compression_Factor    => 2,
+      Equivalent_Keys       => "=",
+      Hash                  => Hash);
+   use DHT;
+
+   function Create_And_Populate
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Init_Size : Bucket_Range_Type) return Instance;
+   --  Create a hash table with initial size Init_Size and populate it with
+   --  key-value pairs where both keys and values are in the range Low_Key
+   --  .. High_Key.
+
+   procedure Check_Empty
+     (Caller    : String;
+      T         : Instance;
+      Low_Key   : Integer;
+      High_Key  : Integer);
+   --  Ensure that
+   --
+   --    * The key-value pairs count of hash table T is 0.
+   --    * All values for the keys in range Low_Key .. High_Key are 0.
+
+   procedure Check_Keys
+     (Caller   : String;
+      Iter     : in out Iterator;
+      Low_Key  : Integer;
+      High_Key : Integer);
+   --  Ensure that iterator Iter visits every key in the range Low_Key ..
+   --  High_Key exactly once.
+
+   procedure Check_Locked_Mutations (Caller : String; T : in out Instance);
+   --  Ensure that all mutation operations of hash table T are locked
+
+   procedure Check_Size
+     (Caller    : String;
+      T         : Instance;
+      Exp_Count : Pair_Count_Type);
+   --  Ensure that the count of key-value pairs of hash table T matches
+   --  expected count Exp_Count. Emit an error if this is not the case.
+
+   procedure Test_Create (Init_Size : Bucket_Range_Type);
+   --  Verify that all dynamic hash table operations fail on a non-created
+   --  table of size Init_Size.
+
+   procedure Test_Delete_Get_Put_Size
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Exp_Count : Pair_Count_Type;
+      Init_Size : Bucket_Range_Type);
+   --  Verify that
+   --
+   --    * Put properly inserts values in the hash table.
+   --    * Get properly retrieves all values inserted in the table.
+   --    * Delete properly deletes values.
+   --    * The size of the hash table properly reflects the number of key-value
+   --      pairs.
+   --
+   --  Low_Key and High_Key denote the range of keys to be inserted, retrieved,
+   --  and deleted. Exp_Count is the expected count of key-value pairs n the
+   --  hash table. Init_Size denotes the initial size of the table.
+
+   procedure Test_Iterate
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Init_Size : Bucket_Range_Type);
+   --  Verify that iterators
+   --
+   --    * Properly visit each key exactly once.
+   --    * Mutation operations are properly locked and unlocked during
+   --      iteration.
+   --
+   --  Low_Key and High_Key denote the range of keys to be inserted, retrieved,
+   --  and deleted. Init_Size denotes the initial size of the table.
+
+   procedure Test_Iterate_Empty (Init_Size : Bucket_Range_Type);
+   --  Verify that an iterator over an empty hash table
+   --
+   --    * Does not visit any key
+   --    * Mutation operations are properly locked and unlocked during
+   --      iteration.
+   --
+   --  Init_Size denotes the initial size of the table.
+
+   procedure Test_Iterate_Forced
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Init_Size : Bucket_Range_Type);
+   --  Verify that an iterator that is forcefully advanced by just Next
+   --
+   --    * Properly visit each key exactly once.
+   --    * Mutation operations are properly locked and unlocked during
+   --      iteration.
+   --
+   --  Low_Key and High_Key denote the range of keys to be inserted, retrieved,
+   --  and deleted. Init_Size denotes the initial size of the table.
+
+   procedure Test_Replace
+     (Low_Val   : Integer;
+      High_Val  : Integer;
+      Init_Size : Bucket_Range_Type);
+   --  Verify that Put properly updates the value of a particular key. Low_Val
+   --  and High_Val denote the range of values to be updated. Init_Size denotes
+   --  the initial size of the table.
+
+   procedure Test_Reset
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Init_Size : Bucket_Range_Type);
+   --  Verify that Reset properly destroy and recreats a hash table. Low_Key
+   --  and High_Key denote the range of keys to be inserted in the hash table.
+   --  Init_Size denotes the initial size of the table.
+
+   -------------------------
+   -- Create_And_Populate --
+   -------------------------
+
+   function Create_And_Populate
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Init_Size : Bucket_Range_Type) return Instance
+   is
+      T : Instance;
+
+   begin
+      T := Create (Init_Size);
+
+      for Key in Low_Key .. High_Key loop
+         Put (T, Key, Key);
+      end loop;
+
+      return T;
+   end Create_And_Populate;
+
+   -----------------
+   -- Check_Empty --
+   -----------------
+
+   procedure Check_Empty
+     (Caller    : String;
+      T         : Instance;
+      Low_Key   : Integer;
+      High_Key  : Integer)
+   is
+      Val : Integer;
+
+   begin
+      Check_Size
+        (Caller    => Caller,
+         T         => T,
+         Exp_Count => 0);
+
+      for Key in Low_Key .. High_Key loop
+         Val := Get (T, Key);
+
+         if Val /= 0 then
+            Put_Line ("ERROR: " & Caller & ": wrong value");
+            Put_Line ("expected: 0");
+            Put_Line ("got     :" & Val'Img);
+         end if;
+      end loop;
+   end Check_Empty;
+
+   ----------------
+   -- Check_Keys --
+   ----------------
+
+   procedure Check_Keys
+     (Caller   : String;
+      Iter     : in out Iterator;
+      Low_Key  : Integer;
+      High_Key : Integer)
+   is
+      type Bit_Vector is array (Low_Key .. High_Key) of Boolean;
+      pragma Pack (Bit_Vector);
+
+      Count : Natural;
+      Key   : Integer;
+      Seen  : Bit_Vector := (others => False);
+
+   begin
+      --  Compute the number of outstanding keys that have to be iterated on
+
+      Count := High_Key - Low_Key + 1;
+
+      while Has_Next (Iter) loop
+         Next (Iter, Key);
+
+         if Seen (Key) then
+            Put_Line
+              ("ERROR: " & Caller & ": Check_Keys: duplicate key" & Key'Img);
+         else
+            Seen (Key) := True;
+            Count := Count - 1;
+         end if;
+      end loop;
+
+      --  In the end, all keys must have been iterated on
+
+      if Count /= 0 then
+         for Key in Seen'Range loop
+            if not Seen (Key) then
+               Put_Line
+                 ("ERROR: " & Caller & ": Check_Keys: missing key" & Key'Img);
+            end if;
+         end loop;
+      end if;
+   end Check_Keys;
+
+   ----------------------------
+   -- Check_Locked_Mutations --
+   ----------------------------
+
+   procedure Check_Locked_Mutations (Caller : String; T : in out Instance) is
+   begin
+      begin
+         Delete (T, 1);
+         Put_Line ("ERROR: " & Caller & ": Delete: no exception raised");
+      exception
+         when Table_Locked =>
+            null;
+         when others =>
+           Put_Line ("ERROR: " & Caller & ": Delete: unexpected exception");
+      end;
+
+      begin
+         Destroy (T);
+         Put_Line ("ERROR: " & Caller & ": Destroy: no exception raised");
+      exception
+         when Table_Locked =>
+            null;
+         when others =>
+           Put_Line ("ERROR: " & Caller & ": Destroy: unexpected exception");
+      end;
+
+      begin
+         Put (T, 1, 1);
+         Put_Line ("ERROR: " & Caller & ": Put: no exception raised");
+      exception
+         when Table_Locked =>
+            null;
+         when others =>
+           Put_Line ("ERROR: " & Caller & ": Put: unexpected exception");
+      end;
+
+      begin
+         Reset (T);
+         Put_Line ("ERROR: " & Caller & ": Reset: no exception raised");
+      exception
+         when Table_Locked =>
+            null;
+         when others =>
+           Put_Line ("ERROR: " & Caller & ": Reset: unexpected exception");
+      end;
+   end Check_Locked_Mutations;
+
+   ----------------
+   -- Check_Size --
+   ----------------
+
+   procedure Check_Size
+     (Caller    : String;
+      T         : Instance;
+      Exp_Count : Pair_Count_Type)
+   is
+      Count : constant Pair_Count_Type := Size (T);
+
+   begin
+      if Count /= Exp_Count then
+         Put_Line ("ERROR: " & Caller & ": Size: wrong value");
+         Put_Line ("expected:" & Exp_Count'Img);
+         Put_Line ("got     :" & Count'Img);
+      end if;
+   end Check_Size;
+
+   ----------
+   -- Hash --
+   ----------
+
+   function Hash (Key : Integer) return Bucket_Range_Type is
+   begin
+      return Bucket_Range_Type (Key);
+   end Hash;
+
+   -----------------
+   -- Test_Create --
+   -----------------
+
+   procedure Test_Create (Init_Size : Bucket_Range_Type) is
+      Count : Pair_Count_Type;
+      Iter  : Iterator;
+      T     : Instance;
+      Val   : Integer;
+
+   begin
+      --  Ensure that every routine defined in the API fails on a hash table
+      --  which has not been created yet.
+
+      begin
+         Delete (T, 1);
+         Put_Line ("ERROR: Test_Create: Delete: no exception raised");
+      exception
+         when Not_Created =>
+            null;
+         when others =>
+           Put_Line ("ERROR: Test_Create: Delete: unexpected exception");
+      end;
+
+      begin
+         Destroy (T);
+         Put_Line ("ERROR: Test_Create: Destroy: no exception raised");
+      exception
+         when Not_Created =>
+            null;
+         when others =>
+           Put_Line ("ERROR: Test_Create: Destroy: unexpected exception");
+      end;
+
+      begin
+         Val := Get (T, 1);
+         Put_Line ("ERROR: Test_Create: Get: no exception raised");
+      exception
+         when Not_Created =>
+            null;
+         when others =>
+           Put_Line ("ERROR: Test_Create: Get: unexpected exception");
+      end;
+
+      begin
+         Iter := Iterate (T);
+         Put_Line ("ERROR: Test_Create: Iterate: no exception raised");
+      exception
+         when Not_Created =>
+            null;
+         when others =>
+           Put_Line ("ERROR: Test_Create: Iterate: unexpected exception");
+      end;
+
+      begin
+         Put (T, 1, 1);
+         Put_Line ("ERROR: Test_Create: Put: no exception raised");
+      exception
+         when Not_Created =>
+            null;
+         when others =>
+           Put_Line ("ERROR: Test_Create: Put: unexpected exception");
+      end;
+
+      begin
+         Reset (T);
+         Put_Line ("ERROR: Test_Create: Reset: no exception raised");
+      exception
+         when Not_Created =>
+            null;
+         when others =>
+           Put_Line ("ERROR: Test_Create: Reset: unexpected exception");
+      end;
+
+      begin
+         Count := Size (T);
+         Put_Line ("ERROR: Test_Create: Size: no exception raised");
+      exception
+         when Not_Created =>
+            null;
+         when others =>
+           Put_Line ("ERROR: Test_Create: Size: unexpected exception");
+      end;
+
+      --  Test create
+
+      T := Create (Init_Size);
+
+      --  Clean up the hash table to prevent memory leaks
+
+      Destroy (T);
+   end Test_Create;
+
+   ------------------------------
+   -- Test_Delete_Get_Put_Size --
+   ------------------------------
+
+   procedure Test_Delete_Get_Put_Size
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Exp_Count : Pair_Count_Type;
+      Init_Size : Bucket_Range_Type)
+   is
+      Exp_Val : Integer;
+      T       : Instance;
+      Val     : Integer;
+
+   begin
+      T := Create_And_Populate (Low_Key, High_Key, Init_Size);
+
+      --  Ensure that its size matches an expected value
+
+      Check_Size
+        (Caller    => "Test_Delete_Get_Put_Size",
+         T         => T,
+         Exp_Count => Exp_Count);
+
+      --  Ensure that every value for the range of keys exists
+
+      for Key in Low_Key .. High_Key loop
+         Val := Get (T, Key);
+
+         if Val /= Key then
+            Put_Line ("ERROR: Test_Delete_Get_Put_Size: Get: wrong value");
+            Put_Line ("expected:" & Key'Img);
+            Put_Line ("got     :" & Val'Img);
+         end if;
+      end loop;
+
+      --  Delete values whose keys are divisible by 10
+
+      for Key in Low_Key .. High_Key loop
+         if Key mod 10 = 0 then
+            Delete (T, Key);
+         end if;
+      end loop;
+
+      --  Ensure that all values whose keys were not deleted still exist
+
+      for Key in Low_Key .. High_Key loop
+         if Key mod 10 = 0 then
+            Exp_Val := 0;
+         else
+            Exp_Val := Key;
+         end if;
+
+         Val := Get (T, Key);
+
+         if Val /= Exp_Val then
+            Put_Line ("ERROR: Test_Delete_Get_Put_Size: Get: wrong value");
+            Put_Line ("expected:" & Exp_Val'Img);
+            Put_Line ("got     :" & Val'Img);
+         end if;
+      end loop;
+
+      --  Delete all values
+
+      for Key in Low_Key .. High_Key loop
+         Delete (T, Key);
+      end loop;
+
+      --  Ensure that the hash table is empty
+
+      Check_Empty
+        (Caller   => "Test_Delete_Get_Put_Size",
+         T        => T,
+         Low_Key  => Low_Key,
+         High_Key => High_Key);
+
+      --  Clean up the hash table to prevent memory leaks
+
+      Destroy (T);
+   end Test_Delete_Get_Put_Size;
+
+   ------------------
+   -- Test_Iterate --
+   ------------------
+
+   procedure Test_Iterate
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Init_Size : Bucket_Range_Type)
+   is
+      Iter_1 : Iterator;
+      Iter_2 : Iterator;
+      T      : Instance;
+
+   begin
+      T := Create_And_Populate (Low_Key, High_Key, Init_Size);
+
+      --  Obtain an iterator. This action must lock all mutation operations of
+      --  the hash table.
+
+      Iter_1 := Iterate (T);
+
+      --  Ensure that every mutation routine defined in the API fails on a hash
+      --  table with at least one outstanding iterator.
+
+      Check_Locked_Mutations
+        (Caller => "Test_Iterate",
+         T      => T);
+
+      --  Obtain another iterator
+
+      Iter_2 := Iterate (T);
+
+      --  Ensure that every mutation is still locked
+
+      Check_Locked_Mutations
+        (Caller => "Test_Iterate",
+         T      => T);
+
+      --  Ensure that all keys are iterable. Note that this does not unlock the
+      --  mutation operations of the hash table because Iter_2 is not exhausted
+      --  yet.
+
+      Check_Keys
+        (Caller   => "Test_Iterate",
+         Iter     => Iter_1,
+         Low_Key  => Low_Key,
+         High_Key => High_Key);
+
+      Check_Locked_Mutations
+        (Caller => "Test_Iterate",
+         T      => T);
+
+      --  Ensure that all keys are iterable. This action unlocks all mutation
+      --  operations of the hash table because all outstanding iterators have
+      --  been exhausted.
+
+      Check_Keys
+        (Caller   => "Test_Iterate",
+         Iter     => Iter_2,
+         Low_Key  => Low_Key,
+         High_Key => High_Key);
+
+      --  Ensure that all mutation operations are once again callable
+
+      Delete (T, Low_Key);
+      Put (T, Low_Key, Low_Key);
+      Reset (T);
+
+      --  Clean up the hash table to prevent memory leaks
+
+      Destroy (T);
+   end Test_Iterate;
+
+   ------------------------
+   -- Test_Iterate_Empty --
+   ------------------------
+
+   procedure Test_Iterate_Empty (Init_Size : Bucket_Range_Type) is
+      Iter : Iterator;
+      Key  : Integer;
+      T    : Instance;
+
+   begin
+      T := Create_And_Populate (0, -1, Init_Size);
+
+      --  Obtain an iterator. This action must lock all mutation operations of
+      --  the hash table.
+
+      Iter := Iterate (T);
+
+      --  Ensure that every mutation routine defined in the API fails on a hash
+      --  table with at least one outstanding iterator.
+
+      Check_Locked_Mutations
+        (Caller => "Test_Iterate_Empty",
+         T      => T);
+
+      --  Attempt to iterate over the keys
+
+      while Has_Next (Iter) loop
+         Next (Iter, Key);
+
+         Put_Line ("ERROR: Test_Iterate_Empty: key" & Key'Img & " exists");
+      end loop;
+
+      --  Ensure that all mutation operations are once again callable
+
+      Delete (T, 1);
+      Put (T, 1, 1);
+      Reset (T);
+
+      --  Clean up the hash table to prevent memory leaks
+
+      Destroy (T);
+   end Test_Iterate_Empty;
+
+   -------------------------
+   -- Test_Iterate_Forced --
+   -------------------------
+
+   procedure Test_Iterate_Forced
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Init_Size : Bucket_Range_Type)
+   is
+      Iter : Iterator;
+      Key  : Integer;
+      T    : Instance;
+
+   begin
+      T := Create_And_Populate (Low_Key, High_Key, Init_Size);
+
+      --  Obtain an iterator. This action must lock all mutation operations of
+      --  the hash table.
+
+      Iter := Iterate (T);
+
+      --  Ensure that every mutation routine defined in the API fails on a hash
+      --  table with at least one outstanding iterator.
+
+      Check_Locked_Mutations
+        (Caller => "Test_Iterate_Forced",
+         T      => T);
+
+      --  Forcibly advance the iterator until it raises an exception
+
+      begin
+         for Guard in Low_Key .. High_Key + 1 loop
+            Next (Iter, Key);
+         end loop;
+
+         Put_Line
+           ("ERROR: Test_Iterate_Forced: Iterator_Exhausted not raised");
+      exception
+         when Iterator_Exhausted =>
+            null;
+         when others =>
+            Put_Line ("ERROR: Test_Iterate_Forced: unexpected exception");
+      end;
+
+      --  Ensure that all mutation operations are once again callable
+
+      Delete (T, Low_Key);
+      Put (T, Low_Key, Low_Key);
+      Reset (T);
+
+      --  Clean up the hash table to prevent memory leaks
+
+      Destroy (T);
+   end Test_Iterate_Forced;
+
+   ------------------
+   -- Test_Replace --
+   ------------------
+
+   procedure Test_Replace
+     (Low_Val   : Integer;
+      High_Val  : Integer;
+      Init_Size : Bucket_Range_Type)
+   is
+      Key : constant Integer := 1;
+      T   : Instance;
+      Val : Integer;
+
+   begin
+      T := Create (Init_Size);
+
+      --  Ensure the Put properly updates values with the same key
+
+      for Exp_Val in Low_Val .. High_Val loop
+         Put (T, Key, Exp_Val);
+
+         Val := Get (T, Key);
+
+         if Val /= Exp_Val then
+            Put_Line ("ERROR: Test_Replace: Get: wrong value");
+            Put_Line ("expected:" & Exp_Val'Img);
+            Put_Line ("got     :" & Val'Img);
+         end if;
+      end loop;
+
+      --  Clean up the hash table to prevent memory leaks
+
+      Destroy (T);
+   end Test_Replace;
+
+   ----------------
+   -- Test_Reset --
+   ----------------
+
+   procedure Test_Reset
+     (Low_Key   : Integer;
+      High_Key  : Integer;
+      Init_Size : Bucket_Range_Type)
+   is
+      T : Instance;
+
+   begin
+      T := Create_And_Populate (Low_Key, High_Key, Init_Size);
+
+      --  Reset the contents of the hash table
+
+      Reset (T);
+
+      --  Ensure that the hash table is empty
+
+      Check_Empty
+        (Caller   => "Test_Reset",
+         T        => T,
+         Low_Key  => Low_Key,
+         High_Key => High_Key);
+
+      --  Clean up the hash table to prevent memory leaks
+
+      Destroy (T);
+   end Test_Reset;
+
+--  Start of processing for Operations
+
+begin
+   Test_Create (Init_Size => 1);
+   Test_Create (Init_Size => 100);
+
+   Test_Delete_Get_Put_Size
+     (Low_Key   => 1,
+      High_Key  => 1,
+      Exp_Count => 1,
+      Init_Size => 1);
+
+   Test_Delete_Get_Put_Size
+     (Low_Key   => 1,
+      High_Key  => 1000,
+      Exp_Count => 1000,
+      Init_Size => 32);
+
+   Test_Iterate
+     (Low_Key   => 1,
+      High_Key  => 32,
+      Init_Size => 32);
+
+   Test_Iterate_Empty (Init_Size => 32);
+
+   Test_Iterate_Forced
+     (Low_Key   => 1,
+      High_Key  => 32,
+      Init_Size => 32);
+
+   Test_Replace
+     (Low_Val   => 1,
+      High_Val  => 10,
+      Init_Size => 32);
+
+   Test_Reset
+     (Low_Key   => 1,
+      High_Key  => 1000,
+      Init_Size => 100);
+end Dynhash;