Update test framework

We now use Kaputt for our tests.

Makefile

@@ -5,7 +5,7 @@ all:
 clean:
 	${MAKE} -C src clean
 
-.PHONY:test
+.PHONY: test
 test:
 	${MAKE} -C test
 

scripts/install_build_deps.sh

@@ -52,7 +52,7 @@ fi
 
 if [ ! -z "$install" ] ; then
     if opam list --installed tezos-deps ; then
-	opam upgrade $(opam list -s --required-by tezos-deps | grep -ve '^ocaml *$')
+	opam upgrade $(opam list -s --required-by tezos-deps --test | grep -ve '^ocaml *$')
     else
 	opam install tezos-deps
     fi

src/tezos-deps.opam

@@ -28,4 +28,5 @@ depends: [
   "ocplib-json-typed"
   "ocplib-resto" {>= "dev"}
   "sodium" {>= "0.3.0"}
+  "kaputt" {test}
 ]

test/.merlin

@@ -20,3 +20,4 @@ B ../src/client/embedded
 FLG -w -40
 PKG lwt
 PKG sodium
+PKG kaputt

test/Makefile

@@ -3,7 +3,7 @@ TESTS := store context state basic basic.sh
 
 all: test
 
-INCLUDES = $(patsubst %, -I %, $(SOURCE_DIRECTORIES))
+INCLUDES = $(patsubst %, -I %, $(SOURCE_DIRECTORIES) lib)
 OCAMLFLAGS = \
   -g -safe-string -w -40 \
   ${INCLUDES} \
@@ -39,7 +39,8 @@ PACKAGES := \
   ocplib-json-typed \
   ocplib-resto.directory \
   sodium \
-  unix
+  unix \
+  kaputt
 
 ############################################################################
 ## External packages
@@ -76,8 +77,9 @@ run-test-store:
 TEST_STORE_INTFS =
 
 TEST_STORE_IMPLS = \
-  test.ml \
+  lib/assert.ml \
-  test_store.ml \
+  lib/test.ml \
+  test_store.ml
 
 ${TEST_STORE_IMPLS:.ml=.cmx}: ${NODELIB}
 test-store: ${NODELIB} ${TEST_STORE_IMPLS:.ml=.cmx}
@@ -98,8 +100,9 @@ run-test-context:
 TEST_CONTEXT_INTFS =
 
 TEST_CONTEXT_IMPLS = \
-  test.ml \
+  lib/assert.ml \
-  test_context.ml \
+  lib/test.ml \
+  test_context.ml
 
 ${TEST_CONTEXT_IMPLS:.ml=.cmx}: ${NODELIB}
 test-context: ${NODELIB} ${TEST_CONTEXT_IMPLS:.ml=.cmx}
@@ -120,8 +123,9 @@ run-test-state:
 TEST_STATE_INTFS =
 
 TEST_STATE_IMPLS = \
-  test.ml \
+  lib/assert.ml \
-  test_state.ml \
+  lib/test.ml \
+  test_state.ml
 
 ${TEST_STATE_IMPLS:.ml=.cmx}: ${NODELIB}
 test-state: ${NODELIB} ../src/proto/embedded_proto_demo.cmxa ${TEST_STATE_IMPLS:.ml=.cmx}
@@ -147,8 +151,9 @@ run-test-basic:
 TEST_BASIC_INTFS =
 
 TEST_BASIC_IMPLS = \
-  test.ml \
+  lib/assert.ml \
-  test_basic.ml \
+  lib/test.ml \
+  test_basic.ml
 
 test-basic \
 ${TEST_BASIC_IMPLS:.ml=.cmx}: \
@@ -180,7 +185,7 @@ clean::
 	-rm -f *.cm*
 
 -include .depend
