ocaml/testsuite/lib/testing.ml

97 lines
3.0 KiB
OCaml

(***********************************************************************)
(* *)
(* 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.ml,v 1.1 2006/01/12 12:52:14 weis Exp $ *)
(* 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_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;;