diff options
| -rw-r--r-- | test/Moretest/testing.ml | 96 | ||||
| -rw-r--r-- | test/Moretest/testing.mli | 34 |
2 files changed, 130 insertions, 0 deletions
diff --git a/test/Moretest/testing.ml b/test/Moretest/testing.ml new file mode 100644 index 000000000..3765c90e5 --- /dev/null +++ b/test/Moretest/testing.ml @@ -0,0 +1,96 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Pierre Weis, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Testing auxilliaries. *) + +open Scanf;; + +let all_tests_ok = ref true;; + +let finish () = + match !all_tests_ok with + | true -> + prerr_endline "\nAll tests succeeded." + | _ -> + prerr_endline "\n\n********* Test suit failed. ***********\n";; + +at_exit finish;; + +let test_num = ref (-1);; + +let print_test_number () = + print_int !test_num; print_string " "; flush stdout;; + +let next_test () = + incr test_num; + print_test_number ();; + +let print_test_fail () = + all_tests_ok := false; + print_string + (Printf.sprintf "\n********* Test number %i failed ***********\n" + !test_num);; + +let print_failure_test_fail () = + all_tests_ok := false; + print_string + (Printf.sprintf + "\n********* Failure Test number %i incorrectly failed ***********\n" + !test_num);; + +let print_failure_test_succeed () = + all_tests_ok := false; + print_string + (Printf.sprintf + "\n********* Failure Test number %i failed to fail ***********\n" + !test_num);; + +let test b = + next_test (); + if not b then print_test_fail ();; + +(* Applies f to x and checks that the evaluation indeed + raises an exception that verifies the predicate [pred]. *) +let test_raises_exc_p pred f x = + next_test (); + try + ignore (f x); + print_failure_test_succeed (); + false + with + | x -> + pred x || (print_failure_test_fail (); false);; + +(* Applies f to x and checks that the evaluation indeed + raises some exception. *) +let test_raises_some_exc f = test_raises_exc_p (fun _ -> true) f;; +let test_raises_this_exc exc = test_raises_exc_p (fun x -> x = exc);; + +(* Applies f to x and checks that the evaluation indeed + raises exception Failure s. *) + +let test_raises_this_failure s f x = + test_raises_exc_p (fun x -> x = Failure s) f x;; + +(* Applies f to x and checks that the evaluation indeed + raises the exception Failure. *) +let test_raises_some_failure f x = + test_raises_exc_p (function Failure _ -> true | _ -> false) f x;; + +let failure_test f x s = test_raises_this_failure s f x;; +let any_failure_test = test_raises_some_failure;; + +let scan_failure_test f x = + test_raises_exc_p (function Scan_failure _ -> true | _ -> false) f x;; + diff --git a/test/Moretest/testing.mli b/test/Moretest/testing.mli new file mode 100644 index 000000000..6f47d2a3e --- /dev/null +++ b/test/Moretest/testing.mli @@ -0,0 +1,34 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Pierre Weis, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Testing auxilliaries. *) + +val test : bool -> unit;; +(** [test e] tests that [e] evaluates to [true]. *) +val failure_test : ('a -> 'b) -> 'a -> string -> bool;; +(** [failure_test f x s] tests that [f x] raises the exception [Failure s]. *) + +val test_raises_some_exc : ('a -> 'b) -> 'a -> bool;; +(** [test_raises_some_exc f x] tests that [f x] raises an exception. *) + +val test_raises_this_exc : exn -> ('a -> 'b) -> 'a -> bool;; +(** [test_raises_this_exc exc f x] tests that [f x] + raises the exception [exc]. *) + +val test_raises_exc_p : (exn -> bool) -> ('a -> 'b) -> 'a -> bool;; +(** [test_raises_exc_p p f x] tests that [f x] raises an exception that + verifies predicate [p]. *) + +val scan_failure_test : ('a -> 'b) -> 'a -> bool;; +(** [scan_failure_test f x] tests that [f x] raises [Scanf.Scan_failure]. *) |