From cbee2ecfe7dfdee3493db5bf8e1e0dc01cc4eb64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Wed, 12 Oct 2016 15:00:19 +0200 Subject: [PATCH] Test: improve report --- src/tezos-deps.opam | 2 +- test/Makefile | 4 +- test/lib/assert.ml | 9 ++- test/lib/assert.mli | 9 +++ test/lib/test.ml | 150 +++++++++++++++++++++++++++++++++++++++---- test/lib/test.mli | 9 +++ test/test_basic.ml | 8 +++ test/test_context.ml | 9 +++ test/test_state.ml | 8 +++ test/test_store.ml | 8 +++ 10 files changed, 198 insertions(+), 18 deletions(-) diff --git a/src/tezos-deps.opam b/src/tezos-deps.opam index aa9c8a1a1..d6f4182e1 100644 --- a/src/tezos-deps.opam +++ b/src/tezos-deps.opam @@ -28,5 +28,5 @@ depends: [ "ocplib-json-typed" "ocplib-resto" {>= "dev"} "sodium" {>= "0.3.0"} - "kaputt" {test} + "kaputt" ] diff --git a/test/Makefile b/test/Makefile index 0f1e02bc8..3521c7841 100644 --- a/test/Makefile +++ b/test/Makefile @@ -182,11 +182,11 @@ test.cmx: test.cmi ocamlfind ocamlc ${OCAMLFLAGS} -c $< clean:: - -rm -f *.cm* + -rm -f *.cm* lib/*.cm* -include .depend .depend: $(wildcard *.ml *.mli lib/*.ml lib/*.mli) - ocamldep $^ > .depend + ocamldep -I lib $^ > .depend clean:: -rm .depend diff --git a/test/lib/assert.ml b/test/lib/assert.ml index f1576b0e8..ceadfbfe6 100644 --- a/test/lib/assert.ml +++ b/test/lib/assert.ml @@ -1,4 +1,11 @@ - +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) open Kaputt.Abbreviations diff --git a/test/lib/assert.mli b/test/lib/assert.mli index 124e35f9d..f62070db4 100644 --- a/test/lib/assert.mli +++ b/test/lib/assert.mli @@ -1,3 +1,12 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + include (module type of struct include Kaputt.Assertion end) diff --git a/test/lib/test.ml b/test/lib/test.ml index 416eb1838..ba2fc3ea4 100644 --- a/test/lib/test.ml +++ b/test/lib/test.ml @@ -1,10 +1,16 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + open Kaputt.Abbreviations let keep_dir = try ignore (Sys.getenv "KEEPDIR") ; true with _ -> false -let make_test ~title test = - Test.add_simple_test ~title (fun () -> Lwt_main.run test) - let rec remove_dir dir = Array.iter (fun file -> let f = Filename.concat dir file in @@ -13,15 +19,131 @@ let rec remove_dir dir = (Sys.readdir dir); Unix.rmdir dir +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 = "" } -> + 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 dirs = - List.fold_left (fun dirs (title, f) -> - let base_dir = Filename.temp_file "tezos_test_" "" in - Unix.unlink base_dir; - Unix.mkdir base_dir 0o777; - make_test ~title:(prefix ^ title) (f base_dir); - base_dir :: dirs) - [] tests in - Test.launch_tests (); - if not keep_dir then - List.iter remove_dir dirs + 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 "Data saved kept " + else + remove_dir base_dir + in + try + Lwt_main.run (f base_dir) ; + finalise () + 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 diff --git a/test/lib/test.mli b/test/lib/test.mli index 3bbcbc0d4..28b29b309 100644 --- a/test/lib/test.mli +++ b/test/lib/test.mli @@ -1 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + val run : string -> (string * (string -> unit Lwt.t)) list -> unit diff --git a/test/test_basic.ml b/test/test_basic.ml index d7ca51b95..e55e99508 100644 --- a/test/test_basic.ml +++ b/test/test_basic.ml @@ -1,3 +1,11 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) open Client_embedded_proto_bootstrap open Client_bootstrap diff --git a/test/test_context.ml b/test/test_context.ml index c6099aa66..0a6062921 100644 --- a/test/test_context.ml +++ b/test/test_context.ml @@ -1,3 +1,12 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + open Hash open Context diff --git a/test/test_state.ml b/test/test_state.ml index b2af72077..a68b91e60 100644 --- a/test/test_state.ml +++ b/test/test_state.ml @@ -1,3 +1,11 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) open Hash open Error_monad diff --git a/test/test_store.ml b/test/test_store.ml index e596a5787..94685add2 100644 --- a/test/test_store.ml +++ b/test/test_store.ml @@ -1,3 +1,11 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) open Hash open Store