2001-12-04 06:24:43 -08:00
|
|
|
open Printf;;
|
1995-11-06 02:34:19 -08:00
|
|
|
|
2001-12-04 06:24:43 -08:00
|
|
|
let flush_all () = flush stdout; flush stderr;;
|
1995-11-06 02:34:19 -08:00
|
|
|
|
2001-12-04 06:24:43 -08:00
|
|
|
let message s = print_string s; print_newline ();;
|
|
|
|
|
|
|
|
let error_occurred = ref false;;
|
|
|
|
let immediate_failure = ref true;;
|
|
|
|
|
|
|
|
let error () =
|
|
|
|
if !immediate_failure then exit 2 else begin
|
|
|
|
error_occurred := true; flush_all (); false
|
|
|
|
end;;
|
|
|
|
|
|
|
|
let success () = flush_all (); true;;
|
|
|
|
|
|
|
|
let function_tested = ref "";;
|
1995-11-06 02:34:19 -08:00
|
|
|
|
|
|
|
let testing_function s =
|
2001-12-04 06:24:43 -08:00
|
|
|
flush_all ();
|
1995-11-06 02:34:19 -08:00
|
|
|
function_tested := s;
|
|
|
|
print_newline();
|
2001-12-04 06:24:43 -08:00
|
|
|
message s;;
|
1995-11-06 02:34:19 -08:00
|
|
|
|
|
|
|
let test test_number eq_fun (answer, correct_answer) =
|
2001-12-04 06:24:43 -08:00
|
|
|
flush_all ();
|
1995-11-06 02:34:19 -08:00
|
|
|
if not (eq_fun answer correct_answer) then begin
|
2001-12-04 06:24:43 -08:00
|
|
|
fprintf stderr ">>> Bad result (%s, test %d)\n" !function_tested test_number;
|
|
|
|
error ()
|
1995-11-06 02:34:19 -08:00
|
|
|
end else begin
|
|
|
|
printf " %d..." test_number;
|
2001-12-04 06:24:43 -08:00
|
|
|
success ()
|
|
|
|
end;;
|
1995-11-06 02:34:19 -08:00
|
|
|
|
|
|
|
let failure_test test_number fun_to_test arg =
|
2001-12-04 06:24:43 -08:00
|
|
|
flush_all ();
|
1995-11-06 02:34:19 -08:00
|
|
|
try
|
|
|
|
fun_to_test arg;
|
2001-12-04 06:24:43 -08:00
|
|
|
fprintf stderr ">>> Failure expected (%s, test %d)\n"
|
1995-11-06 02:34:19 -08:00
|
|
|
!function_tested test_number;
|
2001-12-04 06:24:43 -08:00
|
|
|
error ()
|
1995-11-06 02:34:19 -08:00
|
|
|
with _ ->
|
|
|
|
printf " %d..." test_number;
|
2001-12-04 06:24:43 -08:00
|
|
|
success ();;
|
1995-11-06 02:34:19 -08:00
|
|
|
|
|
|
|
let failwith_test test_number fun_to_test arg correct_failure =
|
2001-12-04 06:24:43 -08:00
|
|
|
flush_all ();
|
1995-11-06 02:34:19 -08:00
|
|
|
try
|
|
|
|
fun_to_test arg;
|
2001-12-04 06:24:43 -08:00
|
|
|
fprintf stderr ">>> Failure expected (%s, test %d)\n"
|
1995-11-06 02:34:19 -08:00
|
|
|
!function_tested test_number;
|
2001-12-04 06:24:43 -08:00
|
|
|
error ()
|
1995-11-06 02:34:19 -08:00
|
|
|
with x ->
|
|
|
|
if x = correct_failure then begin
|
|
|
|
printf " %d..." test_number;
|
2001-12-04 06:24:43 -08:00
|
|
|
success ()
|
1995-11-06 02:34:19 -08:00
|
|
|
end else begin
|
2001-12-04 06:24:43 -08:00
|
|
|
fprintf stderr ">>> Bad failure (%s, test %d)\n"
|
1995-11-06 02:34:19 -08:00
|
|
|
!function_tested test_number;
|
2001-12-04 06:24:43 -08:00
|
|
|
error ()
|
|
|
|
end;;
|
|
|
|
|
|
|
|
let end_tests () =
|
|
|
|
flush_all ();
|
|
|
|
print_newline ();
|
|
|
|
if !error_occurred then begin
|
|
|
|
prerr_endline "************* TESTS FAILED ****************"; exit 2
|
|
|
|
end else begin
|
|
|
|
prerr_endline "************* TESTS COMPLETED SUCCESSFULLY ****************";
|
|
|
|
exit 0
|
|
|
|
end;;
|
1995-11-06 02:34:19 -08:00
|
|
|
|
2001-12-04 06:24:43 -08:00
|
|
|
let eq = (==);;
|
|
|
|
let eq_int = (==);;
|
|
|
|
let eq_string = (=);;
|
1995-11-06 02:34:19 -08:00
|
|
|
|
2001-12-04 06:24:43 -08:00
|
|
|
let sixtyfour = (1 lsl 31) <> 0;;
|