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

Test: improve report

Browse Source
This commit is contained in:
Grégoire Henry 2016-10-12 15:00:19 +02:00
parent 7dfb68b50a
commit cbee2ecfe7
10 changed files with 198 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/tezos-deps.opam
View File

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

4
test/Makefile
View File

@ -182,11 +182,11 @@ test.cmx: test.cmi
ocamlfind ocamlc ${OCAMLFLAGS} -c $< ocamlfind ocamlc ${OCAMLFLAGS} -c $<
clean:: clean::
-rm -f *.cm* -rm -f *.cm* lib/*.cm*
-include .depend -include .depend
.depend: $(wildcard *.ml *.mli lib/*.ml lib/*.mli) .depend: $(wildcard *.ml *.mli lib/*.ml lib/*.mli)
ocamldep $^ > .depend ocamldep -I lib $^ > .depend
clean:: clean::
-rm .depend -rm .depend

9
test/lib/assert.ml
View File

@ -1,4 +1,11 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Kaputt.Abbreviations open Kaputt.Abbreviations

9
test/lib/assert.mli
View File

@ -1,3 +1,12 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include (module type of struct include Kaputt.Assertion end) include (module type of struct include Kaputt.Assertion end)

148
test/lib/test.ml
View File

@ -1,10 +1,16 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Kaputt.Abbreviations open Kaputt.Abbreviations
let keep_dir = try ignore (Sys.getenv "KEEPDIR") ; true with _ -> false 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 = let rec remove_dir dir =
Array.iter (fun file -> Array.iter (fun file ->
let f = Filename.concat dir file in let f = Filename.concat dir file in
@ -13,15 +19,131 @@ let rec remove_dir dir =
(Sys.readdir dir); (Sys.readdir dir);
Unix.rmdir 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 run prefix tests =
let dirs = let tests =
List.fold_left (fun dirs (title, f) -> List.map
(fun (title, f) ->
let base_dir = Filename.temp_file "tezos_test_" "" in let base_dir = Filename.temp_file "tezos_test_" "" in
Unix.unlink base_dir; Unix.unlink base_dir ;
Unix.mkdir base_dir 0o777; Unix.mkdir base_dir 0o777 ;
make_test ~title:(prefix ^ title) (f base_dir); let title = prefix ^ title in
base_dir :: dirs) title,
[] tests in Test.make_simple_test
Test.launch_tests (); ~title
if not keep_dir then (fun () ->
List.iter remove_dir dirs 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

9
test/lib/test.mli
View File

@ -1 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
val run : string -> (string * (string -> unit Lwt.t)) list -> unit val run : string -> (string * (string -> unit Lwt.t)) list -> unit

8
test/test_basic.ml
View File

@ -1,3 +1,11 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Client_embedded_proto_bootstrap open Client_embedded_proto_bootstrap
open Client_bootstrap open Client_bootstrap

9
test/test_context.ml
View File

@ -1,3 +1,12 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Hash open Hash
open Context open Context

8
test/test_state.ml
View File

@ -1,3 +1,11 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Hash open Hash
open Error_monad open Error_monad

8
test/test_store.ml
View File

@ -1,3 +1,11 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Hash open Hash
open Store open Store