97 lines
3.2 KiB
OCaml
97 lines
3.2 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* OCaml *)
|
|
(* *)
|
|
(* 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 GNU Lesser General Public License version 2.1, with the *)
|
|
(* special exception on linking described in the file LICENSE. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
(* Testing auxilliaries. *)
|
|
|
|
open Scanf;;
|
|
|
|
let all_tests_ok = ref true;;
|
|
|
|
let finish () =
|
|
match !all_tests_ok with
|
|
| true ->
|
|
print_endline "\nAll tests succeeded."
|
|
| _ ->
|
|
print_endline "\n\n********* Test suite failed. ***********\n";;
|
|
|
|
at_exit finish;;
|
|
|
|
let test_num = ref (-1);;
|
|
|
|
let print_test_number () =
|
|
print_string " "; print_int !test_num; 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;;
|