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

Test: move data_encoding tests

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-02 16:26:02 +01:00
parent ffe41a003c
commit 6205ca9b31
49 changed files with 697 additions and 549 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
.gitlab-ci.yml
View File

@ -227,146 +227,151 @@ opam:07:tezos-crypto:
variables:
package: tezos-crypto
opam:08:tezos-base:
<<: *opam_definition
variables:
package: tezos-base
opam:09:tezos-protocol-environment-sigs:
<<: *opam_definition
variables:
package: tezos-protocol-environment-sigs
opam:10:irmin-leveldb:
<<: *opam_definition
variables:
package: irmin-leveldb
opam:11:tezos-micheline:
opam:08:tezos-micheline:
<<: *opam_definition
variables:
package: tezos-micheline
opam:12:tezos-protocol-compiler:
<<: *opam_definition
variables:
package: tezos-protocol-compiler
opam:13:tezos-storage:
<<: *opam_definition
variables:
package: tezos-storage
opam:14:ocplib-resto-cohttp:
opam:09:ocplib-resto-cohttp:
<<: *opam_definition
variables:
package: ocplib-resto-cohttp
opam:15:tezos-p2p:
opam:10:tezos-base:
<<: *opam_definition
variables:
package: tezos-p2p
package: tezos-base
opam:16:tezos-protocol-updater:
opam:11:irmin-leveldb:
<<: *opam_definition
variables:
package: tezos-protocol-updater
package: irmin-leveldb
opam:17:tezos-rpc-http:
opam:12:tezos-protocol-environment-sigs:
<<: *opam_definition
variables:
package: tezos-protocol-environment-sigs
opam:13:tezos-rpc-http:
<<: *opam_definition
variables:
package: tezos-rpc-http
opam:18:tezos-shell-services:
opam:14:tezos-shell-services:
<<: *opam_definition
variables:
package: tezos-shell-services
opam:19:tezos-shell:
opam:15:tezos-storage:
<<: *opam_definition
variables:
package: tezos-shell
package: tezos-storage
opam:20:tezos-embedded-protocol-alpha:
opam:16:tezos-protocol-compiler:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-alpha
package: tezos-protocol-compiler
opam:21:tezos-embedded-protocol-demo:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-demo
opam:22:tezos-embedded-protocol-genesis:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-genesis
opam:23:tezos-client-base:
opam:17:tezos-client-base:
<<: *opam_definition
variables:
package: tezos-client-base
opam:24:tezos-client-alpha:
opam:18:tezos-protocol-alpha:
<<: *opam_definition
variables:
package: tezos-client-alpha
package: tezos-protocol-alpha
opam:25:tezos-protocol-environment-client:
opam:19:tezos-protocol-environment-client:
<<: *opam_definition
variables:
package: tezos-protocol-environment-client
opam:26:tezos-protocol-genesis:
opam:20:tezos-p2p:
<<: *opam_definition
variables:
package: tezos-p2p
opam:21:tezos-protocol-updater:
<<: *opam_definition
variables:
package: tezos-protocol-updater
opam:22:tezos-client-alpha:
<<: *opam_definition
variables:
package: tezos-client-alpha
opam:23:tezos-protocol-genesis:
<<: *opam_definition
variables:
package: tezos-protocol-genesis
opam:27:ocplib-resto-json:
opam:24:tezos-shell:
<<: *opam_definition
variables:
package: tezos-shell
opam:25:ocplib-resto-json:
<<: *opam_definition
variables:
package: ocplib-resto-json
opam:28:tezos-client-genesis:
opam:26:tezos-client-genesis:
<<: *opam_definition
variables:
package: tezos-client-genesis
opam:29:ocplib-ezresto:
opam:27:tezos-embedded-protocol-alpha:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-alpha
opam:28:tezos-embedded-protocol-demo:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-demo
opam:29:tezos-embedded-protocol-genesis:
<<: *opam_definition
variables:
package: tezos-embedded-protocol-genesis
opam:30:ocplib-ezresto:
<<: *opam_definition
variables:
package: ocplib-ezresto
opam:30:tezos-client:
opam:31:tezos-client:
<<: *opam_definition
variables:
package: tezos-client
opam:31:tezos-node:
opam:32:tezos-node:
<<: *opam_definition
variables:
package: tezos-node
opam:32:ocplib-ezresto-directory:
opam:33:tezos-test-helpers:
<<: *opam_definition
variables:
package: tezos-test-helpers
opam:34:ocplib-ezresto-directory:
<<: *opam_definition
variables:
package: ocplib-ezresto-directory
opam:33:tezos-test:
opam:35:tezos-test:
<<: *opam_definition
variables:
package: tezos-test
opam:34:tezos-protocol-demo:
opam:36:tezos-protocol-demo:
<<: *opam_definition
variables:
package: tezos-protocol-demo
opam:35:tezos-protocol-alpha:
<<: *opam_definition
variables:
package: tezos-protocol-alpha
##END_OPAM##

