diff --git a/tests/run_tests.ml b/tests/run_tests.ml index a9c70d40..6f11dd98 100644 --- a/tests/run_tests.ml +++ b/tests/run_tests.ml @@ -27,5 +27,12 @@ let suite = Test_future.suite; ] +let props = + QCheck.flatten + [ Test_PersistentHashtbl.props + ] + let _ = - run_test_tt_main suite + ignore (QCheck.run_tests props); + ignore (run_test_tt_main suite); + () diff --git a/tests/test_PersistentHashtbl.ml b/tests/test_PersistentHashtbl.ml index 1c3249cf..75ecb9c2 100644 --- a/tests/test_PersistentHashtbl.ml +++ b/tests/test_PersistentHashtbl.ml @@ -101,3 +101,71 @@ let suite = "test_remove" >:: test_remove; "test_size" >:: test_size; ] + +open QCheck + +let rec _list_uniq l = match l with + | [] -> [] + | (x,_)::l' when List.mem_assoc x l' -> _list_uniq l' + | (x,y)::l' -> (x,y) :: _list_uniq l' + +let check_add_mem = + let gen = Arbitrary.(lift _list_uniq (list (pair small_int small_int))) in + let prop l = + let h = H.of_list l in + List.for_all + (fun (k,v) -> + try + H.find h k = v + with Not_found -> false) + l + in + let name = "persistent_hashtbl_add_mem" in + mk_test ~name ~pp:PP.(list (pair int int)) ~size:List.length gen prop + +let check_len = + let gen = Arbitrary.(lift _list_uniq (list (pair small_int small_int))) in + let prop l = + let h = H.of_list l in + H.length h = List.length l + in + let name = "persistent_hashtbl_len" in + mk_test ~name ~pp:PP.(list (pair int int)) ~size:List.length gen prop + +let check_old_new = + let gen = Arbitrary.(lift _list_uniq (list (pair small_int small_int))) in + let prop l = + let l1, l2 = List.partition (fun (x,_) -> x mod 2 = 0) l in + let h1 = H.of_list l1 in + let h2 = H.of_list ~init:h1 l2 in + List.for_all + (fun (k,v) -> H.find h2 k = v) + l + && + List.for_all + (fun (k,v) -> H.find h1 k = v) + l1 + && + List.length l1 = H.length h1 + && + List.length l = H.length h2 + in + let name = "persistent_hashtbl_old_new" in + mk_test ~name ~pp:PP.(list (pair int int)) ~size:List.length gen prop + +let check_add_remove_empty = + let gen = Arbitrary.(lift _list_uniq (list (pair small_int small_int))) in + let prop l = + let h = H.of_list l in + let h = List.fold_left (fun h (k,_) -> H.remove h k) h l in + H.is_empty h + in + let name = "persistent_hashtbl_add_remove_empty" in + mk_test ~name ~pp:PP.(list (pair int int)) ~size:List.length gen prop + +let props = + [ check_add_mem + ; check_len + ; check_old_new + ; check_add_remove_empty + ]