(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
                 , 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 auxiliaries. *)

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;;

************************************************************************
                                                                        
                                 OCaml                                  
                                                                        
                                                                        
     en Automatique.                                                    
                                                                        
   All rights reserved.  This file is distributed under the terms of    
   special exception on linking described in the file LICENSE.          
                                                                        
************************************************************************
 Testing auxiliaries. 
 Applies f to x and checks that the evaluation indeed
   raises an exception that verifies the predicate [pred]. 
 Applies f to x and checks that the evaluation indeed
   raises some exception. 
 Applies f to x and checks that the evaluation indeed
   raises exception Failure s. 
 Applies f to x and checks that the evaluation indeed
   raises the exception Failure. 
                 , projet Cristal , INRIA Rocquencourt           
    Copyright 2006 Institut National de Recherche en Informatique et     
    the GNU Lesser General Public License version 2.1 , with the          


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 ();;

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);;

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);;


let test_raises_this_failure s f x =
  test_raises_exc_p (fun x -> x = Failure s) f x;;

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;;