0
test/utils/bench_data_encoding.ml → src/lib_data_encoding/test/bench_data_encoding.ml
View File

39
src/lib_data_encoding/test/jbuild Normal file
View File

@ -0,0 +1,39 @@
(jbuild_version 1)
(executables
((names (test_data_encoding
test_stream_data_encoding
;; bench_data_encoding
))
(libraries (tezos-stdlib
tezos_data_encoding
tezos-test-helpers))
(flags (:standard -w -9-32 -safe-string
-open Tezos_stdlib
-open Tezos_data_encoding
-open Tezos_test_helpers))))
(alias
((name buildtest)
(deps (test_data_encoding.exe
test_stream_data_encoding.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)))))
(alias
((name runtest_indent)
(deps ((glob_files *.ml) (glob_files *.mli)))
(action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^}))))

30
test/utils/test_data_encoding.ml → src/lib_data_encoding/test/test_data_encoding.ml
View File

@ -1,7 +1,22 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Utils.Infix
open Lwt.Infix
open Data_encoding
let (>>=) = Lwt.bind
let (>|=) = Lwt.(>|=)
module Error = struct
type error = ..
let pp_print_error _ _ = ()
end
module Test = Test.Make(Error)
let (//) = Filename.concat
let write_file dir ~name content =
@ -117,6 +132,7 @@ let test_simple_values _ =
Lwt.return_unit
(*
let test_json testdir =
let open Data_encoding_ezjsonm in
let file = testdir // "testing_data_encoding.tezos" in
@ -130,7 +146,7 @@ let test_json testdir =
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
@ -256,6 +272,7 @@ let test_splitted _ =
Assert.equal ~msg:__LOC__ "44" (get_result ~msg:__LOC__ binB);
Lwt.return_unit
(*
let test_json_input testdir =
let enc =
obj1
@ -318,10 +335,11 @@ let test_json_input testdir =
| _ -> false) ;
Lwt.return_unit
end
*)
let wrap_test f base_dir =
f base_dir >>= fun result ->
return result
Lwt.return_ok result
let test_wrapped_binary _ =
let open Data_encoding in
@ -413,10 +431,10 @@ let test_randomized_variant_list _ =
let tests = [
"simple", test_simple_values ;
"json", test_json ;
(* "json", test_json ; *)
"union", test_union ;
"splitted", test_splitted ;
"json.input", test_json_input ;
(* "json.input", test_json_input ; *)
"tags", test_tag_errors ;
"wrapped_binary", test_wrapped_binary ;
"out_of_range", test_out_of_range ;

21
test/utils/test_stream_data_encoding.ml → src/lib_data_encoding/test/test_stream_data_encoding.ml
View File

@ -1,14 +1,27 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Lwt.Infix
open Data_encoding
let (>>=) = Lwt.bind
let (>|=) = Lwt.(>|=)
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
let is_await = function Binary.Await _ -> true | _ -> false
let is_success = function Binary.Success _ -> true | _ -> false
let is_error = function Binary.Error -> true | _ -> false
@ -435,7 +448,7 @@ let test_splitted _ =
let wrap_test f base_dir =
f base_dir >>= fun result ->
return result
Lwt.return_ok result
let tests = [
"simple", test_simple_values ;

35
test/lib/assert.ml → src/lib_test_helpers/assert.ml
View File

@ -17,13 +17,6 @@ let is_error ?(msg="") = function
| Error _ -> ()
| Ok _ -> fail "Error _" "Ok _" msg
let contain_error ?(msg="") ~f = function
| Ok _ -> fail "Error _" "Ok _" msg
| Error error when not (List.exists f error) ->
let error_str = Format.asprintf "%a" pp_print_error error in
fail "" error_str msg
| _ -> ()
let is_ok ?(msg="") = function
| Ok _ -> ()
| Error _ -> fail "Ok _" "Error _" msg
@ -36,11 +29,6 @@ let equal_string_list_list ?msg l1 l2 =
Printf.sprintf "[%s]" res in
Assert.make_equal_list ?msg (=) pr_persist l1 l2
let equal_block_hash_list ?msg l1 l2 =
let msg = 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 equal_string_list ?msg l1 l2 =
let msg = format_msg msg in
Assert.make_equal_list ?msg (=) (fun x -> x) l1 l2
@ -52,29 +40,6 @@ let equal_string_option ?msg o1 o2 =
| Some s -> s in
Assert.equal ?msg ~prn o1 o2
let equal_error_monad ?msg exn1 exn2 =
let msg = format_msg msg in
let prn err = Format.asprintf "%a" Error_monad.pp_print_error [err] in
Assert.equal ?msg ~prn exn1 exn2
let equal_block_set ?msg set1 set2 =
let msg = 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 equal_block_map ?msg ~eq map1 map2 =
let msg = 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 equal_result ?msg r1 r2 ~equal_ok ~equal_err =
let msg = format_msg msg in
match r1, r2 with

17
test/lib/assert.mli → src/lib_test_helpers/assert.mli
View File

@ -11,17 +11,10 @@ include module type of Kaputt.Assertion
val format_msg : string option -> string option
val is_ok : ?msg:string -> 'a tzresult -> unit
val is_error : ?msg:string -> 'a tzresult -> unit
val contain_error : ?msg:string -> f:(error -> bool) -> 'a tzresult -> unit
val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a
val fail : string -> string -> ('a, Format.formatter, unit, 'b) format4 -> 'a
val equal_block_hash_list :
?msg:string -> Block_hash.t list -> Block_hash.t list -> unit
val equal_string_list :
?msg:string -> string list -> string list -> unit
@ -30,16 +23,6 @@ val equal_string_list_list :
val equal_string_option : ?msg:string -> string option -> string option -> unit
val equal_error_monad :
?msg:string -> Error_monad.error -> Error_monad.error -> unit
val equal_block_set :
?msg:string -> Block_hash.Set.t -> Block_hash.Set.t -> unit
val equal_block_map :
?msg:string -> eq:('a -> 'a -> bool) ->
'a Block_hash.Map.t -> 'a Block_hash.Map.t -> unit
val equal_result :
?msg:string ->
('a, 'b) result ->

10
test/lib/jbuild → src/lib_test_helpers/jbuild
View File

@ -1,11 +1,11 @@
(jbuild_version 1)
(library
((name test_lib)
(libraries (kaputt tezos-base))
(wrapped false)
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives))))
((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)

0
test/lib/node_helpers.ml → src/lib_test_helpers/node_helpers.ml
View File

0
test/lib/node_helpers.mli → src/lib_test_helpers/node_helpers.mli
View File

186
src/lib_test_helpers/process.ml Normal file
View File

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

44
src/lib_test_helpers/process.mli Normal file
View File

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

170
src/lib_test_helpers/test.ml Normal file
View File

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

9
test/lib/test.mli → src/lib_test_helpers/test.mli
View File

@ -7,6 +7,11 @@
(* *)
(**************************************************************************)
open Error_monad
module Make(Error : sig
type error
val pp_print_error: Format.formatter -> error list -> unit
end) : sig
val run : string -> (string * (string -> unit tzresult Lwt.t)) list -> unit
val run : string -> (string * (string -> (unit, Error.error list) result Lwt.t)) list -> unit
end

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

@ -0,0 +1,20 @@
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+beta15" }
"lwt"
"kaputt"
]
build: [
[ "jbuilder" "build" "-p" name "-j" jobs ]
]
build-test: [
[ "jbuilder" "runtest" "-p" name "-j" jobs ]
]

6
test/jbuild
View File

@ -3,7 +3,7 @@
(alias
((name runtest_basic.sh)
(deps (sandbox.json
lib/test_lib.inc.sh
test_lib.inc.sh
(glob_files contracts/*)
))
(locks (/tcp-port/18731
@ -18,7 +18,7 @@
(alias
((name runtest_contracts.sh)
(deps (sandbox.json
lib/test_lib.inc.sh
test_lib.inc.sh
(glob_files contracts/*)
))
(locks (/tcp-port/18731
@ -33,7 +33,7 @@
(alias
((name runtest_multinode.sh)
(deps (sandbox.json
lib/test_lib.inc.sh
test_lib.inc.sh
(glob_files contracts/*)
))
(locks (/tcp-port/18731 /tcp-port/18732 /tcp-port/18733 /tcp-port/18734

156
test/lib/process.ml
View File

@ -1,156 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let () = Lwt_unix.set_default_async_method Async_none
include Logging.Make (struct let name = "process" end)
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_log_error "%a" Error_monad.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 >>= return)
(fun exn -> fail (Exn exn))
let pop (inch, _) =
Lwt.catch
(fun () -> Lwt_io.read_value inch >>= return)
(fun exn -> fail (Exn exn))
end
let wait pid =
Lwt.catch
(fun () ->
Lwt_unix.waitpid [] pid >>= function
| (_,Lwt_unix.WEXITED 0) ->
return ()
| (_,Lwt_unix.WEXITED n) ->
fail (Exn (Exited n))
| (_,Lwt_unix.WSIGNALED n) ->
fail (Exn (Signaled n))
| (_,Lwt_unix.WSTOPPED n) ->
fail (Exn (Stopped n)))
(function
| Lwt.Canceled ->
Unix.kill pid Sys.sigkill ;
return ()
| exn ->
fail (Exn exn))
type ('a, 'b) t = {
termination: unit tzresult Lwt.t ;
channel: ('b, 'a) Channel.t ;
}
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 ->
Logging.init Stderr >>= fun () ->
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 () ->
Logging.init ~template Stderr >>= fun () ->
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 () ->
return ()
| Some ([Exn (Exited n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process finished with error %d !" n
| Some ([Exn (Signaled n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process was killed by a SIG%s !" (signal_name n)
| Some ([Exn (Stopped n)], remaining) ->
lwt_log_error "Early error!" >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process was stopped by a SIG%s !" (signal_name n)
| Some (err, remaining) ->
lwt_log_error "@[<v 2>Unexpected error!@,%a@]"
pp_print_error err >>= fun () ->
List.iter Lwt.cancel remaining ;
join remaining >>= fun _ ->
failwith "A process finished with an unexpected error !"

29
test/lib/process.mli
View File

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

163
test/lib/test.ml
View File

@ -1,163 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
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_monad.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

4
test/p2p/jbuild
View File

@ -6,12 +6,12 @@
test_p2p_io_scheduler))
(libraries (tezos-base
tezos-p2p
lwt.unix
test_lib))
tezos-test-helpers))
(flags (:standard -w -9-32
-linkall
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_p2p))))
(alias

3
test/p2p/test_p2p_io_scheduler.ml
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
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,6 +217,7 @@ let () =
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

4
test/p2p/test_p2p_pool.ml
View File

@ -7,12 +7,13 @@
(* *)
(**************************************************************************)
module Process = Tezos_test_helpers.Process.Make(Error_monad)
include Logging.Make (struct let name = "test.p2p.connection-pool" end)
type message =
| Ping
let msg_config : message P2p_pool.message_config = {
encoding = [
P2p_pool.Encoding {
@ -279,6 +280,7 @@ let spec = Arg.[
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
let anon_fun _num_peers = raise (Arg.Bad "No anonymous argument.") in
let usage_msg = "Usage: %s <num_peers>.\nArguments are:" in
Arg.parse spec anon_fun usage_msg ;

4
test/p2p/test_p2p_socket.ml
View File

@ -10,6 +10,8 @@
(* 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
@ -409,9 +411,11 @@ let spec = Arg.[
]
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 ;

3
test/proto_alpha/jbuild
View File

@ -12,9 +12,10 @@
tezos-client-genesis
tezos-client-alpha
tezos-shell
test_lib))
tezos-test-helpers))
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_rpc_http
-open Tezos_client_base
-open Tezos_client_genesis

31
test/proto_alpha/proto_alpha_helpers.ml
View File

@ -310,8 +310,15 @@ 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
| 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 failed_to_preapply ~msg ?op f =
Assert.contain_error ~msg ~f:begin function
contain_error ~msg ~f:begin function
| Client_baking_forge.Failed_to_preapply (op', err) ->
begin
match op with
@ -324,64 +331,64 @@ module Assert = struct
end
let generic_economic_error ~msg =
Assert.contain_error ~msg ~f:(ecoproto_error (fun _ -> true))
contain_error ~msg ~f:(ecoproto_error (fun _ -> true))
let unknown_contract ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Raw_context.Storage_error _ -> true
| _ -> false)
end
let non_existing_contract ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Contract_storage.Non_existing_contract _ -> true
| _ -> false)
end
let balance_too_low ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Contract.Balance_too_low _ -> true
| _ -> false)
end
let non_spendable ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Contract_storage.Unspendable_contract _ -> true
| _ -> false)
end
let inconsistent_pkh ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Contract_storage.Inconsistent_hash _ -> true
| _ -> false)
end
let inconsistent_public_key ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Contract_storage.Inconsistent_public_key _ -> true
| _ -> false)
end
let missing_public_key ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Contract_storage.Missing_public_key _ -> true
| _ -> false)
end
let initial_amount_too_low ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Contract.Initial_amount_too_low _ -> true
| _ -> false)
end
let non_delegatable ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Contract_storage.Non_delegatable_contract _ -> true
| _ -> false)
end
let wrong_delegate ~msg =
Assert.contain_error ~msg ~f:begin ecoproto_error (function
contain_error ~msg ~f:begin ecoproto_error (function
| Baking.Wrong_delegate _ -> true
| _ -> false)
end

1
test/proto_alpha/test_endorsement.ml
View File

@ -250,4 +250,5 @@ let tests = [
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "endorsement." tests

1
test/proto_alpha/test_michelson_parser.ml
View File

@ -430,4 +430,5 @@ let tests = [
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "michelson." tests

1
test/proto_alpha/test_origination.ml
View File

@ -96,4 +96,5 @@ let tests = [
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "origination." tests

1
test/proto_alpha/test_transaction.ml
View File

@ -107,4 +107,5 @@ let tests = [
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "transactions." tests

1
test/proto_alpha/test_vote.ml
View File

@ -95,4 +95,5 @@ let tests = [
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "amendment." tests

3
test/proto_alpha_isolate/jbuild
View File

@ -13,10 +13,11 @@
(libraries (tezos-base
tezos-rpc-http
tezos-shell
test_lib
tezos-test-helpers
tezos_proto_alpha_isolate_helpers))
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_rpc_http))))
(alias

1
test/proto_alpha_isolate/test_isolate_dsl.ml
View File

@ -160,4 +160,5 @@ let tests = [
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "dsl." tests

1
test/proto_alpha_isolate/test_isolate_endorsement.ml
View File

@ -150,4 +150,5 @@ let tests = [
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "endorsement." tests

1
test/proto_alpha_isolate/test_isolate_michelson.ml
View File

@ -498,4 +498,5 @@ let tests = [
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "michelson." tests

1
test/proto_alpha_isolate/test_isolate_origination.ml
View File

@ -103,4 +103,5 @@ let tests = [
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "origination." tests

1
test/proto_alpha_isolate/test_isolate_transaction.ml
View File

@ -161,4 +161,5 @@ let tests = [
]
let main () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "transactions." tests

21
test/proto_alpha_isolate_helpers/helpers_assert.ml
View File

@ -106,18 +106,23 @@ let equal_cents_balance ~tc ?msg (contract, cents_balance) =
~msg: (Option.unopt ~default:"equal_cents_balance" msg)
(contract, Helpers_cast.cents_of_int cents_balance)
let ecoproto_error f = function
| Proto_alpha.Environment.Ecoproto_error errors ->
List.exists f errors
| _ -> false
let contain_error ?(msg="") ~f = function
| Ok _ -> Kaputt.Abbreviations.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 generic_economic_error ~msg =
Assert.contain_error ~msg ~f: (ecoproto_error (fun _ -> true))
contain_error ~msg ~f: (ecoproto_error (fun _ -> true))
let economic_error ~msg f =
Assert.contain_error ~msg ~f: (ecoproto_error f)
contain_error ~msg ~f: (ecoproto_error f)
let ill_typed_data_error ~msg =
let aux = function
@ -167,7 +172,7 @@ let balance_too_low ~msg =
let non_spendable ~msg =
Assert.contain_error ~msg ~f: begin ecoproto_error (function
contain_error ~msg ~f: begin ecoproto_error (function
| Proto_alpha.Contract_storage.Unspendable_contract _ -> true
| error ->
Helpers_logger.debug "Actual error: %a" pp error ;
@ -175,25 +180,25 @@ let non_spendable ~msg =
end
let inconsistent_pkh ~msg =
Assert.contain_error ~msg ~f: begin ecoproto_error (function
contain_error ~msg ~f: begin ecoproto_error (function
| Proto_alpha.Contract_storage.Inconsistent_hash _ -> true
| _ -> false)
end
let initial_amount_too_low ~msg =
Assert.contain_error ~msg ~f: begin ecoproto_error (function
contain_error ~msg ~f: begin ecoproto_error (function
| Contract.Initial_amount_too_low _ -> true
| _ -> false)
end
let non_delegatable ~msg =
Assert.contain_error ~msg ~f: begin ecoproto_error (function
contain_error ~msg ~f: begin ecoproto_error (function
| Proto_alpha.Contract_storage.Non_delegatable_contract _ -> true
| _ -> false)
end
let wrong_delegate ~msg =
Assert.contain_error ~msg ~f: begin ecoproto_error (function
contain_error ~msg ~f: begin ecoproto_error (function
| Proto_alpha.Baking.Wrong_delegate _ -> true
| _ -> false)
end

4
test/proto_alpha_isolate_helpers/jbuild
View File

@ -2,8 +2,7 @@
(library
((name tezos_proto_alpha_isolate_helpers)
(libraries (kaputt
test_lib
(libraries (tezos-test-helpers
tezos-base
tezos-shell
tezos-embedded-protocol-genesis
@ -11,6 +10,7 @@
(wrapped false)
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_embedded_raw_protocol_alpha))))
(alias

3
test/shell/jbuild
View File

@ -10,10 +10,11 @@
tezos-embedded-protocol-demo
tezos-embedded-protocol-alpha
tezos-embedded-protocol-genesis
test_lib))
tezos-test-helpers))
(flags (:standard -w -9-32
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_storage
-open Tezos_shell))))

1
test/shell/test_context.ml
View File

@ -216,4 +216,5 @@ let tests : (string * (t -> unit Lwt.t)) list = [
]
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)

1
test/shell/test_state.ml
View File

@ -446,4 +446,5 @@ let tests : (string * (state -> unit tzresult Lwt.t)) list = [
]
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)

50
test/shell/test_store.ml
View File

@ -208,6 +208,15 @@ 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
@ -219,25 +228,34 @@ 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' ->
Assert.equal_block_set ~msg:__LOC__ bhset bhset' ;
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' ->
Assert.equal_block_set ~msg:__LOC__ bhset2 bhset2' ;
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'' ->
Assert.equal_block_set ~msg:__LOC__ bhset2 bhset2'' ;
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 ->
Assert.equal_block_set ~msg:__LOC__ BlockSet.empty empty ;
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
@ -257,12 +275,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' ->
Assert.equal_block_map ~msg:__LOC__ ~eq map map' ;
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' ->
Assert.equal_block_map ~msg:__LOC__ ~eq map2 map2' ;
equal_block_map ~msg:__LOC__ ~eq map2 map2' ;
Lwt.return_unit
(** Functors *)
@ -316,6 +334,11 @@ 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 ;
@ -328,7 +351,7 @@ let test_subblock s =
Block_hash.Set.empty
|> Block_hash.Set.add bh1
|> Block_hash.Set.add bh2 in
Assert.equal_block_set ~msg:__LOC__ set set' ;
equal_block_set ~msg:__LOC__ set set' ;
SubBlocksSet.remove s bh2 >>= fun () ->
let set =
Block_hash.Set.empty
@ -336,13 +359,13 @@ let test_subblock s =
|> Block_hash.Set.add bh3 in
SubBlocksSet.store_all s set >>= fun () ->
SubBlocksSet.elements s >>= fun elts ->
Assert.equal_block_hash_list ~msg:__LOC__
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 ->
Assert.equal_block_hash_list ~msg:__LOC__
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 ->
@ -360,19 +383,19 @@ let test_subblock s =
|> Block_hash.Map.add bh1 v1
|> Block_hash.Map.add bh2 v2 in
SubBlocksMap.read_all s >>= fun map' ->
Assert.equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
SubBlocksSet.remove_all s >>= fun () ->
SubBlocksSet.elements s >>= fun elts ->
Assert.equal_block_hash_list ~msg:__LOC__ elts [] ;
equal_block_hash_list ~msg:__LOC__ elts [] ;
SubBlocksMap.read_all s >>= fun map' ->
Assert.equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
SubBlocksSet.store s bh3 >>= fun () ->
SubBlocks.indexes s >>= fun keys ->
Assert.equal_block_hash_list ~msg:__LOC__
equal_block_hash_list ~msg:__LOC__
(List.sort Block_hash.compare keys)
(List.sort Block_hash.compare [bh1;bh2;bh3]) ;
@ -434,6 +457,7 @@ let tests : (string * (Store.t -> unit Lwt.t)) list = [
]
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)

2
test/test_basic.sh
View File

@ -3,7 +3,7 @@
set -e
test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
source $test_dir/lib/test_lib.inc.sh "$@"
source $test_dir/test_lib.inc.sh "$@"
start_node 1
activate_alpha

2
test/test_contracts.sh
View File

@ -4,7 +4,7 @@ set -e
set -o pipefail
test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
source $test_dir/lib/test_lib.inc.sh "$@"
source $test_dir/test_lib.inc.sh "$@"
start_node 1
activate_alpha

0
test/lib/test_lib.inc.sh → test/test_lib.inc.sh
View File

2
test/test_multinode.sh
View File

@ -3,7 +3,7 @@
set -e
test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
source $test_dir/lib/test_lib.inc.sh "$@"
source $test_dir/test_lib.inc.sh "$@"
expected_connections=4
max_peer_id=8

26
test/utils/jbuild
View File

@ -1,31 +1,23 @@
(jbuild_version 1)
(executables
((names (test_data_encoding
test_lwt_pipe
((names (test_lwt_pipe
test_merkle
test_stream_data_encoding
test_utils
bench_data_encoding
test_mbytes_buffer))
(libraries (tezos-base test_lib))
(libraries (tezos-base tezos-test-helpers))
(flags (:standard -w -9-32
-safe-string
-open Tezos_base__TzPervasives))))
-open Tezos_base__TzPervasives
-open Tezos_test_helpers))))
(alias
((name buildtest)
(deps (test_data_encoding.exe
test_lwt_pipe.exe
(deps (test_lwt_pipe.exe
test_merkle.exe
test_stream_data_encoding.exe
test_utils.exe
test_mbytes_buffer.exe))))
(alias
((name runtest_data_encoding)
(action (run ${exe:test_data_encoding.exe}))))
(alias
((name runtest_lwt_pipe)
(action (run ${exe:test_lwt_pipe.exe}))))
@ -34,10 +26,6 @@
((name runtest_merkle)
(action (run ${exe:test_merkle.exe}))))
(alias
((name runtest_stream_data_encoding)
(action (run ${exe:test_stream_data_encoding.exe}))))
(alias
((name runtest_utils)
(action (run ${exe:test_utils.exe}))))
@ -48,10 +36,8 @@
(alias
((name runtest)
(deps ((alias runtest_data_encoding)
(alias runtest_lwt_pipe)
(deps ((alias runtest_lwt_pipe)
(alias runtest_merkle)
(alias runtest_stream_data_encoding)
(alias runtest_utils)
(alias runtest_mbytes_buffer)))))

1
test/utils/test_merkle.ml
View File

@ -80,4 +80,5 @@ let tests : (string * (string -> unit tzresult Lwt.t)) list = [
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "merkel." tests

1
test/utils/test_utils.ml
View File

@ -50,4 +50,5 @@ let tests : (string * (string -> unit tzresult Lwt.t)) list = [
]
let () =
let module Test = Tezos_test_helpers.Test.Make(Error_monad) in
Test.run "utils." tests