Fix PR#5555

Add Hashtbl.reset to resize the bucket table to its initial size.



git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12451 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 36 insertions, 10 deletions

diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml
index 01f1a5f78..01614846d 100644
--- a/stdlib/hashtbl.ml
+++ b/stdlib/hashtbl.ml
@@ -28,7 +28,9 @@ let seeded_hash seed x = seeded_hash_param 10 100 seed x
 type ('a, 'b) t =
   { mutable size: int;                        (* number of entries *)
     mutable data: ('a, 'b) bucketlist array;  (* the buckets *)
-    mutable seed: int }                       (* for randomization *)
+    mutable seed: int;                        (* for randomization *)
+    initial_size: int;                        (* initial array size *)
+  }
 
 and ('a, 'b) bucketlist =
     Empty
@@ -58,13 +60,24 @@ let rec power_2_above x n =
 let create ?(random = !randomized) initial_size =
   let s = power_2_above 16 initial_size in
   let seed = if random then Random.State.bits (Lazy.force prng) else 0 in
-  { size = 0; seed = seed; data = Array.make s Empty }
+  { initial_size; size = 0; seed = seed; data = Array.make s Empty }
 
 let clear h =
-  for i = 0 to Array.length h.data - 1 do
+  h.size <- 0;
+  let len = Array.length h.data in
+  for i = 0 to len - 1 do
     h.data.(i) <- Empty
-  done;
-  h.size <- 0
+  done
+
+let reset h =
+  let len = Array.length h.data in
+  if Obj.size (Obj.repr h) < 4 (* compatibility with old hash tables *)
+    || len = h.initial_size then
+    clear h
+  else begin
+    h.size <- 0;
+    h.data <- Array.create len Empty
+  end
 
 let copy h = { h with data = Array.copy h.data }
 
@@ -90,7 +103,7 @@ let resize indexfun h =
 
 let key_index h key =
   (* compatibility with old hash tables *)
-  if Obj.size (Obj.repr h) = 3
+  if Obj.size (Obj.repr h) >= 3
   then (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1)
   else (old_hash_param 10 100 key) mod (Array.length h.data)
 
@@ -238,7 +251,8 @@ module type S =
     type key
     type 'a t
     val create: int -> 'a t
-    val clear: 'a t -> unit
+    val clear : 'a t -> unit
+    val reset : 'a t -> unit
     val copy: 'a t -> 'a t
     val add: 'a t -> key -> 'a -> unit
     val remove: 'a t -> key -> unit
@@ -258,6 +272,7 @@ module type SeededS =
     type 'a t
     val create : ?random:bool -> int -> 'a t
     val clear : 'a t -> unit
+    val reset : 'a t -> unit
     val copy : 'a t -> 'a t
     val add : 'a t -> key -> 'a -> unit
     val remove : 'a t -> key -> unit
@@ -278,6 +293,7 @@ module MakeSeeded(H: SeededHashedType): (SeededS with type key = H.t) =
     type 'a t = 'a hashtbl
     let create = create
     let clear = clear
+    let reset = reset
     let copy = copy
 
     let key_index h key =
diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
index ab08fd79f..00d9efca3 100644
--- a/stdlib/hashtbl.mli
+++ b/stdlib/hashtbl.mli
@@ -30,7 +30,7 @@ val create : ?random:bool -> int -> ('a, 'b) t
    initial size [n].  For best results, [n] should be on the
    order of the expected number of elements that will be in
    the table.  The table grows as needed, so [n] is just an
-   initial guess.  
+   initial guess.
 
    The optional [random] parameter (a boolean) controls whether
    the internal organization of the hash table is randomized at each
@@ -43,7 +43,7 @@ val create : ?random:bool -> int -> ('a, 'b) t
    security-sensitive applications, the deterministic collision
    patterns can be exploited by a malicious user to create a
    denial-of-service attack: the attacker sends input crafted to
-   create many collisions in the table, slowing the application down.  
+   create many collisions in the table, slowing the application down.
 
    A hash table that is created with [~random:true] uses the seeded
    hash function {!Hashtbl.seeded_hash} with a seed that is randomly
@@ -65,7 +65,12 @@ val create : ?random:bool -> int -> ('a, 'b) t
    hash tables were created in non-randomized mode. *)
 
 val clear : ('a, 'b) t -> unit
-(** Empty a hash table. *)
+(** Empty a hash table. Use [reset] instead of [clear] to shrink the
+    size of the bucket table to its initial size. *)
+
+val reset : ('a, 'b) t -> unit
+(** Empty a hash table and shrink the size of the bucket table
+    to its initial size. *)
 
 val copy : ('a, 'b) t -> ('a, 'b) t
 (** Return a copy of the given hashtable. *)
@@ -212,6 +217,7 @@ module type S =
     type 'a t
     val create : int -> 'a t
     val clear : 'a t -> unit
+    val reset : 'a t -> unit
     val copy : 'a t -> 'a t
     val add : 'a t -> key -> 'a -> unit
     val remove : 'a t -> key -> unit
@@ -260,6 +266,7 @@ module type SeededS =
     type 'a t
     val create : ?random:bool -> int -> 'a t
     val clear : 'a t -> unit
+    val reset : 'a t -> unit
     val copy : 'a t -> 'a t
     val add : 'a t -> key -> 'a -> unit
     val remove : 'a t -> key -> unit
diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli
index 74fa13881..a004bdb5b 100644
--- a/stdlib/moreLabels.mli
+++ b/stdlib/moreLabels.mli
@@ -27,6 +27,7 @@ module Hashtbl : sig
   type ('a, 'b) t = ('a, 'b) Hashtbl.t
   val create : ?random:bool -> int -> ('a, 'b) t
   val clear : ('a, 'b) t -> unit
+  val reset : ('a, 'b) t -> unit
   val copy : ('a, 'b) t -> ('a, 'b) t
   val add : ('a, 'b) t -> key:'a -> data:'b -> unit
   val find : ('a, 'b) t -> 'a -> 'b
@@ -50,6 +51,7 @@ module Hashtbl : sig
       and 'a t
       val create : int -> 'a t
       val clear : 'a t -> unit
+      val reset : 'a t -> unit
       val copy : 'a t -> 'a t
       val add : 'a t -> key:key -> data:'a -> unit
       val remove : 'a t -> key -> unit
@@ -70,6 +72,7 @@ module Hashtbl : sig
       and 'a t
       val create : ?random:bool -> int -> 'a t
       val clear : 'a t -> unit
+      val reset : 'a t -> unit
       val copy : 'a t -> 'a t
       val add : 'a t -> key:key -> data:'a -> unit
       val remove : 'a t -> key -> unit