balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update test framework

Browse Source 
We now use Kaputt for our tests.
This commit is contained in:
Çağdaş Bozman 2016-09-30 11:43:50 +02:00 committed by Grégoire Henry
parent d0f78a5662
commit 03d37bfdeb
17 changed files with 352 additions and 275 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

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

2
scripts/install_build_deps.sh
View File

@ -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

1
src/tezos-deps.opam
View File

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

3
test/.merlin
View File

@ -19,4 +19,5 @@ S ../src/client/embedded
B ../src/client/embedded
FLG -w -40
PKG lwt
PKG sodium
PKG sodium
PKG kaputt

27
test/Makefile
View File

@ -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 \
test_store.ml \
lib/assert.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 \
test_context.ml \
lib/assert.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 \
test_state.ml \
lib/assert.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 \
test_basic.ml \
lib/assert.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::

0
test/test_p2p.ml → test/attic/test_p2p.ml
View File

75
test/lib/assert.ml Normal file
View File

@ -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"

35
test/lib/assert.mli Normal file
View File

@ -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

27
test/lib/test.ml Normal file
View File

@ -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

1
test/lib/test.mli Normal file
View File

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

9
test/myocaml-parser
View File

@ -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

57
test/test.ml
View File

@ -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

3
test/test.mli
View File

@ -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

54
test/test_basic.ml
View File

@ -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
Format.printf "-> Failure (as expected)\n%!" ;
else
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
failwith
"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
Assert.equal_int64 ~msg:__LOC__ expected balance ;
return ()
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 () ->
print_endline "\nEnd of test\n" ;
return ()
mine bootstrap
let tests =
[ "main", (fun _ -> main () >>= fun _ -> Lwt.return_unit) ]
let () =
try
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.run "basic." tests

77
test/test_context.ml
View File

@ -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)

193
test/test_state.ml
View File

@ -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
|> Utils.unopt 0L
|> Int64.succ
|> Data_encoding.Binary.to_bytes Data_encoding.int64
Pervasives.(
Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
|> Utils.unopt 0L
|> 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 } ;
proto = MBytes.of_string op ;
shell = { net_id = Net genesis_block } ;
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 ->
assert (_changed = Some (oph, op)) ;
State.Operation.mark_invalid state oph [] >>= fun _changed ->
assert _changed;
State.Operation.store state bytes >>=? fun op' ->
Assert.equal_operation ~msg:__LOC__ (Some (oph, op)) op' ;
State.Operation.mark_invalid state oph [] >>= fun state_invalid ->
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 ->
assert (_changed = Some (hash, block)) ;
State.Valid_block.store_invalid state hash [] >>= fun _changed ->
assert _changed ;
State.Block.store state (Store.Block.to_bytes block) >>=? fun block' ->
Assert.equal_block ~msg:__LOC__ (Some (hash, block)) block' ;
State.Valid_block.store_invalid state hash [] >>= fun store_invalid ->
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 ->
assert (_changed = Some (oph, op)) ;
State.Net.Mempool.add net oph >>= fun _changed ->
assert _changed ;
State.Operation.store state bytes >>=? fun op' ->
Assert.equal_operation ~msg:__LOC__ (Some (oph, op)) op' ;
State.Net.Mempool.add net oph >>= fun add_status ->
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 ->
assert (_changed = Some (hash, block)) ;
State.Block.store state (Store.Block.to_bytes block) >>=? fun 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 ->
assert (_changed = Ok (Some (oph, op))) ;
State.Operation.store state bytes >>= fun 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 ->
assert _changed ;
State.Net.Mempool.add net oph >>= fun add_status ->
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 []
|> List.sort Pervasives.compare
Pervasives.(
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 []
|> List.sort Pervasives.compare
Pervasives.(
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 []
|> List.sort Pervasives.compare
Pervasives.(
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 ;
Test.log "Read block %s %a\n" name Time.pp_hum time;
Assert.fail_msg "Error while reading block %s" name ;
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 ;
Test.log "Read invalid block %s\n" name ;
Assert.fail_msg "Error while reading valid block %s" 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"
h1 h2 (rev_find s a) (rev_find s @@ fst expected);
Test.log "Found the expected ancestor %s %s\n" h1 h2 ;
Assert.fail_msg
"bad ancestor %s %s: found %s, expected %s"
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 ;
Test.log "Found the expected valid ancestor %s %s\n" h1 h2 ;
Assert.fail_msg "bad ancestor %s %s" 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
Test.fail "unexpected mempool size (%s: %d %d)"
name (Operation_hash_set.cardinal mempool) (List.length l) ;
let mempool_sz = Operation_hash_set.cardinal mempool in
let l_sz = List.length l in
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
if not (Operation_hash_set.mem oph mempool) then
Test.fail "missing operation in mempool (%s: %s)" name oname)
try
let oph = fst @@ operation s oname in
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 ->
assert _changed ;
State.Net.Mempool.remove s.net (fst @@ operation s "PP") >>= fun _changed ->
assert (not _changed) ;
State.Net.Mempool.remove s.net (fst @@ operation s "PP") >>= fun rm_status ->
Assert.is_true ~msg:__LOC__ rm_status ;
State.Net.Mempool.remove s.net (fst @@ operation s "PP") >>= fun rm_status ->
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)

61
test/test_store.ml
View File

@ -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
"Error while reading key %S\n%!"
(String.concat Filename.dir_sep k);
Assert.fail_msg
"Error while reading key %S\n%!" (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 () ->
let bhset2 = bhset |> BlockSet.add bh3 |> BlockSet.remove bh1 in
Assert.equal_block_map ~msg:__LOC__ ~eq bhset bhset' ;
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 () ->
let map2 = map |> BlockMap.add bh3 (3, 'c') |> BlockMap.remove bh1 in
Assert.equal_block_map ~msg:__LOC__ ~eq map map' ;
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"
(BlockMap.compare Pervasives.compare map2 map2' = 0) >>= fun () ->
Assert.equal_block_map ~msg:__LOC__ ~eq map2 map2' ;
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)