diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0a2a3c11a..182e42ec0 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -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 diff --git a/scripts/ci/create_docker_image.build_deps.sh b/scripts/ci/create_docker_image.build_deps.sh index ae1b73e70..01667073f 100755 --- a/scripts/ci/create_docker_image.build_deps.sh +++ b/scripts/ci/create_docker_image.build_deps.sh @@ -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 diff --git a/scripts/ci/create_opam_repository.tezos_deps.sh b/scripts/ci/create_opam_repository.tezos_deps.sh index 8e929747f..f8e8d95a0 100755 --- a/scripts/ci/create_opam_repository.tezos_deps.sh +++ b/scripts/ci/create_opam_repository.tezos_deps.sh @@ -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 diff --git a/src/lib_crypto/test/jbuild b/src/lib_crypto/test/jbuild index a15c3b065..85af0059c 100644 --- a/src/lib_crypto/test/jbuild +++ b/src/lib_crypto/test/jbuild @@ -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 diff --git a/src/lib_crypto/test/test_merkle.ml b/src/lib_crypto/test/test_merkle.ml index 245b88786..fae52dc27 100644 --- a/src/lib_crypto/test/test_merkle.ml +++ b/src/lib_crypto/test/test_merkle.ml @@ -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 + ] diff --git a/src/lib_crypto/tezos-crypto.opam b/src/lib_crypto/tezos-crypto.opam index ad8f7651f..7cd25217d 100644 --- a/src/lib_crypto/tezos-crypto.opam +++ b/src/lib_crypto/tezos-crypto.opam @@ -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 ] diff --git a/src/lib_data_encoding/test/assert.ml b/src/lib_data_encoding/test/assert.ml new file mode 100644 index 000000000..20e20a899 --- /dev/null +++ b/src/lib_data_encoding/test/assert.ml @@ -0,0 +1,43 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_data_encoding/test/jbuild b/src/lib_data_encoding/test/jbuild index babc37c9a..9eefaa6c5 100644 --- a/src/lib_data_encoding/test/jbuild +++ b/src/lib_data_encoding/test/jbuild @@ -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) diff --git a/src/lib_test_helpers/test.mli b/src/lib_data_encoding/test/test.ml similarity index 73% rename from src/lib_test_helpers/test.mli rename to src/lib_data_encoding/test/test.ml index d248348fd..abc05e32f 100644 --- a/src/lib_test_helpers/test.mli +++ b/src/lib_data_encoding/test/test.ml @@ -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 ; + ] diff --git a/src/lib_data_encoding/test/test_data_encoding.ml b/src/lib_data_encoding/test/test_data_encoding.ml index 59b0d137c..80ac056e5 100644 --- a/src/lib_data_encoding/test/test_data_encoding.ml +++ b/src/lib_data_encoding/test/test_data_encoding.ml @@ -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) diff --git a/src/lib_data_encoding/test/test_stream_data_encoding.ml b/src/lib_data_encoding/test/test_stream_data_encoding.ml index 5ada92e27..77c2b9022 100644 --- a/src/lib_data_encoding/test/test_stream_data_encoding.ml +++ b/src/lib_data_encoding/test/test_stream_data_encoding.ml @@ -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) diff --git a/src/lib_data_encoding/tezos-data-encoding.opam b/src/lib_data_encoding/tezos-data-encoding.opam index d4b94cd43..159bb79be 100644 --- a/src/lib_data_encoding/tezos-data-encoding.opam +++ b/src/lib_data_encoding/tezos-data-encoding.opam @@ -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 ] diff --git a/src/lib_p2p/test/jbuild b/src/lib_p2p/test/jbuild index fc41df4ab..ad4464386 100644 --- a/src/lib_p2p/test/jbuild +++ b/src/lib_p2p/test/jbuild @@ -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 diff --git a/src/lib_p2p/test/process.ml b/src/lib_p2p/test/process.ml new file mode 100644 index 000000000..817d32f4a --- /dev/null +++ b/src/lib_p2p/test/process.ml @@ -0,0 +1,170 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 "@[Unexpected error!@,%a@]" + pp_print_error err >>= fun () -> + List.iter Lwt.cancel remaining ; + join remaining >>= fun _ -> + failwith "A process finished with an unexpected error !" diff --git a/src/lib_p2p/test/process.mli b/src/lib_p2p/test/process.mli new file mode 100644 index 000000000..2dafc1873 --- /dev/null +++ b/src/lib_p2p/test/process.mli @@ -0,0 +1,30 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_p2p/test/test_p2p_io_scheduler.ml b/src/lib_p2p/test/test_p2p_io_scheduler.ml index b637560c8..f5b830566 100644 --- a/src/lib_p2p/test/test_p2p_io_scheduler.ml +++ b/src/lib_p2p/test/test_p2p_io_scheduler.ml @@ -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 .\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) + ] ] diff --git a/src/lib_p2p/test/test_p2p_pool.ml b/src/lib_p2p/test/test_p2p_pool.ml index 382ce61da..3ba26863c 100644 --- a/src/lib_p2p/test/test_p2p_pool.ml +++ b/src/lib_p2p/test/test_p2p_pool.ml @@ -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 .\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 () diff --git a/src/lib_p2p/test/test_p2p_socket.ml b/src/lib_p2p/test/test_p2p_socket.ml index d161f37f8..4ceb12ec8 100644 --- a/src/lib_p2p/test/test_p2p_socket.ml +++ b/src/lib_p2p/test/test_p2p_socket.ml @@ -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 () = diff --git a/src/lib_p2p/tezos-p2p.opam b/src/lib_p2p/tezos-p2p.opam index 21a156f7f..3dea88f12 100644 --- a/src/lib_p2p/tezos-p2p.opam +++ b/src/lib_p2p/tezos-p2p.opam @@ -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 ] diff --git a/src/lib_protocol_environment_client/test/assert.ml b/src/lib_protocol_environment_client/test/assert.ml new file mode 100644 index 000000000..e98edaecb --- /dev/null +++ b/src/lib_protocol_environment_client/test/assert.ml @@ -0,0 +1,50 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_protocol_environment_client/test/jbuild b/src/lib_protocol_environment_client/test/jbuild index eae7384b7..ea352f768 100644 --- a/src/lib_protocol_environment_client/test/jbuild +++ b/src/lib_protocol_environment_client/test/jbuild @@ -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) diff --git a/src/lib_protocol_environment_client/test/test.ml b/src/lib_protocol_environment_client/test/test.ml new file mode 100644 index 000000000..ac06cc480 --- /dev/null +++ b/src/lib_protocol_environment_client/test/test.ml @@ -0,0 +1,13 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let () = + Alcotest.run "tezos-protocol-environment-client" [ + "mem_context", Test_mem_context.tests ; + ] diff --git a/src/lib_protocol_environment_client/test/test_mem_context.ml b/src/lib_protocol_environment_client/test/test_mem_context.ml index da0182261..229447685 100644 --- a/src/lib_protocol_environment_client/test/test_mem_context.ml +++ b/src/lib_protocol_environment_client/test/test_mem_context.ml @@ -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 diff --git a/src/lib_protocol_environment_client/tezos-protocol-environment-client.opam b/src/lib_protocol_environment_client/tezos-protocol-environment-client.opam index 90cda43d6..9ba0d3f28 100644 --- a/src/lib_protocol_environment_client/tezos-protocol-environment-client.opam +++ b/src/lib_protocol_environment_client/tezos-protocol-environment-client.opam @@ -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 ] diff --git a/src/lib_shell/test/assert.ml b/src/lib_shell/test/assert.ml new file mode 100644 index 000000000..f360752c0 --- /dev/null +++ b/src/lib_shell/test/assert.ml @@ -0,0 +1,41 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_shell/test/jbuild b/src/lib_shell/test/jbuild index ce4e39a21..5a224d8eb 100644 --- a/src/lib_shell/test/jbuild +++ b/src/lib_shell/test/jbuild @@ -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) diff --git a/src/lib_shell/test/test_locator.ml b/src/lib_shell/test/test_locator.ml index f85caf0e5..878a50724 100644 --- a/src/lib_shell/test/test_locator.ml +++ b/src/lib_shell/test/test_locator.ml @@ -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 + ] diff --git a/src/lib_shell/test/test_state.ml b/src/lib_shell/test/test_state.ml index f3e19a0fb..b7b573c43 100644 --- a/src/lib_shell/test/test_state.ml +++ b/src/lib_shell/test/test_state.ml @@ -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 + ] diff --git a/src/lib_shell/tezos-shell.opam b/src/lib_shell/tezos-shell.opam index 23ad69919..e0de57c0f 100644 --- a/src/lib_shell/tezos-shell.opam +++ b/src/lib_shell/tezos-shell.opam @@ -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: [ diff --git a/src/lib_stdlib/mBytes.ml b/src/lib_stdlib/mBytes.ml index 66334ea39..a954ef223 100644 --- a/src/lib_stdlib/mBytes.ml +++ b/src/lib_stdlib/mBytes.ml @@ -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 diff --git a/src/lib_stdlib/mBytes.mli b/src/lib_stdlib/mBytes.mli index e38104c00..6e24ddae7 100644 --- a/src/lib_stdlib/mBytes.mli +++ b/src/lib_stdlib/mBytes.mli @@ -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 diff --git a/src/lib_stdlib/test/assert.ml b/src/lib_stdlib/test/assert.ml new file mode 100644 index 000000000..dd156ff7a --- /dev/null +++ b/src/lib_stdlib/test/assert.ml @@ -0,0 +1,18 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_stdlib/test/jbuild b/src/lib_stdlib/test/jbuild index 3c1b0e7f3..629e8f3bc 100644 --- a/src/lib_stdlib/test/jbuild +++ b/src/lib_stdlib/test/jbuild @@ -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 diff --git a/src/lib_stdlib/test/test_tzList.ml b/src/lib_stdlib/test/test_tzList.ml index ffeda6905..3f6a10a6c 100644 --- a/src/lib_stdlib/test/test_tzList.ml +++ b/src/lib_stdlib/test/test_tzList.ml @@ -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 ; + ] diff --git a/src/lib_stdlib/tezos-stdlib.opam b/src/lib_stdlib/tezos-stdlib.opam index 8904620b7..10bc67c59 100644 --- a/src/lib_stdlib/tezos-stdlib.opam +++ b/src/lib_stdlib/tezos-stdlib.opam @@ -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 ] diff --git a/src/lib_stdlib_unix/lwt_utils_unix.ml b/src/lib_stdlib_unix/lwt_utils_unix.ml index 8e1aed807..7aa184272 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.ml +++ b/src/lib_stdlib_unix/lwt_utils_unix.ml @@ -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) diff --git a/src/lib_stdlib_unix/lwt_utils_unix.mli b/src/lib_stdlib_unix/lwt_utils_unix.mli index 444fd0c76..9d43446c2 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.mli +++ b/src/lib_stdlib_unix/lwt_utils_unix.mli @@ -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: diff --git a/src/lib_stdlib_unix/tezos-stdlib-unix.opam b/src/lib_stdlib_unix/tezos-stdlib-unix.opam index 35ebab0e5..9ecda600b 100644 --- a/src/lib_stdlib_unix/tezos-stdlib-unix.opam +++ b/src/lib_stdlib_unix/tezos-stdlib-unix.opam @@ -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" diff --git a/src/lib_storage/test/assert.ml b/src/lib_storage/test/assert.ml new file mode 100644 index 000000000..13ba3ac2c --- /dev/null +++ b/src/lib_storage/test/assert.ml @@ -0,0 +1,79 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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 diff --git a/src/lib_storage/test/jbuild b/src/lib_storage/test/jbuild index 7562aa012..7a179d32d 100644 --- a/src/lib_storage/test/jbuild +++ b/src/lib_storage/test/jbuild @@ -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) diff --git a/src/lib_storage/test/test.ml b/src/lib_storage/test/test.ml new file mode 100644 index 000000000..a67b878d7 --- /dev/null +++ b/src/lib_storage/test/test.ml @@ -0,0 +1,14 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let () = + Alcotest.run "tezos-storage" [ + "store", Test_store.tests ; + "context", Test_context.tests ; + ] diff --git a/src/lib_storage/test/test_context.ml b/src/lib_storage/test/test_context.ml index ad0ab1915..d498bf711 100644 --- a/src/lib_storage/test/test_context.ml +++ b/src/lib_storage/test/test_context.ml @@ -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 diff --git a/src/lib_storage/test/test_store.ml b/src/lib_storage/test/test_store.ml index d4b7b39e6..9ac7c0c14 100644 --- a/src/lib_storage/test/test_store.ml +++ b/src/lib_storage/test/test_store.ml @@ -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 diff --git a/src/lib_storage/tezos-storage.opam b/src/lib_storage/tezos-storage.opam index 72b588103..0a252bacc 100644 --- a/src/lib_storage/tezos-storage.opam +++ b/src/lib_storage/tezos-storage.opam @@ -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 ] diff --git a/src/lib_test_helpers/assert.ml b/src/lib_test_helpers/assert.ml deleted file mode 100644 index dff8fc59c..000000000 --- a/src/lib_test_helpers/assert.ml +++ /dev/null @@ -1,75 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 diff --git a/src/lib_test_helpers/assert.mli b/src/lib_test_helpers/assert.mli deleted file mode 100644 index 3206769c0..000000000 --- a/src/lib_test_helpers/assert.mli +++ /dev/null @@ -1,44 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 diff --git a/src/lib_test_helpers/jbuild b/src/lib_test_helpers/jbuild deleted file mode 100644 index 4fabb5699..000000000 --- a/src/lib_test_helpers/jbuild +++ /dev/null @@ -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} ${^})))) diff --git a/src/lib_test_helpers/process.ml b/src/lib_test_helpers/process.ml deleted file mode 100644 index eb000ac6d..000000000 --- a/src/lib_test_helpers/process.ml +++ /dev/null @@ -1,186 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 "@[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 diff --git a/src/lib_test_helpers/process.mli b/src/lib_test_helpers/process.mli deleted file mode 100644 index 2b054c558..000000000 --- a/src/lib_test_helpers/process.mli +++ /dev/null @@ -1,44 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 diff --git a/src/lib_test_helpers/test.ml b/src/lib_test_helpers/test.ml deleted file mode 100644 index 4a2d678cd..000000000 --- a/src/lib_test_helpers/test.ml +++ /dev/null @@ -1,170 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* 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 diff --git a/src/lib_test_helpers/tezos-test-helpers.opam b/src/lib_test_helpers/tezos-test-helpers.opam deleted file mode 100644 index 1c7ad5453..000000000 --- a/src/lib_test_helpers/tezos-test-helpers.opam +++ /dev/null @@ -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 ] -] diff --git a/src/proto_alpha/lib_client/test/jbuild b/src/proto_alpha/lib_client/test/jbuild index dc83034b4..94f23a047 100644 --- a/src/proto_alpha/lib_client/test/jbuild +++ b/src/proto_alpha/lib_client/test/jbuild @@ -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 diff --git a/src/lib_test_helpers/node_helpers.ml b/src/proto_alpha/lib_client/test/node_helpers.ml similarity index 100% rename from src/lib_test_helpers/node_helpers.ml rename to src/proto_alpha/lib_client/test/node_helpers.ml diff --git a/src/lib_test_helpers/node_helpers.mli b/src/proto_alpha/lib_client/test/node_helpers.mli similarity index 100% rename from src/lib_test_helpers/node_helpers.mli rename to src/proto_alpha/lib_client/test/node_helpers.mli diff --git a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml index 9569d0f7c..3f6226447 100644 --- a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml @@ -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 diff --git a/src/proto_alpha/lib_client/test/proto_alpha_helpers.mli b/src/proto_alpha/lib_client/test/proto_alpha_helpers.mli index 56b254473..d9e1638c3 100644 --- a/src/proto_alpha/lib_client/test/proto_alpha_helpers.mli +++ b/src/proto_alpha/lib_client/test/proto_alpha_helpers.mli @@ -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 -> diff --git a/src/proto_alpha/lib_client/test/test_endorsement.ml b/src/proto_alpha/lib_client/test/test_endorsement.ml index 5e3502ce1..390f86b89 100644 --- a/src/proto_alpha/lib_client/test/test_endorsement.ml +++ b/src/proto_alpha/lib_client/test/test_endorsement.ml @@ -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 + ] diff --git a/src/proto_alpha/lib_client/test/test_michelson_parser.ml b/src/proto_alpha/lib_client/test/test_michelson_parser.ml index c89417a56..952650610 100644 --- a/src/proto_alpha/lib_client/test/test_michelson_parser.ml +++ b/src/proto_alpha/lib_client/test/test_michelson_parser.ml @@ -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 + ] diff --git a/src/proto_alpha/lib_client/test/test_origination.ml b/src/proto_alpha/lib_client/test/test_origination.ml index 1db6e1ff6..128db3959 100644 --- a/src/proto_alpha/lib_client/test/test_origination.ml +++ b/src/proto_alpha/lib_client/test/test_origination.ml @@ -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 + ] diff --git a/src/proto_alpha/lib_client/test/test_transaction.ml b/src/proto_alpha/lib_client/test/test_transaction.ml index be1142ca5..d8eb84405 100644 --- a/src/proto_alpha/lib_client/test/test_transaction.ml +++ b/src/proto_alpha/lib_client/test/test_transaction.ml @@ -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 + ] diff --git a/src/proto_alpha/lib_client/test/test_vote.ml b/src/proto_alpha/lib_client/test/test_vote.ml index 6e31caccf..4190f8cca 100644 --- a/src/proto_alpha/lib_client/test/test_vote.ml +++ b/src/proto_alpha/lib_client/test/test_vote.ml @@ -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 + ] diff --git a/src/proto_alpha/lib_client/tezos-client-alpha.opam b/src/proto_alpha/lib_client/tezos-client-alpha.opam index ebca98df3..4daf04281 100644 --- a/src/proto_alpha/lib_client/tezos-client-alpha.opam +++ b/src/proto_alpha/lib_client/tezos-client-alpha.opam @@ -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 ] diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml index 8f320776b..fe6263505 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml @@ -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 diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli index 2bf51794d..334258e40 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli @@ -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 *) diff --git a/src/proto_alpha/lib_protocol/test/helpers/jbuild b/src/proto_alpha/lib_protocol/test/helpers/jbuild index 45036b843..53f62fbe0 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/jbuild +++ b/src/proto_alpha/lib_protocol/test/helpers/jbuild @@ -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 diff --git a/src/proto_alpha/lib_protocol/test/jbuild b/src/proto_alpha/lib_protocol/test/jbuild index bd0cb5e8f..9ab348855 100644 --- a/src/proto_alpha/lib_protocol/test/jbuild +++ b/src/proto_alpha/lib_protocol/test/jbuild @@ -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) diff --git a/src/proto_alpha/lib_protocol/test/main.ml b/src/proto_alpha/lib_protocol/test/main.ml index 3d8c2c9e7..592a9e09a 100644 --- a/src/proto_alpha/lib_protocol/test/main.ml +++ b/src/proto_alpha/lib_protocol/test/main.ml @@ -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 ; + ] diff --git a/src/proto_alpha/lib_protocol/test/test_big_maps.ml b/src/proto_alpha/lib_protocol/test/test_big_maps.ml index bb11f6e10..f13069b6a 100644 --- a/src/proto_alpha/lib_protocol/test/test_big_maps.ml +++ b/src/proto_alpha/lib_protocol/test/test_big_maps.ml @@ -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 ()) ; ] diff --git a/src/proto_alpha/lib_protocol/test/test_dsl.ml b/src/proto_alpha/lib_protocol/test/test_dsl.ml index 3649808df..38ed5bb14 100644 --- a/src/proto_alpha/lib_protocol/test/test_dsl.ml +++ b/src/proto_alpha/lib_protocol/test/test_dsl.ml @@ -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 ] diff --git a/src/proto_alpha/lib_protocol/test/test_endorsement.ml b/src/proto_alpha/lib_protocol/test/test_endorsement.ml index f87a61a6a..0afb4c161 100644 --- a/src/proto_alpha/lib_protocol/test/test_endorsement.ml +++ b/src/proto_alpha/lib_protocol/test/test_endorsement.ml @@ -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 ; diff --git a/src/proto_alpha/lib_protocol/test/test_michelson.ml b/src/proto_alpha/lib_protocol/test/test_michelson.ml index f4b7897c2..a6fb728e3 100644 --- a/src/proto_alpha/lib_protocol/test/test_michelson.ml +++ b/src/proto_alpha/lib_protocol/test/test_michelson.ml @@ -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 ()) ; ] diff --git a/src/proto_alpha/lib_protocol/test/test_origination.ml b/src/proto_alpha/lib_protocol/test/test_origination.ml index 81b0020a7..fcd4ccd80 100644 --- a/src/proto_alpha/lib_protocol/test/test_origination.ml +++ b/src/proto_alpha/lib_protocol/test/test_origination.ml @@ -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 ; ] diff --git a/src/proto_alpha/lib_protocol/test/test_transaction.ml b/src/proto_alpha/lib_protocol/test/test_transaction.ml index 7da17ecb8..8fcaf2aed 100644 --- a/src/proto_alpha/lib_protocol/test/test_transaction.ml +++ b/src/proto_alpha/lib_protocol/test/test_transaction.ml @@ -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 ] diff --git a/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam b/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam index f6b1e1471..34a9f532f 100644 --- a/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam +++ b/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam @@ -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: [