path: root/testsuite/tests/lib-hashtbl/htbl.ml

(* TEST *)

(* Hashtable operations, using maps as a reference *)

open Printf

module Test(H: Hashtbl.SeededS) (M: Map.S with type key = H.key) = struct

  let incl_mh m h =
    try
      M.iter
        (fun k d ->
          let d' = H.find h k in if d <> d' then raise Exit)
        m;
      true
    with Exit | Not_found -> false

  let domain_hm h m =
    try
      H.iter
        (fun k d -> if not (M.mem k m) then raise Exit)
        h;
      true
    with Exit -> false

  let incl_hm h m =
    try
      H.iter
        (fun k d ->
           let d' = M.find k m in if d <> d' then raise Exit)
        h;
      true
    with Exit | Not_found -> false

  let to_list_ h : _ list =
    H.fold (fun k v acc -> (k,v) :: acc) h []
    |> List.sort Stdlib.compare

  let check_to_seq h =
    let l = to_list_ h in
    let l2 = List.of_seq (H.to_seq h) in
    assert (l = List.sort Stdlib.compare l2)

  let check_to_seq_of_seq h =
    let h' = H.create (H.length h) in
    H.add_seq h' (H.to_seq h);
    (*printf "h.len=%d, h'.len=%d\n" (List.length @@ to_list_ h)
                                     (List.length @@ to_list_ h');*)
    assert (to_list_ h = to_list_ h')

  let test data =
    let n = Array.length data in
    let h = H.create 51 and m = ref M.empty in
    (* Insert all data with H.add *)
    Array.iter
      (fun (k, d) -> H.add h k d; m := M.add k d !m)
      data;
    printf "Insertion: %s\n"
           (if incl_mh !m h && domain_hm h !m then "passed" else "FAILED");
    check_to_seq_of_seq h;
    check_to_seq h;
    (* Insert all data with H.replace *)
    H.clear h; m := M.empty;
    Array.iter
      (fun (k, d) -> H.replace h k d; m := M.add k d !m)
      data;
    printf "Insertion: %s\n"
           (if incl_mh !m h && incl_hm h !m then "passed" else "FAILED");
    check_to_seq_of_seq h;
    check_to_seq h;
    (* Remove some of the data *)
    for i = 0 to n/3 - 1 do
      let (k, _) = data.(i) in H.remove h k; m := M.remove k !m
    done;
    printf "Removal: %s\n"
      (if incl_mh !m h && incl_hm h !m then "passed" else "FAILED");
    check_to_seq_of_seq h;
    check_to_seq h;
    ()

end

module SS = struct
  type t = string
  let compare (x:t) (y:t) = Stdlib.compare x y
  let equal (x:t) (y:t) = x=y
  let seeded_hash = Hashtbl.seeded_hash
end
module SI = struct
  type t = int
  let compare (x:t) (y:t) = Stdlib.compare x y
  let equal (x:t) (y:t) = x=y
  let seeded_hash = Hashtbl.seeded_hash
end
module SSP = struct
  type t = string*string
  let compare (x:t) (y:t) = Stdlib.compare x y
  let equal (x:t) (y:t) = x=y
  let seeded_hash = Hashtbl.seeded_hash
end
module SSL = struct
  type t = string list
  let compare (x:t) (y:t) = Stdlib.compare x y
  let equal (x:t) (y:t) = x=y
  let seeded_hash = Hashtbl.seeded_hash
end
module SSA = struct
  type t = string array
  let compare (x:t) (y:t) = Stdlib.compare x y
  let equal (x:t) (y:t) = x=y
  let seeded_hash = Hashtbl.seeded_hash
end

module MS = Map.Make(SS)
module MI = Map.Make(SI)
module MSP = Map.Make(SSP)
module MSL = Map.Make(SSL)
module MSA = Map.Make(SSA)


(* Generic hash wrapped as a functorial hash *)

module HofM (M: Map.S) : Hashtbl.SeededS with type key = M.key =
  struct
    type key = M.key
    type 'a t = (key, 'a) Hashtbl.t
    let create ?random:bool s = Hashtbl.create s
    let clear = Hashtbl.clear
    let reset = Hashtbl.reset
    let copy = Hashtbl.copy
    let add = Hashtbl.add
    let remove = Hashtbl.remove
    let find = Hashtbl.find
    let find_opt = Hashtbl.find_opt
    let find_all = Hashtbl.find_all
    let replace = Hashtbl.replace
    let mem = Hashtbl.mem
    let iter = Hashtbl.iter
    let fold = Hashtbl.fold
    let length = Hashtbl.length
    let stats = Hashtbl.stats
    let filter_map_inplace = Hashtbl.filter_map_inplace
    let to_seq = Hashtbl.to_seq
    let to_seq_keys = Hashtbl.to_seq_keys
    let to_seq_values = Hashtbl.to_seq_values
    let of_seq = Hashtbl.of_seq
    let add_seq = Hashtbl.add_seq
    let replace_seq = Hashtbl.replace_seq
  end

module HS1 = HofM(MS)
module HI1 = HofM(MI)
module HSP = HofM(MSP)
module HSL = HofM(MSL)

(* Specific functorial hashes *)

module HS2 = Hashtbl.MakeSeeded(SS)
module HS3 = Hashtbl.MakeSeeded(String)
module HI2 = Hashtbl.MakeSeeded(SI)

(* Specific weak functorial hashes *)
module WS = Ephemeron.K1.MakeSeeded(SS)
module WSP1 = Ephemeron.K1.MakeSeeded(SSP)
module WSP2 = Ephemeron.K2.MakeSeeded(SS)(SS)
module WSL = Ephemeron.K1.MakeSeeded(SSL)
module WSA = Ephemeron.Kn.MakeSeeded(SS)

(* Instantiating the test *)

module TS1 = Test(HS1)(MS)
module TS2 = Test(HS2)(MS)
module TS3 = Test(HS3)(MS)
module TI1 = Test(HI1)(MI)
module TI2 = Test(HI2)(MI)
module TSP = Test(HSP)(MSP)
module TSL = Test(HSL)(MSL)

(* Data set: strings from a file, associated with their line number *)

let file_data filename =
  let ic = open_in filename in
  let lineno = ref 0 in
  let data = ref [] in
  begin try
    while true do
      let l = input_line ic in
      incr lineno;
      data := (l, !lineno) :: !data
    done
  with End_of_file -> ()
  end;
  close_in ic;
  Array.of_list !data

(* Data set: fixed strings *)

let string_data = [|
  "Si", 0; "non", 1; "e", 2; "vero", 3; "e", 4; "ben", 5; "trovato", 6;
  "An", 10; "apple", 11; "a", 12; "day", 13; "keeps", 14; "the", 15;
  "doctor", 16; "away", 17;
  "Pierre", 20; "qui", 21; "roule", 22; "n'amasse", 23; "pas", 24; "mousse", 25;
  "Asinus", 30; "asinum", 31; "fricat", 32
|]

(* Data set: random integers *)

let random_integers num range =
  let data = Array.make num (0,0) in
  for i = 0 to num - 1 do
    data.(i) <- (Random.int range, i)
  done;
  data

(* Data set: pairs *)

let pair_data data =
  Array.map (fun (k, d) -> ((k, k), d)) data

(* Data set: lists *)

let list_data data =
  let d = Array.make (Array.length data / 10) ([], "0") in
  let j = ref 0 in
  let rec mklist n =
    if n <= 0 || !j >= Array.length data then [] else begin
      let hd = fst data.(!j) in
      incr j;
      let tl = mklist (n-1) in
      hd :: tl
    end in
  for i = 0 to Array.length d - 1 do
    d.(i) <- (mklist (Random.int 16), Int.to_string i)
  done;
  d

(* The test *)

let _ =
  printf "-- Random integers, large range\n%!";
  TI1.test (random_integers 20_000 1_000_000);
  printf "-- Random integers, narrow range\n%!";
  TI2.test (random_integers 20_000 1_000);
  let d =
    try file_data "../../LICENSE" with Sys_error _ -> string_data in
  printf "-- Strings, generic interface\n%!";
  TS1.test d;
  printf "-- Strings, functorial interface\n%!";
  TS2.test d;
  printf "-- Strings, functorial(String) interface\n%!";
  TS3.test d;
  printf "-- Pairs of strings\n%!";
  TSP.test (pair_data d);
  printf "-- Lists of strings\n%!";
  TSL.test (list_data d)


let () =
  let h = Hashtbl.create 16 in
  for i = 1 to 1000 do Hashtbl.add h i (i * 2) done;
  Printf.printf "%i elements\n" (Hashtbl.length h);
  let () =
    (* Check that filter_map_inplace of nothing changes nothing *)
    let marshaled_before = Marshal.to_string h [Marshal.No_sharing] in
    Hashtbl.filter_map_inplace (fun _k v -> Some v) h;
    let marshaled_after = Marshal.to_string h [Marshal.No_sharing] in
    assert (marshaled_before = marshaled_after) in
  Hashtbl.filter_map_inplace (fun k v ->
      if k mod 100 = 0 then ((*Hashtbl.add h v v;*) Some (v / 100)) else None)
    h;
  let l = Hashtbl.fold (fun k v acc -> (k, v) :: acc) h [] in
  let l = List.sort compare l in
  List.iter (fun (k, v) -> Printf.printf "%i,%i\n" k v) l;
  Printf.printf "%i elements\n" (Hashtbl.length h)