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

Test: quick and dirty port to alcotest

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-11 22:36:49 +01:00
parent 24fe0cc02c
commit a70a0788d3
74 changed files with 902 additions and 1052 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
.gitlab-ci.yml
View File

@ -251,31 +251,31 @@ opam:08:tezos-micheline:
variables:
package: tezos-micheline
opam:09:tezos-rpc:
opam:09:tezos-protocol-environment-sigs:
<<: *opam_definition
variables:
package: tezos-protocol-environment-sigs
opam:10:tezos-rpc:
<<: *opam_definition
variables:
package: tezos-rpc
opam:10:tezos-base:
opam:11:tezos-base:
<<: *opam_definition
variables:
package: tezos-base
opam:11:ocplib-resto-cohttp:
opam:12:ocplib-resto-cohttp:
<<: *opam_definition
variables:
package: ocplib-resto-cohttp
opam:12:irmin-leveldb:
opam:13:irmin-leveldb:
<<: *opam_definition
variables:
package: irmin-leveldb
opam:13:tezos-protocol-environment-sigs:
<<: *opam_definition
variables:
package: tezos-protocol-environment-sigs
opam:14:tezos-stdlib-unix:
<<: *opam_definition
variables:
@ -381,17 +381,12 @@ opam:34:tezos-node:
variables:
package: tezos-node
opam:35:tezos-test-helpers:
<<: *opam_definition
variables:
package: tezos-test-helpers
opam:36:ocplib-ezresto-directory:
opam:35:ocplib-ezresto-directory:
<<: *opam_definition
variables:
package: ocplib-ezresto-directory
opam:37:tezos-protocol-demo:
opam:36:tezos-protocol-demo:
<<: *opam_definition
variables:
package: tezos-protocol-demo

2
scripts/ci/create_docker_image.build_deps.sh
View File

@ -38,7 +38,7 @@ RUN opam exec -- ./tezos/scripts/install_build_deps.sh || \
echo ; \
opam remote add default https://opam.ocaml.org/2.0 && \
opam exec -- ./tezos/scripts/install_build_deps.sh )
RUN opam install --yes ocp-indent
RUN opam install --yes ocp-indent alcotest-lwt
EOF
tar -c $dependencies | tar -C "$tmp_dir" -x

2
scripts/ci/create_opam_repository.tezos_deps.sh
View File

@ -48,7 +48,7 @@ done
# Hack: it loks like there is too many cycle in the opam-repository,
# when using `opam-bundle --with-test --with-doc`, so we manually
# inline some of the test and doc dependencies.
extra_packages="depext kaputt alcotest ocp-indent odoc"
extra_packages="depext alcotest-lwt ocp-indent odoc"
if ! [ -f "$build_dir"/opam-repository-master.tgz ]; then
echo

5
src/lib_crypto/test/jbuild
View File

@ -3,14 +3,11 @@
(executables
((names (test_merkle))
(libraries (tezos-stdlib
tezos-error-monad
tezos-crypto
tezos-test-helpers))
alcotest))
(flags (:standard -w -9-32
-safe-string
-open Tezos_test_helpers
-open Tezos_stdlib
-open Tezos_error_monad
-open Tezos_crypto))))
(alias

27
src/lib_crypto/test/test_merkle.ml
View File

@ -7,7 +7,6 @@
(* *)
(**************************************************************************)
open Error_monad
open Utils.Infix
type tree =
@ -43,9 +42,10 @@ let check_size i =
let l = 0 -- i in
let l2, _ = list_of_tree (Merkle.compute l) in
if compare_list l l2 then
return ()
()
else
failwith "Failed for %d: %a"
Format.kasprintf failwith
"Failed for %d: %a"
i
(Format.pp_print_list
~pp_sep:(fun ppf () -> Format.pp_print_string ppf ";")
@ -53,28 +53,29 @@ let check_size i =
l2
let test_compute _ =
iter_s check_size (0--99)
List.iter check_size (0--99)
let check_path i =
let l = 0 -- i in
let orig = Merkle.compute l in
iter_s (fun j ->
List.iter (fun j ->
let path = Merkle.compute_path l j in
let found, pos = Merkle.check_path path j in
if found = orig && j = pos then
return ()
()
else
failwith "Failed for %d in %d." j i)
Format.kasprintf failwith "Failed for %d in %d." j i)
l
let test_path _ =
iter_s check_path (0--128)
List.iter check_path (0--128)
let tests : (string * (string -> unit tzresult Lwt.t)) list = [
"compute", test_compute ;
"path", test_path ;
let tests = [
"compute", `Quick, test_compute ;
"path", `Quick, test_path ;
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "merkel." tests
Alcotest.run "tezos-crypto" [
"merkel", tests
]

3
src/lib_crypto/tezos-crypto.opam
View File

@ -9,14 +9,13 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"tezos-test-helpers" { test }
"tezos-stdlib"
"lwt"
"nocrypto"
"blake2"
"tweetnacl"
"zarith"
"tezos-error-monad" { test }
"alcotest" { test }
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]

43
src/lib_data_encoding/test/assert.ml Normal file
View File

@ -0,0 +1,43 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let fail expected given msg =
Format.kasprintf failwith
"@[%s@ expected: %s@ got: %s@]" msg expected given
let fail_msg fmt = Format.kasprintf (fail "" "") fmt
let default_printer _ = ""
let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
if not (eq x y) then fail (prn x) (prn y) msg
let not_equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
if eq x y then fail (prn x) (prn y) msg
let is_some ?(msg = "Assert.is_some: error.") a =
match a with
| None -> fail "Some _" "None" msg
| Some _ -> ()
let is_true ?(msg="") x =
if not x then fail "true" "false" msg
let equal_float ?eq ?prn ?msg f1 f2 =
match classify_float f1, classify_float f2 with
| FP_nan, FP_nan -> ()
| _ -> equal ?eq ?prn ?msg f1 f2
let test_fail ?(msg = "") ?(prn = default_printer) f may_fail =
try
let value = f () in
fail "any exception" ("no exception: " ^ prn value) msg
with exn ->
if not (may_fail exn) then
fail "exception"
(Printf.sprintf "unexpectec exception: %s" (Printexc.to_string exn))
msg

22
src/lib_data_encoding/test/jbuild
View File

@ -1,37 +1,25 @@
(jbuild_version 1)
(executables
((names (test_data_encoding
test_stream_data_encoding
((names (test
;; bench_data_encoding
))
(libraries (tezos-stdlib
tezos_data_encoding
tezos-test-helpers))
alcotest))
(flags (:standard -w -9-32 -safe-string
-open Tezos_stdlib
-open Tezos_data_encoding
-open Tezos_test_helpers))))
-open Tezos_data_encoding))))
(alias
((name buildtest)
(deps (test_data_encoding.exe
test_stream_data_encoding.exe
(deps (test.exe
;; bench_data_encoding.exe
))))
(alias
((name runtest_stream_data_encoding)
(action (run ${exe:test_stream_data_encoding.exe}))))
(alias
((name runtest_data_encoding)
(action (run ${exe:test_data_encoding.exe}))))
(alias
((name runtest)
(deps ((alias runtest_data_encoding)
(alias runtest_stream_data_encoding)))))
(action (run ${exe:test.exe}))))
(alias
((name runtest_indent)

14
src/lib_test_helpers/test.mli → src/lib_data_encoding/test/test.ml
View File

@ -7,11 +7,9 @@
(* *)
(**************************************************************************)
module Make(Error : sig
type error
val pp_print_error: Format.formatter -> error list -> unit
end) : sig
val run : string -> (string * (string -> (unit, Error.error list) result Lwt.t)) list -> unit
end
let () =
Random.init 100 ;
Alcotest.run "tezos-data-encoding" [
"data_encoding", Test_data_encoding.tests ;
"stream_data_encoding", Test_stream_data_encoding.tests ;
]

178
src/lib_data_encoding/test/test_data_encoding.ml
View File

@ -8,24 +8,8 @@
(**************************************************************************)
open Utils.Infix
open Lwt.Infix
open Data_encoding
module Error = struct
type error = ..
let pp_print_error _ _ = ()
end
module Test = Test.Make(Error)
let (//) = Filename.concat
let write_file dir ~name content =
let file = (dir // name) in
let oc = open_out file in
output_string oc content ;
close_out oc ;
file
let is_invalid_arg = function
| Invalid_argument _ -> true
| _ -> false
@ -125,28 +109,11 @@ let test_simple_values _ =
test_bin_exn ~msg:__LOC__ (string_enum enum_enc) 7
(function
| No_case_matched -> true
| _ -> false) ;
(* Should fail *)
(* test_bin_exn ~msg:__LOC__ (string_enum ["a", 1; "a", 2]) 2 (...duplicatate...); *)
(* test_json_exn ~msg:__LOC__ (string_enum ["a", 1; "a", 2]) 1 (... duplicate...); *)
| _ -> false)
(* Should fail *)
(* test_bin_exn ~msg:__LOC__ (string_enum ["a", 1; "a", 2]) 2 (...duplicatate...); *)
(* test_json_exn ~msg:__LOC__ (string_enum ["a", 1; "a", 2]) 1 (... duplicate...); *)
Lwt.return_unit
(*
let test_json testdir =
let open Data_encoding_ezjsonm in
let file = testdir // "testing_data_encoding.tezos" in
let v = `Float 42. in
let f_str = to_string ~minify:false v in
Assert.equal_string ~msg:__LOC__ f_str "[\n 42\n]";
read_file (testdir // "NONEXISTINGFILE") >>= fun rf ->
Assert.is_error ~msg:__LOC__ rf ;
write_file file v >>= fun success ->
Assert.is_ok ~msg:__LOC__ success ;
read_file file >>= fun opt ->
Assert.is_ok ~msg:__LOC__ opt ;
Lwt.return ()
*)
type t = A of int | B of string | C of int | D of string | E
let prn_t = function
@ -178,8 +145,7 @@ let test_tag_errors _ =
(fun i -> Some i)] in
Assert.test_fail ~msg:__LOC__ invalid_tag
(function (Invalid_tag (_, `Uint8)) -> true
| _ -> false) ;
Lwt.return_unit
| _ -> false)
let test_union _ =
let enc =
@ -228,8 +194,7 @@ let test_union _ =
Assert.equal ~prn:prn_t ~msg:__LOC__ (A 1) (get_result ~msg:__LOC__ binA) ;
Assert.equal ~prn:prn_t ~msg:__LOC__ (B "2") (get_result ~msg:__LOC__ binB) ;
Assert.equal ~prn:prn_t ~msg:__LOC__ (C 3) (get_result ~msg:__LOC__ binC) ;
Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (get_result ~msg:__LOC__ binD) ;
Lwt.return_unit
Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (get_result ~msg:__LOC__ binD)
type s = { field : int }
@ -269,77 +234,7 @@ let test_splitted _ =
Assert.equal ~msg:__LOC__ "41" (Json.destruct enc jsonA);
Assert.equal ~msg:__LOC__ "42" (Json.destruct enc jsonB);
Assert.equal ~msg:__LOC__ "43" (get_result ~msg:__LOC__ binA);
Assert.equal ~msg:__LOC__ "44" (get_result ~msg:__LOC__ binB);
Lwt.return_unit
(*
let test_json_input testdir =
let enc =
obj1
(req "menu" (
obj3
(req "id" string)
(req "value" string)
(opt "popup" (
obj2
(req "width" int64)
(req "height" int64))))) in
begin
let file =
write_file testdir ~name:"good.json" {|
{
"menu": {
"id": "file",
"value": "File",
"popup": {
"width" : 42,
"height" : 52
}
}
}
|}
in
Lwt_utils_unix.Json.read_file file >>= function
| Error _ -> Assert.fail_msg "Cannot parse \"good.json\"."
| Ok json ->
let (id, value, popup) = Json.destruct enc json in
Assert.equal_string ~msg:__LOC__ "file" id;
Assert.equal_string ~msg:__LOC__ "File" value;
Assert.is_some ~msg:__LOC__ popup;
let w,h = match popup with None -> assert false | Some (w,h) -> w,h in
Assert.equal_int64 ~msg:__LOC__ 42L w;
Assert.equal_int64 ~msg:__LOC__ 52L h;
Lwt.return_unit
end >>= fun () ->
let enc =
obj2
(req "kind" (string))
(req "data" (int64)) in
begin
let file =
write_file testdir ~name:"unknown.json" {|
{
"kind" : "int64",
"data" : "42",
"unknown" : 2
}
|}
in
Lwt_utils_unix.Json.read_file file >>= function
| Error _ -> Assert.fail_msg "Cannot parse \"unknown.json\"."
| Ok json ->
Assert.test_fail ~msg:__LOC__
(fun () -> ignore (Json.destruct enc json))
(function
| Json.Unexpected_field "unknown" -> true
| _ -> false) ;
Lwt.return_unit
end
*)
let wrap_test f base_dir =
f base_dir >>= fun result ->
Lwt.return_ok result
Assert.equal ~msg:__LOC__ "44" (get_result ~msg:__LOC__ binB)
let test_wrapped_binary _ =
let open Data_encoding in
@ -356,31 +251,27 @@ let test_wrapped_binary _ =
let data = (Ok "") in
let encoded = Data_encoding.Binary.to_bytes enc data in
let decoded = Data_encoding.Binary.of_bytes_exn enc encoded in
Lwt.return @@ Assert.equal data decoded
Assert.equal data decoded
let test_out_of_range _ =
let assert_exception enc x =
let test_out_of_range () =
let assert_exception ~msg enc x =
begin try
ignore (Data_encoding.Json.construct enc x) ;
assert false
with Invalid_argument _ ->
Assert.is_true true
ignore (Data_encoding.Json.construct enc x : Data_encoding.json) ;
Assert.fail_msg "%s: json" msg
with Invalid_argument _ -> ()
end ;
begin
try
ignore (Data_encoding.Binary.to_bytes enc x) ;
assert false
with Invalid_argument _ ->
Assert.is_true true
Assert.fail_msg "%s: binary" msg
with Invalid_argument _ -> ()
end in
let enc_int = Data_encoding.ranged_int ~-30 100 in
let enc_float = Data_encoding.ranged_float ~-.30. 100. in
assert_exception enc_int 101 ;
assert_exception enc_int ~-32 ;
assert_exception enc_float ~-.31. ;
assert_exception enc_float 101. ;
assert_exception enc_float 100.1 ;
Lwt.return_unit
assert_exception ~msg: __LOC__ enc_int 101 ;
assert_exception ~msg: __LOC__ enc_int ~-32 ;
assert_exception ~msg: __LOC__ enc_float ~-.31. ;
assert_exception ~msg: __LOC__ enc_float 101.
let test_string_enum_boundary _ =
let open Data_encoding in
@ -394,8 +285,7 @@ let test_string_enum_boundary _ =
run_test entries ;
let entries2 = (("255", 255) :: entries) in
run_test entries2 ;
run_test (("256", 256) :: entries2) ;
Lwt.return_unit
run_test (("256", 256) :: entries2)
(** Generate encodings of the encoding and the randomized generator *)
let test_generator ?(iterations=50) encoding generator =
@ -404,8 +294,7 @@ let test_generator ?(iterations=50) encoding generator =
let bytes = Data_encoding.Binary.to_bytes encoding encode in
let decode = Data_encoding.Binary.of_bytes_exn encoding bytes in
Assert.equal encode decode
done ;
Lwt.return ()
done
let rec make_int_list acc len () =
if len = 0
@ -430,20 +319,15 @@ let test_randomized_variant_list _ =
(make_int_list [] 100 ()))
let tests = [
"simple", test_simple_values ;
(* "json", test_json ; *)
"union", test_union ;
"splitted", test_splitted ;
(* "json.input", test_json_input ; *)
"tags", test_tag_errors ;
"wrapped_binary", test_wrapped_binary ;
"out_of_range", test_out_of_range ;
"string_enum_boundary", test_string_enum_boundary ;
"randomized_int_list", test_randomized_int_list ;
"randomized_string_list", test_randomized_string_list ;
"randomized_variant_list", test_randomized_variant_list ;
"simple", `Quick, test_simple_values ;
"union", `Quick, test_union ;
"splitted", `Quick, test_splitted ;
"tags", `Quick, test_tag_errors ;
"wrapped_binary", `Quick, test_wrapped_binary ;
"out_of_range", `Quick, test_out_of_range ;
"string_enum_boundary", `Quick, test_string_enum_boundary ;
"randomized_int_list", `Quick, test_randomized_int_list ;
"randomized_string_list", `Quick, test_randomized_string_list ;
"randomized_variant_list", `Quick, test_randomized_variant_list ;
]
let () =
Random.init 100 ;
Test.run "data_encoding." (List.map (fun (s, f) -> s, wrap_test f) tests)

