1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 2006 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (* Testing auxiliaries. *)
17
18 open Scanf;;
19
20 let all_tests_ok = ref true;;
21
22 let finish () =
23 match !all_tests_ok with
24 | true ->
25 print_endline "\nAll tests succeeded."
26 | _ ->
27 print_endline "\n\n********* Test suite failed. ***********\n";;
28
29 at_exit finish;;
30
31 let test_num = ref (-1);;
32
33 let print_test_number () =
34 print_string " "; print_int !test_num; flush stdout;;
35
36 let next_test () =
37 incr test_num;
38 print_test_number ();;
39
40 let print_test_fail () =
41 all_tests_ok := false;
42 print_string
43 (Printf.sprintf "\n********* Test number %i failed ***********\n"
44 !test_num);;
45
46 let print_failure_test_fail () =
47 all_tests_ok := false;
48 print_string
49 (Printf.sprintf
50 "\n********* Failure Test number %i incorrectly failed ***********\n"
51 !test_num);;
52
53 let print_failure_test_succeed () =
54 all_tests_ok := false;
55 print_string
56 (Printf.sprintf
57 "\n********* Failure Test number %i failed to fail ***********\n"
58 !test_num);;
59
60 let test b =
61 next_test ();
62 if not b then print_test_fail ();;
63
64 (* Applies f to x and checks that the evaluation indeed
65 raises an exception that verifies the predicate [pred]. *)
66 let test_raises_exc_p pred f x =
67 next_test ();
68 try
69 ignore (f x);
70 print_failure_test_succeed ();
71 false
72 with
73 | x ->
74 pred x || (print_failure_test_fail (); false);;
75
76 (* Applies f to x and checks that the evaluation indeed
77 raises some exception. *)
78 let test_raises_some_exc f = test_raises_exc_p (fun _ -> true) f;;
79 let test_raises_this_exc exc = test_raises_exc_p (fun x -> x = exc);;
80
81 (* Applies f to x and checks that the evaluation indeed
82 raises exception Failure s. *)
83
84 let test_raises_this_failure s f x =
85 test_raises_exc_p (fun x -> x = Failure s) f x;;
86
87 (* Applies f to x and checks that the evaluation indeed
88 raises the exception Failure. *)
89 let test_raises_some_failure f x =
90 test_raises_exc_p (function Failure _ -> true | _ -> false) f x;;
91
92 let failure_test f x s = test_raises_this_failure s f x;;
93 let any_failure_test = test_raises_some_failure;;
94
95 let scan_failure_test f x =
96 test_raises_exc_p (function Scan_failure _ -> true | _ -> false) f x;;
97