-.depend: $(wildcard *.ml *.mli)
+.depend: $(wildcard *.ml *.mli lib/*.ml lib/*.mli)
 	ocamldep $^ > .depend
 
 clean::

test/lib/assert.ml

@@ -0,0 +1,75 @@
+
+
+open Kaputt.Abbreviations
+
+include Kaputt.Assertion
+
+let fail_msg fmt =
+  Format.kasprintf Assert.fail_msg fmt
+
+let fail expected given fmt =
+  Format.kasprintf (Assert.fail expected given) fmt
+
+let format_msg = function None -> None | Some msg -> Some (msg ^ "\n")
+
+let equal_persist_list ?msg l1 l2 =
+  let msg = format_msg msg in
+  let pr_persist l =
+    let res =
+      String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
+    Printf.sprintf "[%s]" res in
+  Assert.make_equal_list ?msg (=) pr_persist l1 l2
+
+let equal_string_option ?msg o1 o2 =
+  let msg = format_msg msg in
+  let prn = function
+    | None -> "None"
+    | Some s -> s in
+  Assert.equal ?msg ~prn o1 o2
+
+let equal_error_monad ?msg exn1 exn2 =
+  let msg = format_msg msg in
+  let prn exn = match exn with
+    | Error_monad.Exn err -> Printexc.to_string err
+    | Error_monad.Unclassified err -> err in
+  Assert.equal ?msg ~prn exn1 exn2
+
+let equal_block_map ?msg ~eq map1 map2 =
+  let msg = format_msg msg in
+  let open Hash in
+  let module BlockMap = Hash_map(Block_hash) in
+  Assert.equal ?msg ~eq map1 map2
+
+let equal_operation ?msg op1 op2 =
+  let msg = format_msg msg in
+  let eq op1 op2 =
+    match op1, op2 with
+    | None, None -> true
+    | Some (h1, op1), Some (h2, op2) ->
+        Hash.Operation_hash.equal h1 h2 && op1 = op2
+    | _ -> false in
+  let prn = function
+    | None -> "none"
+    | Some (h, op) -> Hash.Operation_hash.to_hex h in
+  Assert.equal ?msg ~prn ~eq op1 op2
+
+let equal_block ?msg st1 st2 =
+  let msg = format_msg msg in
+  let eq st1 st2 =
+    match st1, st2 with
+    | None, None -> true
+    | Some (h1, st1), Some (h2, st2) ->
+        Hash.Block_hash.equal h1 h2 && st1 = st2
+    | _ -> false in
+  let prn = function
+    | None -> "none"
+    | Some (h, st) -> Hash.Block_hash.to_hex h in
+  Assert.equal ?msg ~prn ~eq st1 st2
+
+let equal_result ?msg r1 r2 ~equal_ok ~equal_err =
+  let msg = format_msg msg in
+  match r1, r2 with
+  | Ok r1, Ok r2 -> equal_ok ?msg r1 r2
+  | Error e1, Error e2 -> equal_err ?msg e1 e2
+  | Ok r, Error e | Error e, Ok r ->
+      Assert.fail_msg "Results are not the same"

test/lib/assert.mli

@@ -0,0 +1,35 @@
+
+include (module type of struct include Kaputt.Assertion end)
+
+val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a
+
+val fail : string -> string -> ('a, Format.formatter, unit, 'b) format4 -> 'a
+
+val equal_persist_list :
+  ?msg:string -> Persist.key list -> Persist.key list -> unit
+
+val equal_string_option : ?msg:string -> string option -> string option -> unit
+
+val equal_error_monad :
+  ?msg:string -> Error_monad.error -> Error_monad.error -> unit
+
+val equal_block_map : ?msg:string -> eq:('a -> 'a -> bool) -> 'a -> 'a -> unit
+
+val equal_operation :
+  ?msg:string ->
+  (Hash.Operation_hash.t * State.Operation.operation) option ->
+  (Hash.Operation_hash.t * State.Operation.operation) option ->
+  unit
+
+val equal_block :
+  ?msg:string ->
+  (Hash.Block_hash.t * Store.block_header) option ->
+  (Hash.Block_hash.t * Store.block_header) option ->
+  unit
+
+val equal_result :
+  ?msg:string ->
+  ('a, 'b) result ->
+  ('a, 'b) result ->
+  equal_ok:(?msg:string -> 'a -> 'a -> 'c) ->
+  equal_err:(?msg:string -> 'b -> 'b -> 'c) -> 'c

test/lib/test.ml

@@ -0,0 +1,27 @@
+open Kaputt.Abbreviations
+
+let keep_dir = try ignore (Sys.getenv "KEEPDIR") ; true with _ -> false
+
+let make_test ~title test =
+  Test.add_simple_test ~title (fun () -> Lwt_main.run test)
+
+let rec remove_dir dir =
+  Array.iter (fun file ->
+      let f = Filename.concat dir file in
+      if Sys.is_directory f then remove_dir f
+      else Sys.remove f)
+    (Sys.readdir dir);
+  Unix.rmdir dir
+
+let run prefix tests =
+  let dirs =
+    List.fold_left (fun dirs (title, f) ->
+        let base_dir = Filename.temp_file "tezos_test_" "" in
+        Unix.unlink base_dir;
+        Unix.mkdir base_dir 0o777;
+        make_test ~title:(prefix ^ title) (f base_dir);
+        base_dir :: dirs)
+      [] tests in
+  Test.launch_tests ();
+  if not keep_dir then
+    List.iter remove_dir dirs

test/lib/test.mli

@@ -0,0 +1 @@
+val run : string -> (string * (string -> unit Lwt.t)) list -> unit

test/myocaml-parser

@@ -1,9 +0,0 @@
-#! /bin/sh
-
-TESTDIR="$(dirname $0)"
-TEZOSDIR="$(dirname $TESTDIR)"
-
-export OCAMLRUNPARAM=b
-export LWT_LOG="* -> debug"
-
-opam config --switch 4.01.0 exec -- make -C ${TEZOSDIR} top-parser

test/test.ml

@@ -1,57 +0,0 @@
-
-let (>>=) = Lwt.bind
-
-let keep_dir = try ignore (Sys.getenv "KEEPDIR") ; true with _ -> false
-
-let () = Printexc.record_backtrace true
-
-(** Helpers for tests *)
-
-let log fmt = Format.eprintf fmt
-let fail fmt = Format.kasprintf failwith fmt
-
-let run_test name f =
-  let base_dir = Filename.temp_file "tezos_test_" "" in
-  log "---- beginning of test %S in %s ----\n%!" name base_dir ;
-  Lwt_unix.unlink base_dir >>= fun () ->
-  Lwt_unix.mkdir base_dir 0o777 >>= fun () ->
-  Lwt.catch
-    (fun () -> f base_dir >>= fun () ->
-      log "[test succeeded]\n%!" ;
-      Lwt.return (Ok ()))
-    (function
-      | Failure msg ->
-          log "[test FAILED with %s]\n%!" msg ;
-          Printexc.print_backtrace stderr ;
-          flush stderr ;
-          Lwt.return (Error name)
-      | e ->
-          log "[test FAILED with exception %s]\n%!" (Printexc.to_string e) ;
-          Printexc.print_backtrace stderr ;
-          flush stderr ;
-          Lwt.return (Error name)) >>= fun r ->
-  (if not keep_dir then
-     Utils.remove_dir base_dir
-   else
-     Lwt.return_unit) >>= fun () ->
-  log "---- end of test %S ----\n%!" name ;
-  Lwt.return r
-
-let run prefix l =
-  let results =
-    List.map (fun (name, f) -> Lwt_main.run (run_test (prefix ^ name) f)) l in
-  let failed =
-    List.fold_left
-      (fun acc r ->
-         match r with
-         | Ok () -> acc
-         | Error name -> name :: acc)
-      [] results in
-  match failed with
-  | [] ->
-      Printf.printf "All tests succeeded\n%!"
-  | failed ->
-      Printf.printf "Some tests failed:\n";
-      List.iter (Printf.printf "- %s\n") failed;
-      Printf.printf "%!";
-      exit 1

test/test.mli

@@ -1,3 +0,0 @@
-val log : ('a, Format.formatter, unit) format -> 'a
-val fail : ('a, Format.formatter, unit, 'b) format4 -> 'a
-val run : string -> (string * (string -> unit Lwt.t)) list -> unit

test/test_basic.ml

@@ -13,10 +13,8 @@ let should_fail f t =
   | Error error ->
       if not (List.exists f error) then
         failwith "@[<v 2>Unexpected error@ %a@]" pp_print_error error
-      else begin
+      else
-        Format.printf "-> Failure (as expected)\n%!" ;
         return ()
-      end
 
 let fork_node () =
   let init_timeout = 4 in
@@ -77,16 +75,18 @@ let create_account name =
   Lwt.return { name ; contract ; public_key_hash ; public_key ; secret_key }
 
 let transfer ?(block = `Prevalidation) ?(fee = 5L) ~src ~target amount =
-  Cli_entries.message "Transfer %Ld from %s to %s (fee: %Ld)"
-    amount src.name target.name fee;
   let fee =
-    match Tez.of_cents fee with
+    let fee = Tez.of_cents fee in
+    Assert.is_some ~msg:__LOC__ fee ;
+    match fee with
     | Some x -> x
-    | None -> assert false in
+    | None -> assert false in (* will be captured by the previous assert *)
   let amount =
-    match Tez.of_cents amount with
+    let amount = Tez.of_cents amount in
+    Assert.is_some ~msg:__LOC__ amount ;
+    match amount with
     | Some x -> x
-    | None -> assert false in
+    | None -> assert false in (* will be captured by the previous assert *)
   Client_proto_context.transfer
     block
     ~source:src.contract
@@ -96,16 +96,11 @@ let transfer ?(block = `Prevalidation) ?(fee = 5L) ~src ~target amount =
     ~amount ~fee ()
 
 let check_balance ?(block = `Prevalidation) account expected =
-  Client_proto_rpcs.Context.Contract.balance block account.contract >>=? fun balance ->
+  Client_proto_rpcs.Context.Contract.balance
+    block account.contract >>=? fun balance ->
   let balance = Tez.to_cents balance in
-  if balance <> expected then
+  Assert.equal_int64 ~msg:__LOC__ expected balance ;
-    failwith
+  return ()
-      "Unexpected balance for %s: %Ld (expected: %Ld)"
-      account.name balance expected
-  else begin
-    Cli_entries.message "Balance for %s: %Ld" account.name balance ;
-    return ()
-  end
 
 let mine contract =
   let block = `Head 0 in
@@ -114,19 +109,17 @@ let mine contract =
   Client_mining_forge.forge_block
     ~timestamp:(Time.now ()) ~seed_nonce ~src_sk:contract.secret_key
     block contract.public_key_hash >>=? fun block_hash ->
-  Cli_entries.message "Injected %a" Block_hash.pp_short block_hash ;
   return ()
 
 let ecoproto_error f = function
-  | Register_client_embedded_proto_bootstrap.Ecoproto_error errors -> List.exists f errors
+  | Register_client_embedded_proto_bootstrap.Ecoproto_error errors ->
+      List.exists f errors
   | _ -> false
 
 let main () =
   fork_node () ;
   bootstrap_accounts () >>= fun bootstrap_accounts ->
   let bootstrap = List.hd bootstrap_accounts in
-  Format.printf "Received bootstrap key %a@."
-    Ed25519.Public_key_hash.pp_short bootstrap.public_key_hash ;
   create_account "foo" >>= fun foo ->
   create_account "bar" >>= fun bar ->
   transfer ~src:bootstrap ~target:foo 1000_00L >>=? fun () ->
@@ -138,17 +131,10 @@ let main () =
   should_fail
     (ecoproto_error (function Contract.Too_low_balance -> true | _ -> false))
   @@ transfer ~src:bar ~target:foo 1000_00L >>=? fun () ->
-  mine bootstrap >>=? fun () ->
+  mine bootstrap
-  print_endline "\nEnd of test\n" ;
+
-  return ()
+let tests =
+  [ "main", (fun _ -> main () >>= fun _ -> Lwt.return_unit) ]
 
 let () =
-  try
+  Test.run "basic." tests
-    Lwt_main.run (
-      main () >>= function
-      | Error exns ->
-          Format.eprintf "%a@." pp_print_error exns ;
-        exit 1
-      | Ok () -> Lwt.return_unit)
-  with Cli_entries.Command_failed msg ->
-    Format.eprintf "Error: %s@." msg ;

test/test_context.ml

@@ -1,5 +1,3 @@
-
-open Utils
 open Hash
 open Context
 
@@ -46,7 +44,7 @@ let faked_block : Store.block_header = {
 let create_block2 idx =
   checkout idx genesis_block >>= function
   | None | Some (Error _) ->
-      Test.fail "checkout genesis_block"
+      Assert.fail_msg "checkout genesis_block"
   | Some (Ok ctxt) ->
       set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
       set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
@@ -60,7 +58,7 @@ let block3a =
 let create_block3a idx =
   checkout idx block2 >>= function
   | None | Some (Error _) ->
-      Test.fail "checkout block2"
+      Assert.fail_msg "checkout block2"
   | Some (Ok ctxt) ->
       del ctxt ["a"; "b"] >>= fun ctxt ->
       set ctxt ["a"; "d"] (MBytes.of_string "Mars") >>= fun ctxt ->
@@ -77,7 +75,7 @@ let block3c =
 let create_block3b idx =
   checkout idx block2 >>= function
   | None | Some (Error _) ->
-      Test.fail "checkout block3b"
+      Assert.fail_msg "checkout block3b"
   | Some (Ok ctxt) ->
       del ctxt ["a"; "c"] >>= fun ctxt ->
       set ctxt ["a"; "d"] (MBytes.of_string "Février") >>= fun ctxt ->
@@ -93,7 +91,6 @@ let wrap_context_init f base_dir =
   commit_invalid idx faked_block block3c [Error_monad.Unclassified "TEST"] >>= fun () ->
   f idx
 
-
 (** Simple test *)
 
 let c = function
@@ -103,50 +100,50 @@ let c = function
 let test_simple idx =
   checkout idx block2 >>= function
   | None | Some (Error _) ->
-      Test.fail "checkout block2"
+      Assert.fail_msg "checkout block2"
   | Some (Ok ctxt) ->
       get ctxt ["version"] >>= fun version ->
-      assert (c version = Some "0.0");
+      Assert.equal_string_option ~msg:__LOC__ (c version) (Some "0.0") ;
       get ctxt ["a";"b"] >>= fun novembre ->
-      assert (c novembre = Some "Novembre");
+      Assert.equal_string_option (Some "Novembre") (c novembre) ;
       get ctxt ["a";"c"] >>= fun juin ->
-      assert (c juin = Some "Juin");
+      Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ;
       Lwt.return ()
 
 let test_continuation idx =
   checkout idx block3a >>= function
   | None | Some (Error _) ->
-      Test.fail "checkout block3a"
+      Assert.fail_msg "checkout block3a"
   | Some (Ok ctxt) ->
       get ctxt ["version"] >>= fun version ->
-      assert (c version = Some "0.0");
+      Assert.equal_string_option ~msg:__LOC__ (Some "0.0") (c version) ;
       get ctxt ["a";"b"] >>= fun novembre ->
-      assert (c novembre = None);
+      Assert.is_none ~msg:__LOC__ (c novembre) ;
       get ctxt ["a";"c"] >>= fun juin ->
-      assert (c juin = Some "Juin");
+      Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ;
       get ctxt ["a";"d"] >>= fun mars ->
-      assert (c mars = Some "Mars");
+      Assert.equal_string_option ~msg:__LOC__  (Some "Mars") (c mars) ;
       Lwt.return ()
 
 let test_fork idx =
   checkout idx block3b >>= function
   | None | Some (Error _) ->
-      Test.fail "checkout block3b"
+      Assert.fail_msg "checkout block3b"
   | Some (Ok ctxt) ->
       get ctxt ["version"] >>= fun version ->
-      assert (c version = Some "0.0");
+      Assert.equal_string_option ~msg:__LOC__ (Some "0.0") (c version) ;
       get ctxt ["a";"b"] >>= fun novembre ->
-      assert (c novembre = Some "Novembre");
+      Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
       get ctxt ["a";"c"] >>= fun juin ->
-      assert (c juin = None);
+      Assert.is_none ~msg:__LOC__ (c juin) ;
       get ctxt ["a";"d"] >>= fun mars ->
-      assert (c mars = Some "Février");
+      Assert.equal_string_option ~msg:__LOC__ (Some "Février") (c mars) ;
       Lwt.return ()
 
 let test_replay idx =
   checkout idx genesis_block >>= function
   | None | Some (Error _) ->
-      Test.fail "checkout genesis_block"
+      Assert.fail_msg "checkout genesis_block"
   | Some (Ok ctxt0) ->
       set ctxt0 ["version"] (MBytes.of_string "0.0") >>= fun ctxt1 ->
       set ctxt1 ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt2 ->
@@ -155,21 +152,21 @@ let test_replay idx =
       set ctxt3 ["a"; "d"] (MBytes.of_string "Juillet") >>= fun ctxt4b ->
       set ctxt4a ["a"; "b"] (MBytes.of_string "November") >>= fun ctxt5a ->
       get ctxt4a ["a";"b"] >>= fun novembre ->
-      assert (c novembre = Some "Novembre");
+      Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
       get ctxt5a ["a";"b"] >>= fun november ->
-      assert (c november = Some "November");
+      Assert.equal_string_option ~msg:__LOC__ (Some "November") (c november) ;
       get ctxt5a ["a";"d"] >>= fun july ->
-      assert (c july = Some "July");
+      Assert.equal_string_option ~msg:__LOC__ (Some "July") (c july) ;
       get ctxt4b ["a";"b"] >>= fun novembre ->
-      assert (c novembre = Some "Novembre");
+      Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
       get ctxt4b ["a";"d"] >>= fun juillet ->
-      assert (c juillet = Some "Juillet");
+      Assert.equal_string_option ~msg:__LOC__ (Some "Juillet") (c juillet) ;
       Lwt.return ()
 
 let test_list idx =
   checkout idx genesis_block >>= function
   | None | Some (Error _) ->
-      Test.fail "checkout genesis_block"
+      Assert.fail_msg "checkout genesis_block"
   | Some (Ok ctxt) ->
       set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
       set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
@@ -177,31 +174,33 @@ let test_list idx =
       set ctxt ["f";] (MBytes.of_string "Avril") >>= fun ctxt ->
       set ctxt ["g"; "h"] (MBytes.of_string "Avril") >>= fun ctxt ->
       list ctxt [[]] >>= fun l ->
-      assert (l = [["a"];["f"];["g"]]);
+      Assert.equal_persist_list ~msg:__LOC__ [["a"];["f"];["g"]] l ;
       list ctxt [["a"]] >>= fun l ->
-      assert (l = [["a";"b"]; ["a";"c"]; ["a";"d"]]);
+      Assert.equal_persist_list
+        ~msg:__LOC__ [["a";"b"]; ["a";"c"]; ["a";"d"]] l ;
       list ctxt [["f"]] >>= fun l ->
-      assert (l = []);
+      Assert.equal_persist_list ~msg:__LOC__ [] l ;
       list ctxt [["g"]] >>= fun l ->
-      assert (l = [["g";"h"]]);
+      Assert.equal_persist_list ~msg:__LOC__ [["g";"h"]] l ;
       list ctxt [["i"]] >>= fun l ->
-      assert (l = []);
+      Assert.equal_persist_list ~msg:__LOC__ [] l ;
       list ctxt [["a"];["g"]] >>= fun l ->
-      assert (l = [["a"; "b"]; ["a"; "c"]; ["a"; "d"]; ["g"; "h"]]);
+      Assert.equal_persist_list ~msg:__LOC__
+        [["a"; "b"]; ["a"; "c"]; ["a"; "d"]; ["g"; "h"]] l ;
       Lwt.return ()
 
 let test_invalid idx =
   checkout idx block3c >>= function
   | Some (Error [exn]) ->
-      assert (exn = Error_monad.Unclassified "TEST") ;
+      Assert.equal_error_monad
+        ~msg:__LOC__(Error_monad.Unclassified "TEST") exn ;
       Lwt.return_unit
   | Some (Error _) ->
-      Test.fail "checkout unexpected error in block3c"
+      Assert.fail_msg "checkout unexpected error in block3c"
   | Some (Ok _) ->
-      Test.fail "checkout valid block3c"
+      Assert.fail_msg "checkout valid block3c"
   | None ->
-      Test.fail "checkout absent block3c"
+      Assert.fail_msg "checkout absent block3c"
-
 
 
 (******************************************************************************)
@@ -215,5 +214,5 @@ let tests : (string * (index -> unit Lwt.t)) list = [
   "invalid", test_invalid ;
 ]
 
-let res =
+let () =
   Test.run "context." (List.map (fun (s, f) -> s, wrap_context_init f) tests)

test/test_state.ml

@@ -1,6 +1,4 @@
 
-
-open Utils
 open Hash
 open Error_monad
 
@@ -31,10 +29,12 @@ let incr_fitness fitness =
   let new_fitness =
     match fitness with
     | [ _ ; fitness ] ->
-        Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
+        Pervasives.(
-        |> Utils.unopt 0L
+          Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
-        |> Int64.succ
+          |> Utils.unopt 0L
-        |> Data_encoding.Binary.to_bytes Data_encoding.int64
+          |> Int64.succ
+          |> Data_encoding.Binary.to_bytes Data_encoding.int64
+        )
     | _ -> Data_encoding.Binary.to_bytes Data_encoding.int64 1L
   in
   [ MBytes.of_string "\000" ; new_fitness ]
@@ -44,8 +44,8 @@ let incr_timestamp timestamp =
 
 let operation op =
   let op : Store.operation = {
-      shell = { net_id = Net genesis_block } ;
+    shell = { net_id = Net genesis_block } ;
-      proto = MBytes.of_string op ;
+    proto = MBytes.of_string op ;
   } in
   Store.Operation.hash op,
   op,
@@ -66,17 +66,17 @@ let build_chain state tbl otbl pred names =
     (fun (pred_hash, pred) name ->
        begin
          let oph, op, bytes = operation name in
-         State.Operation.store state bytes >>=? fun _changed ->
+         State.Operation.store state bytes >>=? fun op' ->
-         assert (_changed = Some (oph, op)) ;
+         Assert.equal_operation ~msg:__LOC__ (Some (oph, op)) op' ;
-         State.Operation.mark_invalid state oph [] >>= fun _changed ->
+         State.Operation.mark_invalid state oph [] >>= fun state_invalid ->
-         assert _changed;
+         Assert.is_true ~msg:__LOC__ state_invalid ;
          Hashtbl.add otbl name (oph, Error []) ;
          let block = block ~operations:[oph] state pred_hash pred name in
          let hash = Store.Block.hash block in
-         State.Block.store state (Store.Block.to_bytes block) >>=? fun _changed ->
+         State.Block.store state (Store.Block.to_bytes block) >>=? fun block' ->
-         assert (_changed = Some (hash, block)) ;
+         Assert.equal_block ~msg:__LOC__ (Some (hash, block)) block' ;
-         State.Valid_block.store_invalid state hash [] >>= fun _changed ->
+         State.Valid_block.store_invalid state hash [] >>= fun store_invalid ->
-         assert _changed ;
+         Assert.is_true ~msg:__LOC__ store_invalid ;
          Hashtbl.add tbl name (hash, block) ;
          return (hash, block)
        end >>= function
@@ -103,15 +103,15 @@ let build_valid_chain state net tbl vtbl otbl pred names =
     (fun pred name ->
        begin
          let oph, op, bytes = operation name in
-         State.Operation.store state bytes >>=? fun _changed ->
+         State.Operation.store state bytes >>=? fun op' ->
-         assert (_changed = Some (oph, op)) ;
+         Assert.equal_operation ~msg:__LOC__ (Some (oph, op)) op' ;
-         State.Net.Mempool.add net oph >>= fun _changed ->
+         State.Net.Mempool.add net oph >>= fun add_status ->
-         assert _changed ;
+         Assert.is_true ~msg:__LOC__ add_status ;
          Hashtbl.add otbl name (oph, Ok op) ;
          let block = block state ~operations:[oph] pred name in
          let hash = Store.Block.hash block in
-         State.Block.store state (Store.Block.to_bytes block) >>=? fun _changed ->
+         State.Block.store state (Store.Block.to_bytes block) >>=? fun block' ->
-         assert (_changed = Some (hash, block)) ;
+         Assert.equal_block ~msg:__LOC__ (Some (hash, block)) block' ;
          Hashtbl.add tbl name (hash, block) ;
          Lwt.return (Proto.parse_block_header block) >>=? fun block_header ->
          Proto.apply pred.context block_header [] >>=? fun ctxt ->
@@ -142,11 +142,16 @@ let build_example_tree state net =
   build_chain state tbl otbl b7 chain >>= fun () ->
   let pending_op = "PP" in
   let oph, op, bytes = operation pending_op in
-  State.Operation.store state bytes >>= fun _changed ->
+  State.Operation.store state bytes >>= fun op' ->
-  assert (_changed = Ok (Some (oph, op))) ;
+  Assert.equal_result
+    ~msg:__LOC__
+    (Ok (Some (oph, op)))
+    op'
+    ~equal_ok:Assert.equal_operation
+    ~equal_err:(fun ?msg _ _ -> Assert.fail_msg "Operations differs") ;
   Hashtbl.add otbl pending_op (oph, Ok op) ;
-  State.Net.Mempool.add net oph >>= fun _changed ->
+  State.Net.Mempool.add net oph >>= fun add_status ->
-  assert _changed ;
+  Assert.is_true ~msg:__LOC__ add_status ;
   Lwt.return (tbl, vtbl, otbl)
 
 type state = {
@@ -172,16 +177,19 @@ let rev_find s h =
   with Found s -> s
 
 let blocks s =
-  Hashtbl.fold (fun k v acc -> (k,v) :: acc) s.block []
+  Pervasives.(
-  |> List.sort Pervasives.compare
+    Hashtbl.fold (fun k v acc -> (k,v) :: acc) s.block []
+    |> List.sort Pervasives.compare)
 
 let vblocks s =
-  Hashtbl.fold (fun k v acc -> (k,v) :: acc) s.vblock []
+  Pervasives.(
-  |> List.sort Pervasives.compare
+    Hashtbl.fold (fun k v acc -> (k,v) :: acc) s.vblock []
+    |> List.sort Pervasives.compare)
 
 let operations s =
-  Hashtbl.fold (fun k v acc -> (k,v) :: acc) s.operation []
+  Pervasives.(
-  |> List.sort Pervasives.compare
+    Hashtbl.fold (fun k v acc -> (k,v) :: acc) s.operation []
+    |> List.sort Pervasives.compare)
 
 let wrap_state_init f base_dir =
   begin
@@ -205,7 +213,7 @@ let wrap_state_init f base_dir =
   end >>= function
   | Ok () -> Lwt.return_unit
   | Error err ->
-      Test.fail "%a@." Error_monad.pp_print_error err
+      Lwt.return (Error_monad.pp_print_error Format.err_formatter err)
 
 let save_reload s =
   State.shutdown s.state >>= fun () ->
@@ -221,10 +229,10 @@ let test_read_operation (s: state) =
   Lwt_list.iter_s (fun (name, (oph, op)) ->
       State.Operation.read s.state oph >>= function
       | None ->
-          Test.fail "Cannot read block %s" name
+          Assert.fail_msg "Cannot read block %s" name
       | Some { Time.data } ->
           if op <> data then
-            Test.fail "Incorrect operation read %s" name ;
+            Assert.fail_msg "Incorrect operation read %s" name ;
           Lwt.return_unit)
     (operations s) >>= fun () ->
   return s
@@ -240,11 +248,10 @@ let test_read_block (s: state) =
       begin
         State.Block.read s.state hash >>= function
         | None ->
-            Test.fail "Cannot read block %s" name
+            Assert.fail_msg "Cannot read block %s" name
         | Some { Time.data = block' ; time } ->
             if not (Store.Block.equal block block') then
-              Test.fail "Error while reading block %s" name ;
+              Assert.fail_msg "Error while reading block %s" name ;
-            Test.log "Read block %s %a\n" name Time.pp_hum time;
             Lwt.return_unit
       end >>= fun () ->
       let vblock =
@@ -252,18 +259,16 @@ let test_read_block (s: state) =
         with Not_found -> None in
       State.Valid_block.read s.state hash >>= function
       | None ->
-          Test.fail "Cannot read %s" name
+          Assert.fail_msg "Cannot read %s" name
       | Some (Error _) ->
           if vblock <> None then
-            Test.fail "Error while reading valid block %s" name ;
+            Assert.fail_msg "Error while reading valid block %s" name ;
-          Test.log "Read invalid block %s\n" name ;
           Lwt.return_unit
       | Some (Ok _vblock') ->
           match vblock with
           | None ->
-              Test.fail "Error while reading invalid block %s" name
+              Assert.fail_msg "Error while reading invalid block %s" name
           | Some _vblock ->
-              Test.log "Read valid block %s\n" name ;
               Lwt.return_unit
     ) (blocks s) >>= fun () ->
   return s
@@ -275,20 +280,23 @@ let test_read_block (s: state) =
 
 let compare s kind name succs l =
   if Block_hash_set.cardinal succs <> List.length l then
-    Test.fail "unexpected %ssuccessors size (%s: %d %d)"
+    Assert.fail_msg
+      "unexpected %ssuccessors size (%s: %d %d)"
       kind name (Block_hash_set.cardinal succs) (List.length l) ;
   List.iter
     (fun bname ->
        let bh = fst @@ block s bname in
        if not (Block_hash_set.mem bh succs) then
-         Test.fail "missing block in %ssuccessors (%s: %s)" kind name bname)
+         Assert.fail_msg
+           "missing block in %ssuccessors (%s: %s)" kind name bname)
     l
+
 let test_successors s =
   let test s name expected invalid_expected =
     let b = vblock s name in
     State.Valid_block.read s.state b.hash >>= function
     | None | Some (Error _) ->
-        Test.fail "Failed while reading block %s" name
+        Assert.fail_msg "Failed while reading block %s" name
     | Some (Ok { successors ; invalid_successors}) ->
         compare s "" name successors expected ;
         compare s "invalid " name invalid_successors invalid_expected ;
@@ -314,13 +322,13 @@ let rec compare_path p1 p2 = match p1, p2 with
 
 let test_path (s: state) =
   let check_path h1 h2 p2 =
-    Test.log "check_path %s -> %s\n" h1 h2 ;
     State.Block.path s.state (fst @@ block s h1) (fst @@ block s h2) >>= function
     | Error _ ->
-        Test.fail "cannot compute path %s -> %s" h1 h2 ;
+        Assert.fail_msg "cannot compute path %s -> %s" h1 h2
     | Ok p1 ->
         let p2 = List.map (fun b -> fst (block s b)) p2 in
-        if not (compare_path p1 p2) then Test.fail "bad path %s -> %s" h1 h2 ;
+        if not (compare_path p1 p2) then
+          Assert.fail_msg "bad path %s -> %s" h1 h2 ;
         Lwt.return_unit in
   check_path "A2" "A6" ["A3"; "A4"; "A5"; "A6"] >>= fun () ->
   check_path "B2" "B6" ["B3"; "B4"; "B5"; "B6"] >>= fun () ->
@@ -331,14 +339,14 @@ let test_path (s: state) =
 
 let test_valid_path (s: state) =
   let check_path h1 h2 p2 =
-    Test.log "check_path %s -> %s\n" h1 h2 ;
     State.Valid_block.path s.state (vblock s h1) (vblock s h2) >>= function
     | None ->
-        Test.fail "cannot compute path %s -> %s" h1 h2 ;
+        Assert.fail_msg "cannot compute path %s -> %s" h1 h2 ;
     | Some (p: State.Valid_block.t list) ->
         let p = List.map (fun b -> b.State.Valid_block.hash) p in
         let p2 = List.map (fun b -> (vblock s b).hash) p2 in
-        if not (compare_path p p2) then Test.fail "bad path %s -> %s" h1 h2 ;
+        if not (compare_path p p2) then
+          Assert.fail_msg "bad path %s -> %s" h1 h2 ;
         Lwt.return_unit in
   check_path "A2" "A6" ["A3"; "A4"; "A5"; "A6"] >>= fun () ->
   check_path "B2" "B6" ["B3"; "B4"; "B5"; "B6"] >>= fun () ->
@@ -355,19 +363,18 @@ let test_ancestor s =
     State.Block.common_ancestor
       s.state (fst @@ block s h1) (fst @@ block s h2) >>= function
     | Error _ ->
-        Test.fail "Cannot compure ancestor for %s %s" h1 h2
+        Assert.fail_msg "Cannot compure ancestor for %s %s" h1 h2 ;
     | Ok a ->
         if not (Block_hash.equal a (fst expected)) then
-          Test.fail "bad ancestor %s %s: found %s, expected %s"
+          Assert.fail_msg
-            h1 h2 (rev_find s a) (rev_find s @@ fst expected);
+            "bad ancestor %s %s: found %s, expected %s"
-        Test.log "Found the expected ancestor %s %s\n" h1 h2 ;
+            h1 h2 (rev_find s a) (rev_find s @@ fst expected) ;
         Lwt.return_unit in
   let check_valid_ancestor h1 h2 expected =
     State.Valid_block.common_ancestor
       s.state (vblock s h1) (vblock s h2) >>= fun a ->
     if not (Block_hash.equal a.hash expected.State.Valid_block.hash) then
-      Test.fail "bad ancestor %s %s" h1 h2 ;
+      Assert.fail_msg "bad ancestor %s %s" h1 h2 ;
-    Test.log "Found the expected valid ancestor %s %s\n" h1 h2 ;
     Lwt.return_unit in
   check_ancestor "A6" "B6" (block s "A3") >>= fun () ->
   check_ancestor "B6" "A6" (block s "A3") >>= fun () ->
@@ -401,30 +408,31 @@ let test_locator s =
     State.Block.block_locator
       s.state (List.length expected) (fst @@ block s h1) >>= function
     | Error _ ->
-        Test.fail "Cannot compute locator for %s" h1
+        Assert.fail_msg "Cannot compute locator for %s" h1
     | Ok l ->
         if List.length l <> List.length expected then
-          Test.fail "Invalid locator length %s (found: %d, expected: %d)"
+          Assert.fail_msg
+            "Invalid locator length %s (found: %d, expected: %d)"
             h1 (List.length l) (List.length expected) ;
         List.iter2
           (fun h h2 ->
              if not (Block_hash.equal h (fst @@ block s h2)) then
-               Test.fail "Invalid locator %s (expectd: %s)" h1 h2)
+               Assert.fail_msg "Invalid locator %s (expectd: %s)" h1 h2)
           l expected;
         Lwt.return_unit in
   let check_valid_locator h1 expected =
     State.Valid_block.block_locator
       s.state (List.length expected) (vblock s h1) >>= fun l ->
     if List.length l <> List.length expected then
-      Test.fail "Invalid locator length %s (found: %d, expected: %d)"
+      Assert.fail_msg
+        "Invalid locator length %s (found: %d, expected: %d)"
         h1 (List.length l) (List.length expected) ;
     List.iter2
       (fun h h2 ->
          if not (Block_hash.equal h (fst @@ block s h2)) then
-           Test.fail "Invalid locator %s (expectd: %s)" h1 h2)
+           Assert.fail_msg "Invalid locator %s (expectd: %s)" h1 h2)
       l expected ;
     Lwt.return_unit in
-  Printf.eprintf "Checking Block\n%!" ;
   check_locator "A8" ["A8";"A7";"A6";"A5";"A4";"A3";"A2";"A1"] >>= fun () ->
   check_locator "B8"
     ["B8";"B7";"B6";"B5";"B4";"B3";"B2";"B1";"A3"] >>= fun () ->
@@ -432,7 +440,6 @@ let test_locator s =
     ["C8";"C7";"C6";"C5";"C4";"C3";"C2";"C1";
      "B7";"B6";"B4";"B2";"A3";"A1"] >>= fun () ->
   check_locator "C8" ["C8";"C7";"C6";"C5";"C4"] >>= fun () ->
-  Printf.eprintf "Checking Valid_block\n%!" ;
   check_valid_locator "A8"
     ["A8";"A7";"A6";"A5";"A4";"A3";"A2"] >>= fun () ->
   check_valid_locator "B8"
@@ -447,13 +454,14 @@ let test_locator s =
 
 let compare s name heads l =
   if Block_hash_map.cardinal heads <> List.length l then
-    Test.fail "unexpected known_heads size (%s: %d %d)"
+    Assert.fail_msg
+      "unexpected known_heads size (%s: %d %d)"
       name (Block_hash_map.cardinal heads) (List.length l) ;
   List.iter
     (fun bname ->
        let hash = (vblock s bname).hash in
        if not (Block_hash_map.mem hash heads) then
-         Test.fail "missing block in known_heads (%s: %s)" name bname)
+         Assert.fail_msg "missing block in known_heads (%s: %s)" name bname)
     l
 
 let test_known_heads s =
@@ -473,15 +481,15 @@ let test_known_heads s =
 let test_head s =
   State.Net.Blockchain.head s.net >>= fun head ->
   if not (Block_hash.equal head.hash genesis_block) then
-    Test.fail "unexpected head" ;
+    Assert.fail_msg "unexpected head" ;
   State.Net.Blockchain.set_head s.net (vblock s "A6") >>= fun _ ->
   State.Net.Blockchain.head s.net >>= fun head ->
   if not (Block_hash.equal head.hash (vblock s "A6").hash) then
-    Test.fail "unexpected head" ;
+    Assert.fail_msg "unexpected head" ;
   save_reload s >>=? fun s ->
   State.Net.Blockchain.head s.net >>= fun head ->
   if not (Block_hash.equal head.hash (vblock s "A6").hash) then
-    Test.fail "unexpected head" ;
+    Assert.fail_msg "unexpected head" ;
   return s
 
 
@@ -495,11 +503,11 @@ let test_mem s =
   let test_mem s x =
     mem s x >>= function
     | true -> Lwt.return_unit
-    | false -> Test.fail "mem %s" x in
+    | false -> Assert.fail_msg "mem %s" x in
   let test_not_mem s x =
     mem s x >>= function
     | false -> Lwt.return_unit
-    | true -> Test.fail "not (mem %s)" x in
+    | true -> Assert.fail_msg "not (mem %s)" x in
   test_not_mem s "A3" >>= fun () ->
   test_not_mem s "A6" >>= fun () ->
   test_not_mem s "A8" >>= fun () ->
@@ -539,7 +547,7 @@ let test_mem s =
   save_reload s >>=? fun s ->
   State.Net.Blockchain.head s.net >>= fun head ->
   if not (Block_hash.equal head.hash (vblock s "B8").hash) then
-    Test.fail "Invalid head after save/load" ;
+    Assert.fail_msg "Invalid head after save/load" ;
   return s
 
 
@@ -552,20 +560,20 @@ let test_new s =
     State.Valid_block.block_locator s.state 50 (vblock s h) >>= fun loc ->
     State.Net.Blockchain.find_new s.net loc (List.length expected) >>= function
     | Error _ ->
-        Test.fail "Failed to compute new blocks %s" h
+        Assert.fail_msg "Failed to compute new blocks %s" h
     | Ok blocks ->
         if List.length blocks <> List.length expected then
-          Test.fail "Invalid locator length %s (found: %d, expected: %d)"
+          Assert.fail_msg
+            "Invalid locator length %s (found: %d, expected: %d)"
             h (List.length blocks) (List.length expected) ;
         List.iter2
           (fun h1 h2 ->
              if not (Block_hash.equal h1 (vblock s h2).hash) then
-               Test.fail "Invalid locator %s (expected: %s)" h h2)
+               Assert.fail_msg "Invalid locator %s (expected: %s)" h h2)
           blocks expected ;
-    Lwt.return_unit
+        Lwt.return_unit
   in
   test s "A6" [] >>= fun () ->
-  Printf.eprintf "Set_head A8.\n%!" ;
   State.Net.Blockchain.set_head s.net (vblock s "A8") >>= fun _ ->
   test s "A6" ["A7";"A8"] >>= fun () ->
   test s "A6" ["A7"] >>= fun () ->
@@ -579,14 +587,21 @@ let test_new s =
 (** State.mempool *)
 
 let compare s name mempool l =
-  if Operation_hash_set.cardinal mempool <> List.length l then
+  let mempool_sz = Operation_hash_set.cardinal mempool in
-    Test.fail "unexpected mempool size (%s: %d %d)"
+  let l_sz = List.length l in
-      name (Operation_hash_set.cardinal mempool) (List.length l) ;
+  if mempool_sz <> l_sz then
+    Assert.fail
+      (string_of_int mempool_sz)
+      (string_of_int l_sz)
+      "unexpected mempool size (%s)" name ;
   List.iter
     (fun oname ->
-       let oph = fst @@ operation s oname in
+       try
-       if not (Operation_hash_set.mem oph mempool) then
+         let oph = fst @@ operation s oname  in
-         Test.fail "missing operation in mempool (%s: %s)" name oname)
+         if not (Operation_hash_set.mem oph mempool) then
+           Assert.fail_msg "missing operation in mempool (%s: %s)" name oname
+       with Not_found ->
+         Assert.fail_msg "Read value not found in mempool (%s: %s)" name oname)
     l
 
 let test_mempool s =
@@ -611,10 +626,10 @@ let test_mempool s =
     ["PP";
      "A4" ; "A5" ; "A6" ; "A7" ; "A8" ;
      "B7" ; "B8" ] ;
-  State.Net.Mempool.remove s.net (fst @@ operation s "PP") >>= fun _changed ->
+  State.Net.Mempool.remove s.net (fst @@ operation s "PP") >>= fun rm_status ->
-  assert _changed ;
+  Assert.is_true ~msg:__LOC__ rm_status ;
-  State.Net.Mempool.remove s.net (fst @@ operation s "PP") >>= fun _changed ->
+  State.Net.Mempool.remove s.net (fst @@ operation s "PP") >>= fun rm_status ->
-  assert (not _changed) ;
+  Assert.is_false ~msg:__LOC__ rm_status ;
   State.Net.Mempool.get s.net >>= fun mempool ->
   compare s "B6.remove" mempool
     ["A4" ; "A5" ; "A6" ; "A7" ; "A8" ;
@@ -649,5 +664,5 @@ let tests : (string * (state -> state tzresult Lwt.t)) list = [
   "mempool", test_mempool;
 ]
 
-let res =
+let () =
   Test.run "state." (List.map (fun (s, f) -> s, wrap_state_init f) tests)

test/test_store.ml

@@ -1,5 +1,4 @@
 
-open Utils
 open Hash
 open Store
 
@@ -109,16 +108,15 @@ let test_block (s: Store.store) =
 let check s k d =
   get s k >|= fun d' ->
   if d' <> Some d then begin
-    Test.fail
+    Assert.fail_msg
-      "Error while reading key %S\n%!"
+      "Error while reading key %S\n%!"  (String.concat Filename.dir_sep k) ;
-      (String.concat Filename.dir_sep k);
   end
 
 let check_none s k =
   get s k >|= function
   | None -> ()
   | Some _ ->
-      Test.fail
+      Assert.fail_msg
         "Error while reading non-existent key %S\n%!"
         (String.concat Filename.dir_sep k)
 
@@ -139,26 +137,27 @@ let test_generic_list (s: Store.store) =
       set s ["f";] (MBytes.of_string "Avril") >>= fun () ->
       set s ["g"; "h"] (MBytes.of_string "Avril") >>= fun () ->
       list s [] >>= fun l ->
-      assert (l = []);
+      Assert.equal_persist_list ~msg:__LOC__ [] l ;
       list s [[]] >>= fun l ->
-      assert (l = [["a"];["f"];["g"];["version"]]);
+      Assert.equal_persist_list
+        ~msg:__LOC__ [["a"];["f"];["g"];["version"]] l ;
       list s [["a"]] >>= fun l ->
-      assert (l = [["a";"b"]; ["a";"c"]; ["a";"d"]]);
+      Assert.equal_persist_list
+        ~msg:__LOC__ [["a";"b"]; ["a";"c"]; ["a";"d"]] l ;
       list s [["f"]] >>= fun l ->
-      assert (l = []);
+      Assert.equal_persist_list ~msg:__LOC__ [] l ;
       list s [["g"]] >>= fun l ->
-      assert (l = [["g";"h"]]);
+      Assert.equal_persist_list ~msg:__LOC__ [["g";"h"]] l ;
       list s [["i"]] >>= fun l ->
-      assert (l = []);
+      Assert.equal_persist_list ~msg:__LOC__ [] l ;
       list s [["a"];["g"]] >>= fun l ->
-      assert (l = [["a"; "b"]; ["a"; "c"]; ["a"; "d"]; ["g"; "h"]]);
+      Assert.equal_persist_list ~msg:__LOC__
+        [["a"; "b"]; ["a"; "c"]; ["a"; "d"]; ["g"; "h"]] l ;
       Lwt.return_unit)
 
 (** HashSet *)
 
 let test_hashset (s: Store.store) =
-  let test name b =
-    if b then Lwt.return_unit else Test.fail name in
   let module BlockSet = Hash_set(Block_hash) in
   let module StoreSet =
     Persist.MakeBufferedPersistentSet
@@ -168,22 +167,25 @@ let test_hashset (s: Store.store) =
         let prefix = [ "test_set" ]
         let length = path_len
       end)(BlockSet) in
-  let bhset = BlockSet.empty |> BlockSet.add bh1 |> BlockSet.add bh2 in
+  let open BlockSet in
+  let eq = BlockSet.equal in
+  let bhset : BlockSet.t = BlockSet.add bh2 (BlockSet.add bh1 BlockSet.empty) in
   Persist.use s.global_store (fun s ->
       StoreSet.write s bhset >>= fun s ->
       StoreSet.read s >>= fun bhset' ->
-      test "init" (BlockSet.compare bhset bhset' = 0) >>= fun () ->
+      Assert.equal_block_map ~msg:__LOC__ ~eq bhset bhset' ;
-      let bhset2 = bhset |> BlockSet.add bh3 |> BlockSet.remove bh1 in
+      let bhset2 =
+        Pervasives.(bhset |> BlockSet.add bh3 |> BlockSet.remove bh1) in
       StoreSet.write s bhset2 >>= fun s ->
       StoreSet.read s >>= fun bhset2' ->
-      test "add/del" (BlockSet.compare bhset2 bhset2' = 0) >>= fun () ->
+      Assert.equal_block_map ~msg:__LOC__ ~eq bhset2 bhset2' ;
       StoreSet.fold s BlockSet.empty
         (fun bh acc -> Lwt.return (BlockSet.add bh acc)) >>= fun bhset2'' ->
-      test "fold" (BlockSet.compare bhset2 bhset2'' = 0) >>= fun () ->
+      Assert.equal_block_map ~msg:__LOC__ ~eq bhset2 bhset2'' ;
       set s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
       StoreSet.clear s >>= fun s ->
       StoreSet.read s >>= fun empty ->
-      test "clean" (BlockSet.compare empty BlockSet.empty = 0) >>= fun () ->
+      Assert.equal_block_map ~msg:__LOC__ ~eq BlockSet.empty empty ;
       check s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
       Lwt.return_unit)
 
@@ -191,8 +193,6 @@ let test_hashset (s: Store.store) =
 (** HashMap *)
 
 let test_hashmap (s: Store.store) =
-  let test name b =
-    if b then Lwt.return_unit else Test.fail name in
   let module BlockMap = Hash_map(Block_hash) in
   let module StoreMap =
     Persist.MakeBufferedPersistentTypedMap
@@ -208,17 +208,19 @@ let test_hashmap (s: Store.store) =
           Data_encoding.(tup2 int31 (conv int_of_char char_of_int int8))
       end)
       (BlockMap) in
+  let eq = BlockMap.equal (=) in
   let map =
-    BlockMap.empty |> BlockMap.add bh1 (1, 'a') |> BlockMap.add bh2 (2, 'b') in
+    Pervasives.(BlockMap.empty |>
+                BlockMap.add bh1 (1, 'a') |> BlockMap.add bh2 (2, 'b')) in
   Persist.use s.global_store (fun s ->
       StoreMap.write s map >>= fun s ->
       StoreMap.read s >>= fun map' ->
-      test "init" (BlockMap.compare Pervasives.compare map map' = 0) >>= fun () ->
+      Assert.equal_block_map ~msg:__LOC__ ~eq map map' ;
-      let map2 = map |> BlockMap.add bh3 (3, 'c') |> BlockMap.remove bh1 in
+      let map2 =
+        Pervasives.(map |> BlockMap.add bh3 (3, 'c') |> BlockMap.remove bh1) in
       StoreMap.write s map2 >>= fun s ->
       StoreMap.read s >>= fun map2' ->
-      test "add/del"
+      Assert.equal_block_map ~msg:__LOC__ ~eq map2 map2' ;
-        (BlockMap.compare Pervasives.compare map2 map2' = 0) >>= fun () ->
       Lwt.return_unit)
 
 (** *)
@@ -231,8 +233,7 @@ let tests : (string * (store -> unit Lwt.t)) list = [
   "generic_list", test_generic_list ;
   "hashset", test_hashset ;
   "hashmap", test_hashmap ;
- ]
+]
 
-let res =
+let () =
   Test.run "store." (List.map (fun (s, f) -> s, wrap_store_init f) tests)
-