32
src/lib_data_encoding/test/test_stream_data_encoding.ml
View File

@ -7,17 +7,8 @@
(* *)
(**************************************************************************)
open Lwt.Infix
open Data_encoding
module Error = struct
type error = ..
let pp_print_error _ _ = ()
end
module Test = Test.Make(Error)
let (//) = Filename.concat
let is_invalid_arg = function
| Invalid_argument _ -> true
| _ -> false
@ -321,8 +312,6 @@ let test_simple_values _ =
["one", 1; "two", 2; "three", 3; "four", 4; "five", 6; "six", 6] in
test_simple ~msg:__LOC__ (string_enum enum_enc) 4;
Lwt.return_unit
type t = A of int | B of string | C of int | D of string | E
@ -391,8 +380,7 @@ let test_union _ =
Assert.equal ~prn:prn_t ~msg:__LOC__ (A 1) (get_result ~msg:__LOC__ binA) ;
Assert.equal ~prn:prn_t ~msg:__LOC__ (B "2") (get_result ~msg:__LOC__ binB) ;
Assert.equal ~prn:prn_t ~msg:__LOC__ (C 3) (get_result ~msg:__LOC__ binC) ;
Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (get_result ~msg:__LOC__ binD) ;
Lwt.return_unit
Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (get_result ~msg:__LOC__ binD)
type s = { field : int }
@ -442,20 +430,10 @@ let test_splitted _ =
Assert.equal ~msg:__LOC__ "41" (Json.destruct enc jsonA);
Assert.equal ~msg:__LOC__ "42" (Json.destruct enc jsonB);
Assert.equal ~msg:__LOC__ "43" (get_result ~msg:__LOC__ binA);
Assert.equal ~msg:__LOC__ "44" (get_result ~msg:__LOC__ binB);
Lwt.return_unit
let wrap_test f base_dir =
f base_dir >>= fun result ->
Lwt.return_ok result
Assert.equal ~msg:__LOC__ "44" (get_result ~msg:__LOC__ binB)
let tests = [
"simple", test_simple_values ;
"union", test_union ;
"splitted", test_splitted ;
"simple", `Quick, test_simple_values ;
"union", `Quick, test_union ;
"splitted", `Quick, test_splitted ;
]
let () =
Test.run "stream_data_encoding."
(List.map (fun (s, f) -> s, wrap_test f) tests)

2
src/lib_data_encoding/tezos-data-encoding.opam
View File

@ -9,12 +9,12 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"tezos-test-helpers" { test }
"tezos-stdlib"
"ezjsonm"
"js_of_ocaml" # for ocplib-json-typed.bson
"ocplib-json-typed"
"ocplib-endian"
"alcotest" { test }
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]

3
src/lib_p2p/test/jbuild
View File

@ -7,13 +7,12 @@
(libraries (tezos-base
tezos-stdlib-unix
tezos-p2p
tezos-test-helpers))
alcotest-lwt))
(flags (:standard -w -9-32
-linkall
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_stdlib_unix
-open Tezos_test_helpers
-open Tezos_p2p))))
(alias

170
src/lib_p2p/test/process.ml Normal file
View File

@ -0,0 +1,170 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Error_monad
let () = Lwt_unix.set_default_async_method Async_none
let section = Lwt_log.Section.make "process"
let log_f ~level format =
if level < Lwt_log.Section.level section then
Format.ikfprintf (fun _ -> Lwt.return_unit) Format.std_formatter format
else
Format.kasprintf (fun msg -> Lwt_log.log ~section ~level msg) format
let lwt_debug fmt = log_f ~level:Lwt_log.Debug fmt
let lwt_log_notice fmt = log_f ~level:Lwt_log.Notice fmt
let lwt_log_info fmt = log_f ~level:Lwt_log.Info fmt
let lwt_log_error fmt = log_f ~level:Lwt_log.Error fmt
exception Exited of int
exception Signaled of int
exception Stopped of int
let handle_error f =
Lwt.catch
f
(fun exn -> Lwt.return_error [Exn exn]) >>= function
| Ok () -> Lwt.return_unit
| Error err ->
lwt_debug "%a" pp_print_error err >>= fun () ->
exit 1
module Channel = struct
type ('a, 'b) t = (Lwt_io.input_channel * Lwt_io.output_channel)
let push (_, outch) v =
Lwt.catch
(fun () -> Lwt_io.write_value outch v >>= Lwt.return_ok)
(fun exn -> Lwt.return_error [Exn exn])
let pop (inch, _) =
Lwt.catch
(fun () -> Lwt_io.read_value inch >>= Lwt.return_ok)
(fun exn -> Lwt.return_error [Exn exn])
end
let wait pid =
Lwt.catch
(fun () ->
Lwt_unix.waitpid [] pid >>= function
| (_,Lwt_unix.WEXITED 0) ->
Lwt.return_ok ()
| (_,Lwt_unix.WEXITED n) ->
Lwt.return_error [Exn (Exited n)]
| (_,Lwt_unix.WSIGNALED n) ->
Lwt.return_error [Exn (Signaled n)]
| (_,Lwt_unix.WSTOPPED n) ->
Lwt.return_error [Exn (Stopped n)])
(function
| Lwt.Canceled ->
Unix.kill pid Sys.sigkill ;
Lwt.return_ok ()
| exn ->
Lwt.return_error [Exn exn])
type ('a, 'b) t = {
termination: unit tzresult Lwt.t ;
channel: ('b, 'a) Channel.t ;
}
let template = "$(date) - $(section): $(message)"
let detach ?(prefix = "") f =
Lwt_io.flush_all () >>= fun () ->
let main_in, child_out = Lwt_io.pipe () in
let child_in, main_out = Lwt_io.pipe () in
match Lwt_unix.fork () with
| 0 ->
Lwt_log.default :=
Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () ;
Random.self_init () ;
let template = Format.asprintf "%s$(message)" prefix in
Lwt_main.run begin
Lwt_io.close main_in >>= fun () ->
Lwt_io.close main_out >>= fun () ->
Lwt_log.default :=
Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () ;
lwt_log_notice "PID: %d" (Unix.getpid ()) >>= fun () ->
handle_error (fun () -> f (child_in, child_out))
end ;
exit 0
| pid ->
let termination = wait pid in
Lwt_io.close child_in >>= fun () ->
Lwt_io.close child_out >>= fun () ->
Lwt.return ({ termination ; channel = (main_in, main_out) })
let signal_name =
let names =
[ Sys.sigabrt, "ABRT" ;
Sys.sigalrm, "ALRM" ;
Sys.sigfpe, "FPE" ;
Sys.sighup, "HUP" ;
Sys.sigill, "ILL" ;
Sys.sigint, "INT" ;
Sys.sigkill, "KILL" ;
Sys.sigpipe, "PIPE" ;
Sys.sigquit, "QUIT" ;
Sys.sigsegv, "SEGV" ;
Sys.sigterm, "TERM" ;
Sys.sigusr1, "USR1" ;
Sys.sigusr2, "USR2" ;
Sys.sigchld, "CHLD" ;
Sys.sigcont, "CONT" ;
Sys.sigstop, "STOP" ;
Sys.sigtstp, "TSTP" ;
Sys.sigttin, "TTIN" ;
Sys.sigttou, "TTOU" ;
Sys.sigvtalrm, "VTALRM" ;
Sys.sigprof, "PROF" ;
Sys.sigbus, "BUS" ;
Sys.sigpoll, "POLL" ;
Sys.sigsys, "SYS" ;
Sys.sigtrap, "TRAP" ;
Sys.sigurg, "URG" ;
Sys.sigxcpu, "XCPU" ;
Sys.sigxfsz, "XFSZ" ] in
fun n -> List.assoc n names
let wait_all processes =
let rec loop processes =
match processes with
| [] -> Lwt.return_none
| processes ->
Lwt.nchoose_split processes >>= function
| (finished, remaining) ->
let rec handle = function
| [] -> loop remaining
| Ok () :: finished -> handle finished
| Error err :: _ ->
Lwt.return (Some (err, remaining)) in
handle finished in
loop (List.map (fun p -> p.termination) processes) >>= function
| None ->
lwt_log_info "All done!" >>= fun () ->
Lwt.return_ok ()
| Some ([Exn (Exited n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process finished with error %d !" n
| Some ([Exn (Signaled n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process was killed by a SIG%s !" (signal_name n)
| Some ([Exn (Stopped n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process was stopped by a SIG%s !" (signal_name n)
| Some (err, remaining) ->
lwt_log_error "@[<v 2>Unexpected error!@,%a@]"
pp_print_error err >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process finished with an unexpected error !"

30
src/lib_p2p/test/process.mli Normal file
View File

@ -0,0 +1,30 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Error_monad
exception Exited of int
module Channel : sig
type ('a, 'b) t
val push: ('a, 'b) t -> 'a -> unit tzresult Lwt.t
val pop: ('a, 'b) t -> 'b tzresult Lwt.t
end
type ('a, 'b) t = {
termination: unit tzresult Lwt.t ;
channel: ('b, 'a) Channel.t ;
}
val detach:
?prefix:string ->
(('a, 'b) Channel.t -> unit tzresult Lwt.t) ->
('a, 'b) t Lwt.t
val wait_all: ('a, 'b) t list -> unit tzresult Lwt.t

34
src/lib_p2p/test/test_p2p_io_scheduler.ml
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
module Process = Tezos_test_helpers.Process.Make(Error_monad)
include Logging.Make (struct let name = "test-p2p-io-scheduler" end)
exception Error of error list
@ -215,17 +213,25 @@ let () =
let usage_msg = "Usage: %s <num_peers>.\nArguments are:" in
Arg.parse spec anon_fun usage_msg
let wrap n f =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let () =
Sys.catch_break true ;
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "p2p.io-scheduler." [
"trivial-quota", (fun _dir ->
run
?display_client_stat:!display_client_stat
?max_download_speed:!max_download_speed
?max_upload_speed:!max_upload_speed
~read_buffer_size:!read_buffer_size
?read_queue_size:!read_queue_size
?write_queue_size:!write_queue_size
!addr !port !delay !clients)
Alcotest.run ~argv:[|""|] "tezos-p2p" [
"p2p.io-scheduler", [
wrap "trivial-quota" (fun () ->
run
?display_client_stat:!display_client_stat
?max_download_speed:!max_download_speed
?max_upload_speed:!max_upload_speed
~read_buffer_size:!read_buffer_size
?read_queue_size:!read_queue_size
?write_queue_size:!write_queue_size
!addr !port !delay !clients)
]
]

22
src/lib_p2p/test/test_p2p_pool.ml
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
module Process = Tezos_test_helpers.Process.Make(Error_monad)
include Logging.Make (struct let name = "test.p2p.connection-pool" end)
type message =
@ -279,19 +277,27 @@ let spec = Arg.[
]
let wrap n f =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
let anon_fun _num_peers = raise (Arg.Bad "No anonymous argument.") in
let usage_msg = "Usage: %s <num_peers>.\nArguments are:" in
Arg.parse spec anon_fun usage_msg ;
let ports = !port -- (!port + !clients - 1) in
let points = List.map (fun port -> !addr, port) ports in
Test.run "p2p-connection-pool." [
"simple", (fun _ -> Simple.run points) ;
"random", (fun _ -> Random_connections.run points !repeat_connections) ;
"garbled", (fun _ -> Garbled.run points) ;
Alcotest.run ~argv:[|""|] "tezos-p2p" [
"p2p-connection-pool", [
wrap "simple" (fun _ -> Simple.run points) ;
wrap "random" (fun _ -> Random_connections.run points !repeat_connections) ;
wrap "garbled" (fun _ -> Garbled.run points) ;
]
]
let () =
Sys.catch_break true ;
try main ()

37
src/lib_p2p/test/test_p2p_socket.ml
View File

@ -7,11 +7,6 @@
(* *)
(**************************************************************************)
(* TODO Use Kaputt on the client side and remove `assert` from the
server. *)
module Process = Tezos_test_helpers.Process.Make(Error_monad)
include Logging.Make (struct let name = "test.p2p.connection" end)
let default_addr = Ipaddr.V6.localhost
@ -403,22 +398,30 @@ let spec = Arg.[
]
let wrap n f =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let main () =
let module Test = Tezos_test_helpers.Process.Make(Error_monad) in
let anon_fun _num_peers = raise (Arg.Bad "No anonymous argument.") in
let usage_msg = "Usage: %s.\nArguments are:" in
Arg.parse spec anon_fun usage_msg ;
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "p2p-connection." [
"low-level", Low_level.run ;
"kick", Kick.run ;
"kicked", Kicked.run ;
"simple-message", Simple_message.run ;
"chunked-message", Chunked_message.run ;
"oversized-message", Oversized_message.run ;
"close-on-read", Close_on_read.run ;
"close-on-write", Close_on_write.run ;
"garbled-data", Garbled_data.run ;
Alcotest.run ~argv:[|""|] "tezos-p2p" [
"p2p-connection.", [
wrap "low-level" Low_level.run ;
wrap "kick" Kick.run ;
wrap "kicked" Kicked.run ;
wrap "simple-message" Simple_message.run ;
wrap "chunked-message" Chunked_message.run ;
wrap "oversized-message" Oversized_message.run ;
wrap "close-on-read" Close_on_read.run ;
wrap "close-on-write" Close_on_write.run ;
wrap "garbled-data" Garbled_data.run ;
]
]
let () =

2
src/lib_p2p/tezos-p2p.opam
View File

@ -9,9 +9,9 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"tezos-test-helpers" { test }
"tezos-base"
"tezos-stdlib-unix"
"alcotest-lwt" { test }
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]

50
src/lib_protocol_environment_client/test/assert.ml Normal file
View File

@ -0,0 +1,50 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let fail expected given msg =
Format.kasprintf Pervasives.failwith
"@[%s@ expected: %s@ got: %s@]" msg expected given
let fail_msg fmt = Format.kasprintf (fail "" "") fmt
let default_printer _ = ""
let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
if not (eq x y) then fail (prn x) (prn y) msg
let equal_string_option ?msg o1 o2 =
let prn = function
| None -> "None"
| Some s -> s in
equal ?msg ~prn o1 o2
let is_none ?(msg="") x =
if x <> None then fail "None" "Some _" msg
let make_equal_list eq prn ?(msg="") x y =
let rec iter i x y =
match x, y with
| hd_x :: tl_x, hd_y :: tl_y ->
if eq hd_x hd_y then
iter (succ i) tl_x tl_y
else
let fm = Printf.sprintf "%s (at index %d)" msg i in
fail (prn hd_x) (prn hd_y) fm
| _ :: _, [] | [], _ :: _ ->
let fm = Printf.sprintf "%s (lists of different sizes)" msg in
fail_msg "%s" fm
| [], [] ->
() in
iter 0 x y
let equal_string_list_list ?msg l1 l2 =
let pr_persist l =
let res =
String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
Printf.sprintf "[%s]" res in
make_equal_list ?msg (=) pr_persist l1 l2

13
src/lib_protocol_environment_client/test/jbuild
View File

@ -1,27 +1,22 @@
(jbuild_version 1)
(executables
((names (test_mem_context))
((names (test))
(libraries (tezos-base
tezos-protocol-environment-client
tezos-test-helpers))
alcotest-lwt))
(flags (:standard -w -9-32
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_protocol_environment_client))))
(alias
((name buildtest)
(deps (test_mem_context.exe))))
(alias
((name runtest_mem_context)
(action (run ${exe:test_mem_context.exe}))))
(deps (test.exe))))
(alias
((name runtest)
(deps ((alias runtest_mem_context)))))
(action (run ${exe:test.exe}))))
(alias
((name runtest_indent)

13
src/lib_protocol_environment_client/test/test.ml Normal file
View File

@ -0,0 +1,13 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let () =
Alcotest.run "tezos-protocol-environment-client" [
"mem_context", Test_mem_context.tests ;
]

13
src/lib_protocol_environment_client/test/test_mem_context.ml
View File

@ -34,13 +34,13 @@ type t = {
block3b: Mem_context.t ;
}
let wrap_context_init f _base_dir =
let wrap_context_init f _ () =
let genesis = Mem_context.empty in
create_block2 genesis >>= fun block2 ->
create_block3a block2 >>= fun block3a ->
create_block3b block2 >>= fun block3b ->
f { genesis; block2 ; block3a; block3b } >>= fun result ->
return result
Lwt.return result
(** Simple test *)
@ -135,7 +135,7 @@ let test_fold { genesis = ctxt } =
(******************************************************************************)
let tests : (string * (t -> unit Lwt.t)) list = [
let tests = [
"simple", test_simple ;
"continuation", test_continuation ;
"fork", test_fork ;
@ -143,6 +143,7 @@ let tests : (string * (t -> unit Lwt.t)) list = [
"fold", test_fold ;
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "context." (List.map (fun (s, f) -> s, wrap_context_init f) tests)
let tests =
List.map
(fun (n, f) -> Alcotest_lwt.test_case n `Quick (wrap_context_init f))
tests

2
src/lib_protocol_environment_client/tezos-protocol-environment-client.opam
View File

@ -12,7 +12,7 @@ depends: [
"tezos-base"
"tezos-micheline"
"tezos-protocol-environment-sigs"
"tezos-test-helpers" { test }
"alcotest-lwt" { test }
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]

41
src/lib_shell/test/assert.ml Normal file
View File

@ -0,0 +1,41 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let fail expected given msg =
Format.kasprintf Pervasives.failwith
"@[%s@ expected: %s@ got: %s@]" msg expected given
let fail_msg fmt = Format.kasprintf (fail "" "") fmt
let default_printer _ = ""
let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
if not (eq x y) then fail (prn x) (prn y) msg
let equal_operation ?msg op1 op2 =
let eq op1 op2 =
match op1, op2 with
| None, None -> true
| Some op1, Some op2 ->
Operation.equal op1 op2
| _ -> false in
let prn = function
| None -> "none"
| Some op -> Operation_hash.to_hex (Operation.hash op) in
equal ?msg ~prn ~eq op1 op2
let equal_block ?msg st1 st2 =
let eq st1 st2 =
match st1, st2 with
| None, None -> true
| Some st1, Some st2 -> Block_header.equal st1 st2
| _ -> false in
let prn = function
| None -> "none"
| Some st -> Block_hash.to_hex (Block_header.hash st) in
equal ?msg ~prn ~eq st1 st2

7
src/lib_shell/test/jbuild
View File

@ -8,14 +8,15 @@
tezos-protocol-updater
tezos-shell
tezos-embedded-protocol-demo
tezos-test-helpers))
tezos-stdlib-unix
alcotest-lwt))
(flags (:standard -w -9-32
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_storage
-open Tezos_protocol_updater
-open Tezos_shell))))
-open Tezos_shell
-open Tezos_stdlib_unix))))
(alias
((name buildtest)

22
src/lib_shell/test/test_locator.ml
View File

@ -311,10 +311,20 @@ let test_locator base_dir =
loop 1
let tests : (string * (string -> unit tzresult Lwt.t)) list =
[ "test pred", test_pred ]
let wrap n f =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
Lwt_utils_unix.with_tempdir "tezos_test_" begin fun dir ->
f dir >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
end
let bench = [ "test locator", test_locator ]
let tests =
[ wrap "test pred" test_pred ]
let bench = [ wrap "test locator" test_locator ]
let tests =
try
@ -324,6 +334,8 @@ let tests =
tests @ bench
with _ -> tests @ bench
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "state." tests
Alcotest.run ~argv:[|""|] "tezos-shell" [
"locator", tests
]

39
src/lib_shell/test/test_state.ml
View File

@ -58,30 +58,6 @@ let operation op =
op,
Data_encoding.Binary.to_bytes Operation.encoding op
let equal_operation ?msg op1 op2 =
let msg = Assert.format_msg msg in
let eq op1 op2 =
match op1, op2 with
| None, None -> true
| Some op1, Some op2 ->
Operation.equal op1 op2
| _ -> false in
let prn = function
| None -> "none"
| Some op -> Operation_hash.to_hex (Operation.hash op) in
Assert.equal ?msg ~prn ~eq op1 op2
let equal_block ?msg st1 st2 =
let msg = Assert.format_msg msg in
let eq st1 st2 =
match st1, st2 with
| None, None -> true
| Some st1, Some st2 -> Block_header.equal st1 st2
| _ -> false in
let prn = function
| None -> "none"
| Some st -> Block_hash.to_hex (Block_header.hash st) in
Assert.equal ?msg ~prn ~eq st1 st2
let block _state ?(context = Context_hash.zero) ?(operations = []) (pred: State.Block.t) name
: Block_header.t =
@ -447,6 +423,17 @@ let tests : (string * (state -> unit tzresult Lwt.t)) list = [
"find_new", test_find_new ;
]
let wrap (n, f) =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
Lwt_utils_unix.with_tempdir "tezos_test_" begin fun dir ->
wrap_state_init f dir >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
end
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "state." (List.map (fun (s, f) -> s, wrap_state_init f) tests)
Alcotest.run ~argv:[|""|] "tezos-shell" [
"state", List.map wrap tests
]

2
src/lib_shell/tezos-shell.opam
View File

@ -9,12 +9,12 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"tezos-test-helpers" { test }
"tezos-base"
"tezos-rpc-http"
"tezos-p2p"
"tezos-shell-services"
"tezos-protocol-updater"
"alcotest-lwt" { test }
"tezos-embedded-protocol-demo" { test }
]
build: [

3
src/lib_stdlib/mBytes.ml
View File

@ -103,3 +103,6 @@ let concat b1 b2 =
blit b2 0 b l1 l2 ;
b
let pp_hex ppf t =
let `Hex s = to_hex t in
Format.pp_print_string ppf s

2
src/lib_stdlib/mBytes.mli
View File

@ -157,3 +157,5 @@ val concat: t -> t -> t
val to_hex: t -> Hex.t
val of_hex: Hex.t -> t
val pp_hex: Format.formatter -> t -> unit

18
src/lib_stdlib/test/assert.ml Normal file
View File

@ -0,0 +1,18 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let fail expected given msg =
Format.kasprintf failwith
"@[%s@ expected: %s@ got: %s@]" msg expected given
let fail_msg fmt = Format.kasprintf (fail "" "") fmt
let default_printer _ = ""
let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
if not (eq x y) then fail (prn x) (prn y) msg

4
src/lib_stdlib/test/jbuild
View File

@ -5,10 +5,10 @@
test_mbytes_buffer
test_lwt_pipe))
(libraries (tezos-stdlib
tezos-test-helpers))
alcotest
lwt.unix))
(flags (:standard -w -9-32
-safe-string
-open Tezos_test_helpers
-open Tezos_stdlib))))
(alias

17
src/lib_stdlib/test/test_tzList.ml
View File

@ -7,12 +7,6 @@
(* *)
(**************************************************************************)
module Error = struct
type error = ..
let pp_print_error _ _ = ()
end
module Test = Tezos_test_helpers.Test.Make(Error)
let rec permut = function
| [] -> [[]]
| x :: xs ->
@ -48,12 +42,13 @@ let test_take_n _ =
end ;
ListLabels.iter (permut [1;2;3;3;4;5;5;5;6]) ~f:begin fun xs ->
Assert.equal ~msg:__LOC__ (TzList.take_n ~compare 5 xs) [4;5;5;5;6]
end ;
Lwt.return_ok ()
end
let tests : (string * (string -> (unit, Error.error list) result Lwt.t)) list = [
"take_n", test_take_n ;
let tests = [
"take_n", `Quick, test_take_n ;
]
let () =
Test.run "tzList." tests
Alcotest.run "stdlib" [
"tzList", tests ;
]

2
src/lib_stdlib/tezos-stdlib.opam
View File

@ -9,12 +9,12 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"tezos-test-helpers" { test }
"cstruct"
"hex"
"ocplib-endian"
"stringext"
"lwt"
"alcotest" { test }
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]

6
src/lib_stdlib_unix/lwt_utils_unix.ml
View File

@ -241,3 +241,9 @@ module Protocol = struct
(List.map (fun { name ; _ } -> String.capitalize_ascii name) p.components)
end
let with_tempdir name f =
let base_dir = Filename.temp_file name "" in
Lwt_unix.unlink base_dir >>= fun () ->
Lwt_unix.mkdir base_dir 0o700 >>= fun () ->
Lwt.finalize (fun () -> f base_dir) (fun () -> remove_dir base_dir)

2
src/lib_stdlib_unix/lwt_utils_unix.mli
View File

@ -25,6 +25,8 @@ val create_dir: ?perm:int -> string -> unit Lwt.t
val read_file: string -> string Lwt.t
val create_file: ?perm:int -> string -> string -> unit Lwt.t
val with_tempdir: string -> (string -> 'a Lwt.t) -> 'a Lwt.t
val safe_close: Lwt_unix.file_descr -> unit Lwt.t
val getaddrinfo:

1
src/lib_stdlib_unix/tezos-stdlib-unix.opam
View File

@ -9,7 +9,6 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"tezos-test-helpers" { test }
"tezos-base"
"lwt" { >= "3.0.0" }
"ipaddr"

79
src/lib_storage/test/assert.ml Normal file
View File

@ -0,0 +1,79 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let fail expected given msg =
Format.kasprintf Pervasives.failwith
"@[%s@ expected: %s@ got: %s@]" msg expected given
let fail_msg fmt = Format.kasprintf (fail "" "") fmt
let default_printer _ = ""
let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
if not (eq x y) then fail (prn x) (prn y) msg
let equal_string_option ?msg o1 o2 =
let prn = function
| None -> "None"
| Some s -> s in
equal ?msg ~prn o1 o2
let is_false ?(msg="") x =
if x then fail "false" "true" msg
let is_true ?(msg="") x =
if not x then fail "true" "false" msg
let is_none ?(msg="") x =
if x <> None then fail "None" "Some _" msg
let make_equal_list eq prn ?(msg="") x y =
let rec iter i x y =
match x, y with
| hd_x :: tl_x, hd_y :: tl_y ->
if eq hd_x hd_y then
iter (succ i) tl_x tl_y
else
let fm = Printf.sprintf "%s (at index %d)" msg i in
fail (prn hd_x) (prn hd_y) fm
| _ :: _, [] | [], _ :: _ ->
let fm = Printf.sprintf "%s (lists of different sizes)" msg in
fail_msg "%s" fm
| [], [] ->
() in
iter 0 x y
let equal_string_list ?msg l1 l2 =
make_equal_list ?msg (=) (fun x -> x) l1 l2
let equal_string_list_list ?msg l1 l2 =
let pr_persist l =
let res =
String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
Printf.sprintf "[%s]" res in
make_equal_list ?msg (=) pr_persist l1 l2
let equal_block_set ?msg set1 set2 =
let b1 = Block_hash.Set.elements set1
and b2 = Block_hash.Set.elements set2 in
make_equal_list ?msg
(fun h1 h2 -> Block_hash.equal h1 h2)
Block_hash.to_string
b1 b2
let equal_block_map ?msg ~eq map1 map2 =
let b1 = Block_hash.Map.bindings map1
and b2 = Block_hash.Map.bindings map2 in
make_equal_list ?msg
(fun (h1, b1) (h2, b2) -> Block_hash.equal h1 h2 && eq b1 b2)
(fun (h1, _) -> Block_hash.to_string h1)
b1 b2
let equal_block_hash_list ?msg l1 l2 =
let pr_block_hash = Block_hash.to_short_b58check in
make_equal_list ?msg Block_hash.equal pr_block_hash l1 l2

24
src/lib_storage/test/jbuild
View File

@ -1,34 +1,24 @@
(jbuild_version 1)
(executables
((names (test_context
test_store))
((names (test))
(libraries (tezos-base
tezos-storage
tezos-test-helpers))
tezos-stdlib-unix
alcotest-lwt))
(flags (:standard -w -9-32
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_storage))))
-open Tezos_storage
-open Tezos_stdlib_unix))))
(alias
((name buildtest)
(deps (test_context.exe
test_store.exe))))
(alias
((name runtest_context)
(action (run ${exe:test_context.exe}))))
(alias
((name runtest_store)
(action (run ${exe:test_store.exe}))))
(deps (test.exe))))
(alias
((name runtest)
(deps ((alias runtest_context)
(alias runtest_store)))))
(action (chdir ${ROOT} (run ${exe:test.exe})))))
(alias
((name runtest_indent)

14
src/lib_storage/test/test.ml Normal file
View File

@ -0,0 +1,14 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let () =
Alcotest.run "tezos-storage" [
"store", Test_store.tests ;
"context", Test_context.tests ;
]

34
src/lib_storage/test/test_context.ml
View File

@ -84,18 +84,20 @@ type t = {
block3b: Context_hash.t ;
}
let wrap_context_init f base_dir =
let root = base_dir // "context" in
Context.init ~root ?patch_context:None >>= fun idx ->
Context.commit_genesis idx
~net_id
~time:genesis_time
~protocol:genesis_protocol >>= fun genesis ->
create_block2 idx genesis >>= fun block2 ->
create_block3a idx block2 >>= fun block3a ->
create_block3b idx block2 >>= fun block3b ->
f { idx; genesis; block2 ; block3a; block3b } >>= fun result ->
Error_monad.return result
let wrap_context_init f _ () =
Lwt_utils_unix.with_tempdir "tezos_test_" begin fun base_dir ->
let root = base_dir // "context" in
Context.init ~root ?patch_context:None >>= fun idx ->
Context.commit_genesis idx
~net_id
~time:genesis_time
~protocol:genesis_protocol >>= fun genesis ->
create_block2 idx genesis >>= fun block2 ->
create_block3a idx block2 >>= fun block3a ->
create_block3b idx block2 >>= fun block3b ->
f { idx; genesis; block2 ; block3a; block3b } >>= fun result ->
Lwt.return result
end
(** Simple test *)
@ -218,6 +220,8 @@ let tests : (string * (t -> unit Lwt.t)) list = [
"fold", test_fold ;
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "context." (List.map (fun (s, f) -> s, wrap_context_init f) tests)
let tests =
List.map
(fun (s, f) -> Alcotest_lwt.test_case s `Quick (wrap_context_init f))
tests

101
src/lib_storage/test/test_store.ml
View File

@ -28,25 +28,29 @@ let genesis_time =
(** *)
let wrap_store_init f base_dir =
let root = base_dir // "store" in
Store.init root >>= function
| Ok store ->
f store >>= fun () ->
return ()
| Error err ->
Format.kasprintf Pervasives.failwith
"@[Cannot initialize store:@ %a@]" pp_print_error err
let wrap_store_init f _ () =
Lwt_utils_unix.with_tempdir "tezos_test_" begin fun base_dir ->
let root = base_dir // "store" in
Store.init root >>= function
| Ok store ->
f store >>= fun () ->
Lwt.return ()
| Error err ->
Format.kasprintf Pervasives.failwith
"@[Cannot initialize store:@ %a@]" pp_print_error err
end
let wrap_raw_store_init f base_dir =
let root = base_dir // "store" in
Raw_store.init root >>= function
| Ok store ->
f store >>= fun () ->
return ()
| Error err ->
Format.kasprintf Pervasives.failwith
"@[Cannot initialize store:@ %a@]" pp_print_error err
let wrap_raw_store_init f _ () =
Lwt_utils_unix.with_tempdir "tezos_test_" begin fun base_dir ->
let root = base_dir // "store" in
Raw_store.init root >>= function
| Ok store ->
f store >>= fun () ->
Lwt.return ()
| Error err ->
Format.kasprintf Pervasives.failwith
"@[Cannot initialize store:@ %a@]" pp_print_error err
end
let test_init _ = Lwt.return_unit
@ -202,15 +206,6 @@ let test_generic_list (type t)
open Store_helpers
let equal_block_set ?msg set1 set2 =
let msg = Assert.format_msg msg in
let b1 = Block_hash.Set.elements set1
and b2 = Block_hash.Set.elements set2 in
Assert.make_equal_list ?msg
(fun h1 h2 -> Block_hash.equal h1 h2)
Block_hash.to_string
b1 b2
let test_hashset (type t)
(module Store: Store_sigs.STORE with type t = t) (s: Store.t) =
let module BlockSet = Block_hash.Set in
@ -222,34 +217,25 @@ let test_hashset (type t)
let bhset : BlockSet.t = BlockSet.add bh2 (BlockSet.add bh1 BlockSet.empty) in
StoreSet.store_all s bhset >>= fun () ->
StoreSet.read_all s >>= fun bhset' ->
equal_block_set ~msg:__LOC__ bhset bhset' ;
Assert.equal_block_set ~msg:__LOC__ bhset bhset' ;
let bhset2 =
Pervasives.(bhset |> BlockSet.add bh3 |> BlockSet.remove bh1) in
StoreSet.store_all s bhset2 >>= fun () ->
StoreSet.read_all s >>= fun bhset2' ->
equal_block_set ~msg:__LOC__ bhset2 bhset2' ;
Assert.equal_block_set ~msg:__LOC__ bhset2 bhset2' ;
StoreSet.fold s ~init:BlockSet.empty
~f:(fun bh acc -> Lwt.return (BlockSet.add bh acc)) >>= fun bhset2'' ->
equal_block_set ~msg:__LOC__ bhset2 bhset2'' ;
Assert.equal_block_set ~msg:__LOC__ bhset2 bhset2'' ;
Store.store s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
StoreSet.remove_all s >>= fun () ->
StoreSet.read_all s >>= fun empty ->
equal_block_set ~msg:__LOC__ BlockSet.empty empty ;
Assert.equal_block_set ~msg:__LOC__ BlockSet.empty empty ;
check (module Store) s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
Lwt.return_unit
(** HashMap *)
let equal_block_map ?msg ~eq map1 map2 =
let msg = Assert.format_msg msg in
let b1 = Block_hash.Map.bindings map1
and b2 = Block_hash.Map.bindings map2 in
Assert.make_equal_list ?msg
(fun (h1, b1) (h2, b2) -> Block_hash.equal h1 h2 && eq b1 b2)
(fun (h1, _) -> Block_hash.to_string h1)
b1 b2
let test_hashmap (type t)
(module Store: Store_sigs.STORE with type t = t) (s: Store.t) =
let module BlockMap = Block_hash.Map in
@ -269,12 +255,12 @@ let test_hashmap (type t)
BlockMap.add bh1 (1, 'a') |> BlockMap.add bh2 (2, 'b')) in
StoreMap.store_all s map >>= fun () ->
StoreMap.read_all s >>= fun map' ->
equal_block_map ~msg:__LOC__ ~eq map map' ;
Assert.equal_block_map ~msg:__LOC__ ~eq map map' ;
let map2 =
Pervasives.(map |> BlockMap.add bh3 (3, 'c') |> BlockMap.remove bh1) in
StoreMap.store_all s map2 >>= fun () ->
StoreMap.read_all s >>= fun map2' ->
equal_block_map ~msg:__LOC__ ~eq map2 map2' ;
Assert.equal_block_map ~msg:__LOC__ ~eq map2 map2' ;
Lwt.return_unit
(** Functors *)
@ -328,11 +314,6 @@ module SubBlocksMap =
end))
(Block_hash.Map)
let equal_block_hash_list ?msg l1 l2 =
let msg = Assert.format_msg msg in
let pr_block_hash = Block_hash.to_short_b58check in
Assert.make_equal_list ?msg Block_hash.equal pr_block_hash l1 l2
let test_subblock s =
SubBlocksSet.known s bh1 >>= fun known ->
Assert.is_false ~msg:__LOC__ known ;
@ -345,7 +326,7 @@ let test_subblock s =
Block_hash.Set.empty
|> Block_hash.Set.add bh1
|> Block_hash.Set.add bh2 in
equal_block_set ~msg:__LOC__ set set' ;
Assert.equal_block_set ~msg:__LOC__ set set' ;
SubBlocksSet.remove s bh2 >>= fun () ->
let set =
Block_hash.Set.empty
@ -353,13 +334,13 @@ let test_subblock s =
|> Block_hash.Set.add bh3 in
SubBlocksSet.store_all s set >>= fun () ->
SubBlocksSet.elements s >>= fun elts ->
equal_block_hash_list ~msg:__LOC__
Assert.equal_block_hash_list ~msg:__LOC__
(List.sort Block_hash.compare elts)
(List.sort Block_hash.compare [bh3 ; bh3']) ;
SubBlocksSet.store s bh2 >>= fun () ->
SubBlocksSet.remove s bh3 >>= fun () ->
SubBlocksSet.elements s >>= fun elts ->
equal_block_hash_list ~msg:__LOC__
Assert.equal_block_hash_list ~msg:__LOC__
(List.sort Block_hash.compare elts)
(List.sort Block_hash.compare [bh2 ; bh3']) ;
SubBlocksMap.known s bh1 >>= fun known ->
@ -377,19 +358,19 @@ let test_subblock s =
|> Block_hash.Map.add bh1 v1
|> Block_hash.Map.add bh2 v2 in
SubBlocksMap.read_all s >>= fun map' ->
equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
Assert.equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
SubBlocksSet.remove_all s >>= fun () ->
SubBlocksSet.elements s >>= fun elts ->
equal_block_hash_list ~msg:__LOC__ elts [] ;
Assert.equal_block_hash_list ~msg:__LOC__ elts [] ;
SubBlocksMap.read_all s >>= fun map' ->
equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
Assert.equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
SubBlocksSet.store s bh3 >>= fun () ->
SubBlocks.indexes s >>= fun keys ->
equal_block_hash_list ~msg:__LOC__
Assert.equal_block_hash_list ~msg:__LOC__
(List.sort Block_hash.compare keys)
(List.sort Block_hash.compare [bh1;bh2;bh3]) ;
@ -450,8 +431,10 @@ let tests : (string * (Store.t -> unit Lwt.t)) list = [
"block", test_block ;
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "store."
(List.map (fun (s, f) -> s, wrap_raw_store_init f) tests_raw @
List.map (fun (s, f) -> s, wrap_store_init f) tests)
let tests =
List.map
(fun (s, f) -> Alcotest_lwt.test_case s `Quick (wrap_raw_store_init f))
tests_raw @
List.map
(fun (s, f) -> Alcotest_lwt.test_case s `Quick (wrap_store_init f))
tests

3
src/lib_storage/tezos-storage.opam
View File

@ -9,10 +9,11 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"tezos-test-helpers" { test }
"tezos-base"
"leveldb"
"irmin-leveldb"
"tezos-stdlib-unix" { test }
"alcotest-lwt" { test }
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]

75
src/lib_test_helpers/assert.ml
View File

@ -1,75 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include Kaputt.Assertion
module Assert = Kaputt.Abbreviations.Assert
let format_msg = function None -> None | Some msg -> Some (msg ^ "\n")
let is_error ?(msg="") = function
| Error _ -> ()
| Ok _ -> fail "Error _" "Ok _" msg
let is_ok ?(msg="") = function
| Ok _ -> ()
| Error _ -> fail "Ok _" "Error _" msg
let equal_string_list_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_list ?msg l1 l2 =
let msg = format_msg msg in
Assert.make_equal_list ?msg (=) (fun x -> x) 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_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 _, Error _ | Error _, Ok _ ->
Assert.fail_msg "Results are not the same"
let equal_exn ?msg exn1 exn2 =
let msg = format_msg msg in
let prn = Printexc.to_string in
Assert.equal ?msg ~prn exn1 exn2
let test_fail ?(msg = "") ?(prn = Assert.default_printer) f may_fail =
try
let value = f () in
fail "any exception" ("no exception: " ^ prn value) msg
with exn ->
if not (may_fail exn) then
fail "exception"
(Printf.sprintf "unexpectec exception: %s" (Printexc.to_string exn))
msg
let fail_msg fmt =
Format.kasprintf Assert.fail_msg fmt
let fail expected given fmt =
Format.kasprintf (Assert.fail expected given) fmt
let equal_float ?eq ?prn ?msg f1 f2 =
match classify_float f1, classify_float f2 with
| FP_nan, FP_nan -> ()
| _ -> equal ?eq ?prn ?msg f1 f2

44
src/lib_test_helpers/assert.mli
View File

@ -1,44 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include module type of Kaputt.Assertion
val format_msg : string option -> string option
val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a
val fail : string -> string -> ('a, Format.formatter, unit, 'b) format4 -> 'a
val equal_string_list :
?msg:string -> string list -> string list -> unit
val equal_string_list_list :
?msg:string -> string list list -> string list list -> unit
val equal_string_option : ?msg:string -> string option -> string 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
val equal_exn : ?msg:string -> exn -> exn -> unit
val test_fail :
?msg:string ->
?prn:('a -> string) ->
(unit -> 'a) ->
(exn -> bool) ->
unit
val equal_float:
?eq:(float -> float -> bool) ->
?prn:(float -> string) -> ?msg:string -> float -> float -> unit

13
src/lib_test_helpers/jbuild
View File

@ -1,13 +0,0 @@
(jbuild_version 1)
(library
((name tezos_test_helpers)
(public_name tezos-test-helpers)
(libraries (lwt.unix kaputt))
(modules (:standard))
(flags (:standard -w -9-32 -safe-string))))
(alias
((name runtest_indent)
(deps ((glob_files *.ml*)))
(action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))

186
src/lib_test_helpers/process.ml
View File

@ -1,186 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Lwt.Infix
let () = Lwt_unix.set_default_async_method Async_none
module Make(Error : sig
type error
type error += Exn of exn
type 'a tzresult = ('a, error list) result
val pp_print_error: Format.formatter -> error list -> unit
val error_exn: exn -> ('a, error list) result
val join: unit tzresult Lwt.t list -> unit tzresult Lwt.t
val failwith:
('a, Format.formatter, unit, 'b tzresult Lwt.t) format4 ->
'a
end) = struct
open Error
let section = Lwt_log.Section.make "process"
let log_f ~level format =
if level < Lwt_log.Section.level section then
Format.ikfprintf (fun _ -> Lwt.return_unit) Format.std_formatter format
else
Format.kasprintf (fun msg -> Lwt_log.log ~section ~level msg) format
let lwt_debug fmt = log_f ~level:Lwt_log.Debug fmt
let lwt_log_notice fmt = log_f ~level:Lwt_log.Notice fmt
let lwt_log_info fmt = log_f ~level:Lwt_log.Info fmt
let lwt_log_error fmt = log_f ~level:Lwt_log.Error fmt
exception Exited of int
exception Signaled of int
exception Stopped of int
let handle_error f =
Lwt.catch
f
(fun exn -> Lwt.return_error [Exn exn]) >>= function
| Ok () -> Lwt.return_unit
| Error err ->
lwt_debug "%a" pp_print_error err >>= fun () ->
exit 1
module Channel = struct
type ('a, 'b) t = (Lwt_io.input_channel * Lwt_io.output_channel)
let push (_, outch) v =
Lwt.catch
(fun () -> Lwt_io.write_value outch v >>= Lwt.return_ok)
(fun exn -> Lwt.return_error [Exn exn])
let pop (inch, _) =
Lwt.catch
(fun () -> Lwt_io.read_value inch >>= Lwt.return_ok)
(fun exn -> Lwt.return_error [Exn exn])
end
let wait pid =
Lwt.catch
(fun () ->
Lwt_unix.waitpid [] pid >>= function
| (_,Lwt_unix.WEXITED 0) ->
Lwt.return_ok ()
| (_,Lwt_unix.WEXITED n) ->
Lwt.return_error [Exn (Exited n)]
| (_,Lwt_unix.WSIGNALED n) ->
Lwt.return_error [Exn (Signaled n)]
| (_,Lwt_unix.WSTOPPED n) ->
Lwt.return_error [Exn (Stopped n)])
(function
| Lwt.Canceled ->
Unix.kill pid Sys.sigkill ;
Lwt.return_ok ()
| exn ->
Lwt.return_error [Exn exn])
type ('a, 'b) t = {
termination: unit tzresult Lwt.t ;
channel: ('b, 'a) Channel.t ;
}
let template = "$(date) - $(section): $(message)"
let detach ?(prefix = "") f =
Lwt_io.flush_all () >>= fun () ->
let main_in, child_out = Lwt_io.pipe () in
let child_in, main_out = Lwt_io.pipe () in
match Lwt_unix.fork () with
| 0 ->
Lwt_log.default :=
Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () ;
Random.self_init () ;
let template = Format.asprintf "%s$(message)" prefix in
Lwt_main.run begin
Lwt_io.close main_in >>= fun () ->
Lwt_io.close main_out >>= fun () ->
Lwt_log.default :=
Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () ;
lwt_log_notice "PID: %d" (Unix.getpid ()) >>= fun () ->
handle_error (fun () -> f (child_in, child_out))
end ;
exit 0
| pid ->
let termination = wait pid in
Lwt_io.close child_in >>= fun () ->
Lwt_io.close child_out >>= fun () ->
Lwt.return ({ termination ; channel = (main_in, main_out) })
let signal_name =
let names =
[ Sys.sigabrt, "ABRT" ;
Sys.sigalrm, "ALRM" ;
Sys.sigfpe, "FPE" ;
Sys.sighup, "HUP" ;
Sys.sigill, "ILL" ;
Sys.sigint, "INT" ;
Sys.sigkill, "KILL" ;
Sys.sigpipe, "PIPE" ;
Sys.sigquit, "QUIT" ;
Sys.sigsegv, "SEGV" ;
Sys.sigterm, "TERM" ;
Sys.sigusr1, "USR1" ;
Sys.sigusr2, "USR2" ;
Sys.sigchld, "CHLD" ;
Sys.sigcont, "CONT" ;
Sys.sigstop, "STOP" ;
Sys.sigtstp, "TSTP" ;
Sys.sigttin, "TTIN" ;
Sys.sigttou, "TTOU" ;
Sys.sigvtalrm, "VTALRM" ;
Sys.sigprof, "PROF" ;
Sys.sigbus, "BUS" ;
Sys.sigpoll, "POLL" ;
Sys.sigsys, "SYS" ;
Sys.sigtrap, "TRAP" ;
Sys.sigurg, "URG" ;
Sys.sigxcpu, "XCPU" ;
Sys.sigxfsz, "XFSZ" ] in
fun n -> List.assoc n names
let wait_all processes =
let rec loop processes =
match processes with
| [] -> Lwt.return_none
| processes ->
Lwt.nchoose_split processes >>= function
| (finished, remaining) ->
let rec handle = function
| [] -> loop remaining
| Ok () :: finished -> handle finished
| Error err :: _ ->
Lwt.return (Some (err, remaining)) in
handle finished in
loop (List.map (fun p -> p.termination) processes) >>= function
| None ->
lwt_log_info "All done!" >>= fun () ->
Lwt.return_ok ()
| Some ([Exn (Exited n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process finished with error %d !" n
| Some ([Exn (Signaled n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process was killed by a SIG%s !" (signal_name n)
| Some ([Exn (Stopped n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process was stopped by a SIG%s !" (signal_name n)
| Some (err, remaining) ->
lwt_log_error "@[<v 2>Unexpected error!@,%a@]"
pp_print_error err >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process finished with an unexpected error !"
end

44
src/lib_test_helpers/process.mli
View File

@ -1,44 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Make(Error : sig
type error
type error += Exn of exn
type 'a tzresult = ('a, error list) result
val pp_print_error: Format.formatter -> error list -> unit
val error_exn: exn -> ('a, error list) result
val join: unit tzresult Lwt.t list -> unit tzresult Lwt.t
val failwith:
('a, Format.formatter, unit, 'b tzresult Lwt.t) format4 ->
'a
end) : sig
open Error
exception Exited of int
module Channel : sig
type ('a, 'b) t
val push: ('a, 'b) t -> 'a -> unit tzresult Lwt.t
val pop: ('a, 'b) t -> 'b tzresult Lwt.t
end
type ('a, 'b) t = {
termination: unit tzresult Lwt.t ;
channel: ('b, 'a) Channel.t ;
}
val detach:
?prefix:string ->
(('a, 'b) Channel.t -> unit tzresult Lwt.t) ->
('a, 'b) t Lwt.t
val wait_all: ('a, 'b) t list -> unit tzresult Lwt.t
end

170
src/lib_test_helpers/test.ml
View File

@ -1,170 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Make(Error : sig
type error
val pp_print_error: Format.formatter -> error list -> unit
end) = struct
module Test = Kaputt.Abbreviations.Test
let keep_dir = try ignore (Sys.getenv "KEEPDIR") ; true with _ -> false
let rec remove_dir dir =
if Sys.file_exists dir then begin
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
end
let output name res =
let open Kaputt in
let open Test in
let out = stderr in
match res with
| Passed ->
Printf.fprintf out "Test '%s' ... passed\n" name
| Failed { Assertion.expected_value = "" ; actual_value = "" ; message } ->
Printf.fprintf out "Test '%s' ... failed\n %s \n" name message
| Failed { Assertion.expected_value ; actual_value ; message = "" } ->
if expected_value <> actual_value then
Printf.fprintf out
"Test '%s' ... failed\n expected `%s` but received `%s`\n"
name
expected_value
actual_value
else
Printf.fprintf out
"Test '%s' ... failed\n expected anything excluding `%s` \
but received `%s`\n"
name
expected_value
actual_value
| Failed { Assertion.expected_value ; actual_value ; message } ->
if expected_value <> actual_value then
Printf.fprintf out
"Test '%s' ... failed\n %s (expected `%s` but received `%s`)\n"
name
message
expected_value
actual_value
else
Printf.fprintf out
"Test '%s' ... failed\n %s (expected anything excluding `%s` \
but received `%s`)\n"
name
message
expected_value
actual_value
| Uncaught (e, bt) ->
Printf.fprintf out
"Test '%s' ... raised an exception\n %s\n%s\n"
name (Printexc.to_string e) bt
| Report (valid, total, uncaught, counterexamples, categories) ->
Printf.fprintf out
"Test '%s' ... %d/%d case%s passed%s\n"
name
valid
total
(if valid > 1 then "s" else "")
(match uncaught with
| 0 -> ""
| 1 -> " (1 uncaught exception)"
| n -> " (" ^ (string_of_int n) ^ " uncaught exceptions)");
if counterexamples <> [] then
Printf.fprintf out " counterexample%s: %s\n"
(if (List.length counterexamples) > 1 then "s" else "")
(String.concat ", " counterexamples);
if (List.length categories) > 1 then begin
Printf.fprintf out " categories:\n";
List.iter
(fun (c, n) ->
Printf.fprintf out
" %s -> %d occurrence%s\n"
c n (if n > 1 then "s" else ""))
categories
end
| Exit_code c ->
Printf.fprintf out "Test '%s' ... returned code %d\n" name c
let run prefix tests =
let tests =
List.map
(fun (title, f) ->
let base_dir = Filename.temp_file "tezos_test_" "" in
Unix.unlink base_dir ;
Unix.mkdir base_dir 0o777 ;
let title = prefix ^ title in
title,
Test.make_simple_test
~title
(fun () ->
let finalise () =
if keep_dir then
Format.eprintf "Kept data dir %s@." base_dir
else
remove_dir base_dir
in
try
match Lwt_main.run (f base_dir) with
| Ok () -> finalise ()
| Error err ->
finalise () ;
Format.kasprintf
(fun message ->
raise @@
Kaputt.Assertion.Failed
{ expected_value = "" ;
actual_value = "" ;
message })
"%a" Error.pp_print_error err
with exn ->
finalise () ;
raise exn))
tests in
let passed = ref 0 in
let failed = ref 0 in
let uncaught = ref 0 in
let total = ref 0 in
List.iter
(fun (title, test) ->
let res = Test.exec_test test in
begin
match res with
| Passed ->
incr passed;
incr total
| Failed _ ->
incr failed;
incr total
| Uncaught _ ->
incr uncaught;
incr total
| Report (pass, tot, unc, _, _) ->
passed := !passed + pass;
failed := !failed + (tot - pass -unc);
uncaught := !uncaught + unc;
total := !total + tot
| Exit_code c ->
incr (if c = 0 then passed else failed);
incr total
end ;
output title res ;
flush stderr)
tests ;
Format.eprintf "SUMMARY: %d/%d passed (%.2f%%) -- %d failed, \
%d uncaught exceptions.@."
!passed !total (float_of_int !passed *. 100. /. float_of_int !total)
!failed !uncaught ;
if !total <> !passed then exit 1
end

20
src/lib_test_helpers/tezos-test-helpers.opam
View File

@ -1,20 +0,0 @@
opam-version: "1.2"
version: "dev"
maintainer: "contact@tezos.com"
authors: [ "Tezos devteam" ]
homepage: "https://www.tezos.com/"
bug-reports: "https://gitlab.com/tezos/tezos/issues"
dev-repo: "https://gitlab.com/tezos/tezos.git"
license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"lwt"
"kaputt"
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]
]
build-test: [
[ "jbuilder" "runtest" "-p" name "-j" jobs ]
]

3
src/proto_alpha/lib_client/test/jbuild
View File

@ -12,10 +12,9 @@
tezos-client-base
tezos-client-genesis
tezos-client-alpha
tezos-test-helpers))
alcotest-lwt))
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_rpc_http
-open Tezos_shell_services
-open Tezos_client_base

0
src/lib_test_helpers/node_helpers.ml → src/proto_alpha/lib_client/test/node_helpers.ml
View File

0
src/lib_test_helpers/node_helpers.mli → src/proto_alpha/lib_client/test/node_helpers.mli
View File

36
src/proto_alpha/lib_client/test/proto_alpha_helpers.ml
View File

@ -264,10 +264,20 @@ end
module Assert = struct
include Assert
let fail expected given msg =
Format.kasprintf Pervasives.failwith
"@[%s@ expected: %s@ got: %s@]" msg expected given
let fail_msg fmt = Format.kasprintf (fail "" "") fmt
let default_printer _ = ""
let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
if not (eq x y) then fail (prn x) (prn y) msg
let make_equal e p = equal ~eq:e ~prn:p
let equal_bool = make_equal (=) string_of_bool
let equal_int = make_equal (=) string_of_int
let equal_pkh ?msg pkh1 pkh2 =
let msg = Assert.format_msg msg in
let eq pkh1 pkh2 =
match pkh1, pkh2 with
| None, None -> true
@ -277,13 +287,12 @@ module Assert = struct
let prn = function
| None -> "none"
| Some pkh -> Ed25519.Public_key_hash.to_hex pkh in
Assert.equal ?msg ~prn ~eq pkh1 pkh2
equal ?msg ~prn ~eq pkh1 pkh2
let equal_tez ?msg tz1 tz2 =
let msg = Assert.format_msg msg in
let eq tz1 tz2 = Int64.equal (Tez.to_mutez tz1) (Tez.to_mutez tz2) in
let prn = Tez.to_string in
Assert.equal ?msg ~prn ~eq tz1 tz2
equal ?msg ~prn ~eq tz1 tz2
let balance_equal ?block ~msg account expected_balance =
Account.balance ?block account >>=? fun actual_balance ->
@ -305,10 +314,10 @@ module Assert = struct
let hash op = Tezos_base.Operation.hash op
let contain_error ?(msg="") ~f = function
| Ok _ -> Kaputt.Abbreviations.Assert.fail "Error _" "Ok _" msg
| Ok _ -> fail "Error _" "Ok _" msg
| Error error when not (List.exists f error) ->
let error_str = Format.asprintf "%a" Error_monad.pp_print_error error in
Kaputt.Abbreviations.Assert.fail "" error_str msg
fail "" error_str msg
| _ -> ()
let failed_to_preapply ~msg ?op f =
@ -389,8 +398,8 @@ module Assert = struct
let check_protocol ?msg ~block h =
Block_services.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto ->
return @@ Assert.equal
?msg:(Assert.format_msg msg)
return @@ equal
?msg
~prn:Protocol_hash.to_b58check
~eq:Protocol_hash.equal
block_proto h
@ -398,10 +407,15 @@ module Assert = struct
let check_voting_period_kind ?msg ~block kind =
Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.http_ctxt !rpc_config) block
>>=? fun current_kind ->
return @@ Assert.equal
?msg:(Assert.format_msg msg)
return @@ equal
?msg
current_kind kind
let is_none ?(msg="") x =
if x <> None then fail "None" "Some _" msg
let is_some ?(msg="") x =
if x = None then fail "Some _" "None" msg
end
module Baking = struct

10
src/proto_alpha/lib_client/test/proto_alpha_helpers.mli
View File

@ -146,7 +146,15 @@ end
module Assert : sig
include module type of Assert
val fail : string -> string -> string -> 'a
val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a
val equal : ?eq:('a -> 'a -> bool) -> ?prn:('a -> string) -> ?msg:string -> 'a -> 'a -> unit
val is_none : ?msg:string -> 'a option -> unit
val is_some : ?msg:string -> 'a option -> unit
val equal_int : ?msg:string -> int -> int -> unit
val equal_bool : ?msg:string -> bool -> bool -> unit
val balance_equal:
?block:Block_services.block ->

13
src/proto_alpha/lib_client/test/test_endorsement.ml
View File

@ -253,6 +253,15 @@ let tests = [
"main", (fun _ -> main ()) ;
]
let wrap (n, f) =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "endorsement." tests
Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
"endorsement", List.map wrap tests
]

13
src/proto_alpha/lib_client/test/test_michelson_parser.ml
View File

@ -429,6 +429,15 @@ let tests = [
"rnd-tez-litterals", (fun _ -> test_random_tez_litterals ()) ;
]
let wrap (n, f) =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "michelson." tests
Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
"michelson", List.map wrap tests
]

14
src/proto_alpha/lib_client/test/test_origination.ml
View File

@ -99,6 +99,16 @@ let tests = [
"main", (fun _ -> main ()) ;
]
let wrap (n, f) =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "origination." tests
Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
"origination", List.map wrap tests
]

13
src/proto_alpha/lib_client/test/test_transaction.ml
View File

@ -110,6 +110,15 @@ let tests = [
"main", (fun _ -> main ()) ;
]
let wrap (n, f) =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "transactions." tests
Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
"transactions", List.map wrap tests
]

13
src/proto_alpha/lib_client/test/test_vote.ml
View File

@ -98,6 +98,15 @@ let tests = [
"change_to_demo_proto", (fun _ -> change_to_demo_proto ()) ;
]
let wrap (n, f) =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "amendment." tests
Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
"amendment", List.map wrap tests
]

3
src/proto_alpha/lib_client/tezos-client-alpha.opam
View File

@ -9,15 +9,14 @@ license: "unreleased"
depends: [
"ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" }
"tezos-test-helpers" { test }
"tezos-base"
"tezos-protocol-environment-client"
"tezos-protocol-alpha"
"tezos-shell-services"
"tezos-client-base"
"tezos-test-helpers" { test }
"tezos-node" { test }
"tezos-client-genesis" { test }
"alcotest-lwt" { test }
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]

42
src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml
View File

@ -7,9 +7,38 @@
(* *)
(**************************************************************************)
include Assert
open Proto_alpha
open Tezos_context
open Proto_alpha.Tezos_context
module Assert = struct
let fail expected given msg =
Format.kasprintf Pervasives.failwith
"@[%s@ expected: %s@ got: %s@]" msg expected given
let fail_msg fmt = Format.kasprintf (fail "" "") fmt
let default_printer _ = ""
let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
if not (eq x y) then fail (prn x) (prn y) msg
let is_true ?(msg="") x =
if not x then fail "true" "false" msg
let is_false ?(msg="") x =
if x then fail "false" "true" msg
let is_some ?(msg="") x =
if x = None then fail "Some _" "None" msg
let is_none ?(msg="") x =
if x <> None then fail "None" "Some _" msg
let make_equal e p = equal ~eq:e ~prn:p
let string_of_string s = Printf.sprintf "%S" s
let equal_string = make_equal (=) string_of_string
end
let wrap_result = Proto_alpha.Environment.wrap_error
@ -58,7 +87,6 @@ let no_error ?msg = function
let equal_pkh ?msg pkh1 pkh2 =
let msg = Assert.format_msg msg in
let eq pkh1 pkh2 =
match pkh1, pkh2 with
| None, None -> true
@ -112,10 +140,10 @@ let ecoproto_error f = function
| _ -> false
let contain_error ?(msg="") ~f = function
| Ok _ -> Kaputt.Abbreviations.Assert.fail "Error _" "Ok _" msg
| Ok _ -> Assert.fail "Error _" "Ok _" msg
| Error error when not (List.exists f error) ->
let error_str = Format.asprintf "%a" Error_monad.pp_print_error error in
Kaputt.Abbreviations.Assert.fail "" error_str msg
let error_str = Format.asprintf "%a" Tezos_error_monad.Error_monad.pp_print_error error in
Assert.fail "" error_str msg
| _ -> ()
let generic_economic_error ~msg =
@ -202,3 +230,5 @@ let wrong_delegate ~msg =
| Proto_alpha.Baking.Wrong_delegate _ -> true
| _ -> false)
end
include Assert

12
src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli
View File

@ -10,7 +10,17 @@
open Proto_alpha
open Tezos_context
include module type of Assert
val fail : string -> string -> string -> 'a
(** Raises [Failed] with the passed parameters
(expected value, actual value, and message). *)
val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a
(** [fail_msg m] is equivalent to [fail "" "" m]. *)
val equal_string : ?msg:string -> string -> string -> unit
(** Same as [equal], but specialized for [string] values. *)
val equal : ?eq:('a -> 'a -> bool) -> ?prn:('a -> string) -> ?msg:string -> 'a -> 'a -> unit
(** Functions capturing common assertion scenarios and error monads helpers *)

7
src/proto_alpha/lib_protocol/test/helpers/jbuild
View File

@ -2,16 +2,15 @@
(library
((name tezos_proto_alpha_isolate_helpers)
(libraries (tezos-test-helpers
tezos-base
(libraries (tezos-base
tezos-stdlib-unix
tezos-protocol-environment-client
tezos-protocol-alpha))
tezos-protocol-alpha
alcotest-lwt))
(wrapped false)
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_stdlib_unix
-open Tezos_test_helpers
-open Tezos_protocol_environment_client))))
(alias

7
src/proto_alpha/lib_protocol/test/jbuild
View File

@ -3,13 +3,12 @@
(executable
((name main)
(libraries (tezos-base
tezos-test-helpers
tezos-micheline
tezos_proto_alpha_isolate_helpers
tezos_proto_alpha_isolate_michelson_parser))
tezos_proto_alpha_isolate_michelson_parser
alcotest-lwt))
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_micheline
-open Tezos_proto_alpha_isolate_michelson_parser))))
@ -22,7 +21,7 @@
((name runtest_proto_alpha)
(package tezos-protocol-alpha)
(deps (sandbox.json (glob_files contracts/*.tz)))
(action (chdir ${ROOT} (run ${exe:main.exe} ${path-no-dep:contracts})))))
(action (chdir ${ROOT} (run ${exe:main.exe})))))
(alias
((name runtest)

24
src/proto_alpha/lib_protocol/test/main.ml
View File

@ -7,12 +7,20 @@
(* *)
(**************************************************************************)
let wrap (n, f) =
Alcotest_lwt.test_case n `Quick begin fun _ () ->
f () >>= function
| Ok () -> Lwt.return_unit
| Error error ->
Format.kasprintf Pervasives.failwith "%a" pp_print_error error
end
let () =
let module Test = Test.Make(Error_monad) in
Test.run "proto_alpha."
( Test_dsl.tests @
Test_transaction.tests @
Test_endorsement.tests @
Test_origination.tests @
Test_big_maps.tests @
Test_michelson.tests )
Alcotest.run "tezos-protocol-alpha" [
"dsl", List.map wrap Test_dsl.tests ;
"transaction", List.map wrap Test_transaction.tests ;
"endorsement", List.map wrap Test_endorsement.tests ;
"origination", List.map wrap Test_origination.tests ;
"bigmaps", List.map wrap Test_big_maps.tests ;
"michelson", List.map wrap Test_michelson.tests ;
]

7
src/proto_alpha/lib_protocol/test/test_big_maps.ml
View File

@ -8,11 +8,8 @@
(**************************************************************************)
let name = "Isolate Big Maps"
let name = "bigmap"
module Logger = Logging.Make(struct let name = name end)
let section = Lwt_log.Section.make name
let () =
Lwt_log.Section.set_level section Lwt_log.Debug(*.Warning*)
open Logger
@ -128,5 +125,5 @@ let main () =
let tests = [
"main", (fun _ -> main ()) ;
"bigmaps", (fun _ -> main ()) ;
]

2
src/proto_alpha/lib_protocol/test/test_dsl.ml
View File

@ -151,6 +151,6 @@ let test_dsl () : unit proto_tzresult Lwt.t =
let tests =
List.map
(fun (n, f) -> (n, (fun (_ : string) -> f () >>= Assert.wrap)))
(fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap)))
[ "dsl", test_dsl
]

2
src/proto_alpha/lib_protocol/test/test_endorsement.ml
View File

@ -132,7 +132,7 @@ let test_fitness () =
let tests =
List.map
(fun (n, f) -> (n, (fun (_ : string) -> f () >>= Assert.wrap)))
(fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap)))
[ "endorsement.payment", test_endorsement_payment ;
"endorsement.wrong", test_wrong_endorsement ;
"endorsement.multiple", test_multiple_endorsement ;

4
src/proto_alpha/lib_protocol/test/test_michelson.ml
View File

@ -478,6 +478,6 @@ let test_program () =
return ()
let tests = [
"michelson.example", (fun _ -> test_example ()) ;
"michelson.program", (fun _ -> test_program ()) ;
"example", (fun _ -> test_example ()) ;
"program", (fun _ -> test_program ()) ;
]

6
src/proto_alpha/lib_protocol/test/test_origination.ml
View File

@ -81,8 +81,8 @@ let test_delegation () =
let tests =
List.map
(fun (n, f) -> (n, (fun (_: string) -> f () >>= Assert.wrap)))
[ "origination.simple", test_simple_origination ;
"origination.delegate", test_delegation ;
(fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap)))
[ "simple", test_simple_origination ;
"delegate", test_delegation ;
]

2
src/proto_alpha/lib_protocol/test/test_transaction.ml
View File

@ -147,7 +147,7 @@ let test_cycle_transfer () =
let tests =
List.map
(fun (n, f) -> (n, (fun (_: string) -> f () >>= Assert.wrap)))
(fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap)))
[ "transaction.basic", test_basic ;
"transaction.cycle_transfer", test_cycle_transfer
]

2
src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam
View File

@ -11,7 +11,7 @@ depends: [
"jbuilder" { build & >= "1.0+beta17" }
"tezos-base"
"tezos-protocol-compiler"
"tezos-test-helpers" { test }
"alcotest-lwt" { test }
"tezos-protocol-environment-client" { test }
]
build: [