Page MenuHomeHEPForge
Files F7877129

No OneTemporary
Actions

View Options

Index: trunk/src/omega/tests/omega_unit.ml
===================================================================
--- trunk/src/omega/tests/omega_unit.ml (revision 4001)
+++ trunk/src/omega/tests/omega_unit.ml (revision 4002)
@@ -1,14 +1,37 @@
+(* $Id$
+
+ Copyright (C) 1999-2012 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <christian.speckner@physik.uni-freiburg.de>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+
open OUnit
let trivial_test =
bracket
(fun () -> true)
(fun b -> assert_bool "always true" b)
(fun b -> ())
let suite =
"O'Mega Unit Test Suite" >:::
["trivial" >:: trivial_test]
let _ =
run_test_tt_main suite
Property changes on: trunk/src/omega/tests/omega_unit.ml
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property
Index: trunk/src/omega/tests/oUnit.ml
===================================================================
--- trunk/src/omega/tests/oUnit.ml (revision 4001)
+++ trunk/src/omega/tests/oUnit.ml (revision 4002)
@@ -1,803 +1,805 @@
+(* $Id$ *)
+
(***********************************************************************)
(* The OUnit library *)
(* *)
(* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *)
(* Copyright (C) 2010 OCamlCore SARL *)
(* *)
(***********************************************************************)
(* Version 1.1.2, with minor modifications by Thorsten Ohl *)
(************************************************************************
The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL.
Permission is hereby granted, free of charge, to any person obtaining
a copy of this document and the OUnit software ("the Software"), to
deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute,
sublicense, and/or sell copies of the Software, and to permit persons
to whom the Software is furnished to do so, subject to the following
conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
The Software is provided ``as is'', without warranty of any kind,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose and noninfringement.
In no event shall Maas-Maarten Zeeman be liable for any claim, damages
or other liability, whether in an action of contract, tort or
otherwise, arising from, out of or in connection with the Software or
the use or other dealings in the software.
************************************************************************)
open Format
(* TODO: really use Format in printf call. Most of the time, not
* cuts/spaces/boxes are used
*)
let global_verbose = ref false
let buff_printf f =
let buff = Buffer.create 13 in
let fmt = formatter_of_buffer buff in
f fmt;
pp_print_flush fmt ();
Buffer.contents buff
let bracket set_up f tear_down () =
let fixture =
set_up ()
in
let () =
try
let () = f fixture in
tear_down fixture
with e ->
let () =
tear_down fixture
in
raise e
in
()
let bracket_tmpfile ?(prefix="ounit-") ?(suffix=".txt") ?mode f =
bracket
(fun () ->
Filename.open_temp_file ?mode prefix suffix)
f
(fun (fn, chn) ->
begin
try
close_out chn
with _ ->
()
end;
begin
try
Sys.remove fn
with _ ->
()
end)
exception Skip of string
let skip_if b msg =
if b then
raise (Skip msg)
exception Todo of string
let todo msg =
raise (Todo msg)
let assert_failure msg =
failwith ("OUnit: " ^ msg)
let assert_bool msg b =
if not b then assert_failure msg
let assert_string str =
if not (str = "") then assert_failure str
let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual =
let get_error_string () =
(* let max_len = pp_get_margin fmt () in *)
(* let ellipsis_text = "[...]" in *)
let print_ellipsis p fmt s =
(* TODO: find a way to do this
let res = p s in
let len = String.length res in
if diff <> None && len > max_len then
begin
let len_with_ellipsis =
(max_len - (String.length ellipsis_text)) / 2
in
(* TODO: we should use %a here to print values *)
fprintf fmt
"@[%s[...]%s@]"
(String.sub res
0
len_with_ellipsis)
(String.sub res
(len - len_with_ellipsis)
len_with_ellipsis)
end
else
begin
(* TODO: we should use %a here to print values *)
fprintf fmt "@[%s@]" res
end
*)
pp_print_string fmt (p s)
in
let res =
buff_printf
(fun fmt ->
pp_open_vbox fmt 0;
begin
match msg with
| Some s ->
pp_open_box fmt 0;
pp_print_string fmt s;
pp_close_box fmt ();
pp_print_cut fmt ()
| None ->
()
end;
begin
match printer with
| Some p ->
let p_ellipsis = print_ellipsis p in
fprintf fmt
"@[expected: @[%a@]@ but got: @[%a@]@]@,"
p_ellipsis expected
p_ellipsis actual
| None ->
fprintf fmt "@[not equal@]@,"
end;
begin
match pp_diff with
| Some d ->
fprintf fmt
"@[differences: %a@]@,"
d (expected, actual)
| None ->
()
end;
pp_close_box fmt ())
in
let len =
String.length res
in
if len > 0 && res.[len - 1] = '\n' then
String.sub res 0 (len - 1)
else
res
in
if not (cmp expected actual) then
assert_failure (get_error_string ())
let assert_command
?(exit_code=Unix.WEXITED 0)
?(sinput=Stream.of_list [])
?(foutput=ignore)
?(use_stderr=true)
?env
?verbose
prg args =
let verbose =
match verbose with
| Some v -> v
| None -> !global_verbose
in
bracket_tmpfile
(fun (fn_out, chn_out) ->
let cmd_print fmt =
let () =
match env with
| Some e ->
begin
pp_print_string fmt "env";
Array.iter (fprintf fmt "@ %s") e;
pp_print_space fmt ()
end
| None ->
()
in
pp_print_string fmt prg;
List.iter (fprintf fmt "@ %s") args
in
(* Start the process *)
let in_write =
Unix.dup (Unix.descr_of_out_channel chn_out)
in
let (out_read, out_write) =
Unix.pipe ()
in
let err =
if use_stderr then
in_write
else
Unix.stderr
in
let args =
Array.of_list (prg :: args)
in
let pid =
Unix.set_close_on_exec out_write;
if verbose then
printf "@[Starting command '%t'@]\n" cmd_print;
match env with
| Some e ->
Unix.create_process_env prg args e out_read in_write err
| None ->
Unix.create_process prg args out_read in_write err
in
let () =
Unix.close out_read;
Unix.close in_write
in
let () =
(* Dump sinput into the process stdin *)
let buff = " " in
Stream.iter
(fun c ->
let _i : int =
buff.[0] <- c;
Unix.write out_write buff 0 1
in
())
sinput;
Unix.close out_write
in
let _, real_exit_code =
let rec wait_intr () =
try
Unix.waitpid [] pid
with Unix.Unix_error (Unix.EINTR, _, _) ->
wait_intr ()
in
wait_intr ()
in
let exit_code_printer =
function
| Unix.WEXITED n ->
Printf.sprintf "exit code %d" n
| Unix.WSTOPPED n ->
Printf.sprintf "stopped by signal %d" n
| Unix.WSIGNALED n ->
Printf.sprintf "killed by signal %d" n
in
(* Dump process output to stderr *)
if verbose then
begin
let chn =
open_in fn_out
in
let buff = String.make 4096 'X' in
let len = ref (-1) in
while !len <> 0 do
len := input chn buff 0 (String.length buff);
printf "%s" (String.sub buff 0 !len);
done;
printf "@?";
close_in chn
end;
(* Check process status *)
assert_equal
~msg:(buff_printf
(fun fmt ->
fprintf fmt
"@[Exit status of command '%t'@]" cmd_print))
~printer:exit_code_printer
exit_code
real_exit_code;
begin
let chn =
open_in fn_out
in
try
foutput (Stream.of_channel chn)
with e ->
close_in chn;
raise e
end)
()
let raises f =
try
f ();
None
with e ->
Some e
let assert_raises ?msg exn (f: unit -> 'a) =
let pexn =
Printexc.to_string
in
let get_error_string () =
let str =
Format.sprintf
"expected exception %s, but no exception was raised."
(pexn exn)
in
match msg with
| None ->
assert_failure str
| Some s ->
assert_failure (Format.sprintf "%s\n%s" s str)
in
match raises f with
| None ->
assert_failure (get_error_string ())
| Some e ->
assert_equal ?msg ~printer:pexn exn e
(* Compare floats up to a given relative error *)
let cmp_float ?(epsilon = 0.00001) a b =
abs_float (a -. b) <= epsilon *. (abs_float a) ||
abs_float (a -. b) <= epsilon *. (abs_float b)
(* Now some handy shorthands *)
let (@?) = assert_bool
(* The type of test function *)
type test_fun = unit -> unit
(* The type of tests *)
type test =
| TestCase of test_fun
| TestList of test list
| TestLabel of string * test
(* Some shorthands which allows easy test construction *)
let (>:) s t = TestLabel(s, t) (* infix *)
let (>::) s f = TestLabel(s, TestCase(f)) (* infix *)
let (>:::) s l = TestLabel(s, TestList(l)) (* infix *)
(* Utility function to manipulate test *)
let rec test_decorate g =
function
| TestCase f ->
TestCase (g f)
| TestList tst_lst ->
TestList (List.map (test_decorate g) tst_lst)
| TestLabel (str, tst) ->
TestLabel (str, test_decorate g tst)
(* Return the number of available tests *)
let rec test_case_count =
function
| TestCase _ ->
1
| TestLabel (_, t) ->
test_case_count t
| TestList l ->
List.fold_left
(fun c t -> c + test_case_count t)
0 l
type node =
| ListItem of int
| Label of string
type path = node list
let string_of_node =
function
| ListItem n ->
string_of_int n
| Label s ->
s
let string_of_path path =
String.concat ":" (List.rev_map string_of_node path)
(* Some helper function, they are generally applicable *)
(* Applies function f in turn to each element in list. Function f takes
one element, and integer indicating its location in the list *)
let mapi f l =
let rec rmapi cnt l =
match l with
| [] ->
[]
| h :: t ->
(f h cnt) :: (rmapi (cnt + 1) t)
in
rmapi 0 l
let fold_lefti f accu l =
let rec rfold_lefti cnt accup l =
match l with
| [] ->
accup
| h::t ->
rfold_lefti (cnt + 1) (f accup h cnt) t
in
rfold_lefti 0 accu l
(* Returns all possible paths in the test. The order is from test case
to root
*)
let test_case_paths test =
let rec tcps path test =
match test with
| TestCase _ ->
[path]
| TestList tests ->
List.concat
(mapi (fun t i -> tcps ((ListItem i)::path) t) tests)
| TestLabel (l, t) ->
tcps ((Label l)::path) t
in
tcps [] test
(* Test filtering with their path *)
module SetTestPath = Set.Make(String)
let test_filter ?(skip=false) only test =
let set_test =
List.fold_left
(fun st str -> SetTestPath.add str st)
SetTestPath.empty
only
in
let rec filter_test path tst =
if SetTestPath.mem (string_of_path path) set_test then
begin
Some tst
end
else
begin
match tst with
| TestCase f ->
begin
if skip then
Some
(TestCase
(fun () ->
skip_if true "Test disabled";
f ()))
else
None
end
| TestList tst_lst ->
begin
let ntst_lst =
fold_lefti
(fun ntst_lst tst i ->
let nntst_lst =
match filter_test ((ListItem i) :: path) tst with
| Some tst ->
tst :: ntst_lst
| None ->
ntst_lst
in
nntst_lst)
[]
tst_lst
in
if not skip && ntst_lst = [] then
None
else
Some (TestList (List.rev ntst_lst))
end
| TestLabel (lbl, tst) ->
begin
let ntst_opt =
filter_test
((Label lbl) :: path)
tst
in
match ntst_opt with
| Some ntst ->
Some (TestLabel (lbl, ntst))
| None ->
if skip then
Some (TestLabel (lbl, tst))
else
None
end
end
in
filter_test [] test
(* The possible test results *)
type test_result =
| RSuccess of path
| RFailure of path * string
| RError of path * string
| RSkip of path * string
| RTodo of path * string
let is_success =
function
| RSuccess _ -> true
| RFailure _ | RError _ | RSkip _ | RTodo _ -> false
let is_failure =
function
| RFailure _ -> true
| RSuccess _ | RError _ | RSkip _ | RTodo _ -> false
let is_error =
function
| RError _ -> true
| RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> false
let is_skip =
function
| RSkip _ -> true
| RSuccess _ | RFailure _ | RError _ | RTodo _ -> false
let is_todo =
function
| RTodo _ -> true
| RSuccess _ | RFailure _ | RError _ | RSkip _ -> false
let result_flavour =
function
| RError _ -> "Error"
| RFailure _ -> "Failure"
| RSuccess _ -> "Success"
| RSkip _ -> "Skip"
| RTodo _ -> "Todo"
let result_path =
function
| RSuccess path
| RError (path, _)
| RFailure (path, _)
| RSkip (path, _)
| RTodo (path, _) -> path
let result_msg =
function
| RSuccess _ -> "Success"
| RError (_, msg)
| RFailure (_, msg)
| RSkip (_, msg)
| RTodo (_, msg) -> msg
(* Returns true if the result list contains successes only *)
let rec was_successful =
function
| [] -> true
| RSuccess _::t
| RSkip _::t ->
was_successful t
| RFailure _::_
| RError _::_
| RTodo _::_ ->
false
(* Events which can happen during testing *)
type test_event =
| EStart of path
| EEnd of path
| EResult of test_result
let maybe_backtrace () =
if Printexc.backtrace_status () then
"\n" ^ Printexc.get_backtrace ()
else ""
(* Run all tests, report starts, errors, failures, and return the results *)
let perform_test report test =
let run_test_case f path =
try
f ();
RSuccess path
with
| Failure s ->
RFailure (path, s ^ maybe_backtrace ())
| Skip s ->
RSkip (path, s)
| Todo s ->
RTodo (path, s)
| s ->
RError (path, Printexc.to_string s ^ maybe_backtrace ())
in
let rec run_test path results =
function
| TestCase(f) ->
begin
let result =
report (EStart path);
run_test_case f path
in
report (EResult result);
report (EEnd path);
result::results
end
| TestList (tests) ->
begin
fold_lefti
(fun results t cnt ->
run_test
((ListItem cnt)::path)
results t)
results tests
end
| TestLabel (label, t) ->
begin
run_test ((Label label)::path) results t
end
in
run_test [] [] test
(* Function which runs the given function and returns the running time
of the function, and the original result in a tuple *)
let time_fun f x y =
let begin_time = Unix.gettimeofday () in
(Unix.gettimeofday () -. begin_time, f x y)
(* A simple (currently too simple) text based test runner *)
let run_test_tt ?verbose test =
let verbose =
match verbose with
| Some v -> v
| None -> !global_verbose
in
let printf = Format.printf in
let separator1 =
String.make (get_margin ()) '='
in
let separator2 =
String.make (get_margin ()) '-'
in
let string_of_result =
function
| RSuccess _ ->
if verbose then "ok\n" else "."
| RFailure (_, _) ->
if verbose then "FAIL\n" else "F"
| RError (_, _) ->
if verbose then "ERROR\n" else "E"
| RSkip (_, _) ->
if verbose then "SKIP\n" else "S"
| RTodo (_, _) ->
if verbose then "TODO\n" else "T"
in
let report_event =
function
| EStart p ->
if verbose then printf "%s ...\n" (string_of_path p)
| EEnd _ ->
()
| EResult result ->
printf "%s@?" (string_of_result result)
in
let print_result_list results =
List.iter
(fun result ->
printf "%s\n%s: %s\n\n%s\n%s\n"
separator1
(result_flavour result)
(string_of_path (result_path result))
(result_msg result)
separator2)
results
in
(* Now start the test *)
let running_time, results = time_fun perform_test report_event test in
let errors = List.filter is_error results in
let failures = List.filter is_failure results in
let skips = List.filter is_skip results in
let todos = List.filter is_todo results in
if not verbose then printf "\n";
(* Print test report *)
print_result_list errors;
print_result_list failures;
printf "Ran: %d tests in: %.2f seconds.\n"
(List.length results) running_time;
(* Print final verdict *)
if was_successful results then
(
if skips = [] then
printf "OK"
else
printf "OK: Cases: %d Skip: %d\n"
(test_case_count test) (List.length skips)
)
else
printf "FAILED: Cases: %d Tried: %d Errors: %d \
Failures: %d Skip:%d Todo:%d\n"
(test_case_count test) (List.length results)
(List.length errors) (List.length failures)
(List.length skips) (List.length todos);
(* Return the results possibly for further processing *)
results
(* Call this one from you test suites *)
let run_test_tt_main ?(arg_specs=[]) ?(set_verbose=ignore) suite =
let only_test = ref [] in
let () =
Arg.parse
(Arg.align
[
"-verbose",
Arg.Set global_verbose,
" Run the test in verbose mode.";
"-only-test",
Arg.String (fun str -> only_test := str :: !only_test),
"path Run only the selected test";
"-list-test",
Arg.Unit
(fun () ->
List.iter
(fun pth ->
print_endline (string_of_path pth))
(test_case_paths suite);
exit 0),
" List tests";
] @ arg_specs
)
(fun x -> raise (Arg.Bad ("Bad argument : " ^ x)))
("usage: " ^ Sys.argv.(0) ^ " [-verbose] [-only-test path]*")
in
let nsuite =
if !only_test = [] then
suite
else
begin
match test_filter ~skip:true !only_test suite with
| Some test ->
test
| None ->
failwith ("Filtering test "^
(String.concat ", " !only_test)^
" lead to no test")
end
in
let result =
set_verbose !global_verbose;
run_test_tt ~verbose:!global_verbose nsuite
in
if not (was_successful result) then
exit 1
else
result
Property changes on: trunk/src/omega/tests/oUnit.ml
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property
Index: trunk/src/omega/tests/oUnitDiff.mli
===================================================================
--- trunk/src/omega/tests/oUnitDiff.mli (revision 4001)
+++ trunk/src/omega/tests/oUnitDiff.mli (revision 4002)
@@ -1,137 +1,139 @@
+(* $Id$ *)
+
(***********************************************************************)
(* The OUnit library *)
(* *)
(* Copyright (C) 2010 OCamlCore SARL *)
(* *)
(***********************************************************************)
(* Version 1.1.2, with minor modifications by Thorsten Ohl *)
(************************************************************************
The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL.
Permission is hereby granted, free of charge, to any person obtaining
a copy of this document and the OUnit software ("the Software"), to
deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute,
sublicense, and/or sell copies of the Software, and to permit persons
to whom the Software is furnished to do so, subject to the following
conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
The Software is provided ``as is'', without warranty of any kind,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose and noninfringement.
In no event shall Maas-Maarten Zeeman be liable for any claim, damages
or other liability, whether in an action of contract, tort or
otherwise, arising from, out of or in connection with the Software or
the use or other dealings in the software.
************************************************************************)
(** Unit tests for collection of elements
This module allows to define a more precise way to display differences
between collection of elements. When collection differ, the tester is
interested by what are the missing/extra elements. This module provides
a [diff] operation to spot the difference quickly between two sets of
elements.
Example:
{[
open OUnit;;
module EInt =
struct
type t = int
let compare = ( - )
let pp_print = Format.pp_print_int
let pp_print_sep = OUnitDiff.comma_separator
end
module ListInt = OUnitDiff.ListSimpleMake(EInt);;
let test_diff () =
ListInt.assert_equal
[1; 2; 3; 4; 5]
[1; 2; 5; 4]
;;
let _ =
run_test_tt_main ("test_diff" >:: test_diff)
;;
]}
when run this test outputs:
{[
OUnit: expected: 1, 2, 3, 4, 5 but got: 1, 2, 5, 4
differences: element number 2 differ (3 <> 5)
]}
@since 1.1.0
@author Sylvain Le Gall
*)
(** {2 Signatures} *)
(** Definition of an element
*)
module type DIFF_ELEMENT =
sig
(** Type of an element *)
type t
(** Pretty printer for an element *)
val pp_printer : Format.formatter -> t -> unit
(** Element comparison *)
val compare : t -> t -> int
(** Pretty print element separator *)
val pp_print_sep : Format.formatter -> unit -> unit
end
(** Definition of standard operations
*)
module type S =
sig
(** Type of an element *)
type e
(** Type of a collection of element *)
type t
(** Compare a collection of element *)
val compare : t -> t -> int
(** Pretty printer a collection of element *)
val pp_printer : Format.formatter -> t -> unit
(** Pretty printer for collection differences *)
val pp_diff : Format.formatter -> t * t -> unit
(** {!assert_equal} with [~diff], [~cmp] and [~printer] predefined for
this collection events
*)
val assert_equal : ?msg:string -> t -> t -> unit
(** Create [t] using of list *)
val of_list : e list -> t
end
(** {2 Implementations} *)
(** Collection of elements based on a Set, elements order doesn't matter *)
module SetMake : functor (D : DIFF_ELEMENT) -> S
with type e = D.t
(** Collection of elements based on a List, order matters but difference display
is very simple. It stops at the first element which differs.
*)
module ListSimpleMake : functor (D: DIFF_ELEMENT) -> S
with type e = D.t and type t = D.t list
val pp_comma_separator : Format.formatter -> unit -> unit
Property changes on: trunk/src/omega/tests/oUnitDiff.mli
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property
Index: trunk/src/omega/tests/oUnit.mli
===================================================================
--- trunk/src/omega/tests/oUnit.mli (revision 4001)
+++ trunk/src/omega/tests/oUnit.mli (revision 4002)
@@ -1,281 +1,283 @@
+(* $Id$ *)
+
(***********************************************************************)
(* The OUnit library *)
(* *)
(* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *)
(* Copyright (C) 2010 OCamlCore SARL *)
(* *)
(***********************************************************************)
(* Version 1.1.2, with minor modifications by Thorsten Ohl *)
(************************************************************************
The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL.
Permission is hereby granted, free of charge, to any person obtaining
a copy of this document and the OUnit software ("the Software"), to
deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute,
sublicense, and/or sell copies of the Software, and to permit persons
to whom the Software is furnished to do so, subject to the following
conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
The Software is provided ``as is'', without warranty of any kind,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose and noninfringement.
In no event shall Maas-Maarten Zeeman be liable for any claim, damages
or other liability, whether in an action of contract, tort or
otherwise, arising from, out of or in connection with the Software or
the use or other dealings in the software.
************************************************************************)
(** Unit test building blocks
@author Maas-Maarten Zeeman
@author Sylvain Le Gall
*)
(** {2 Assertions}
Assertions are the basic building blocks of unittests. *)
(** Signals a failure. This will raise an exception with the specified
string.
@raise Failure signal a failure *)
val assert_failure : string -> 'a
(** Signals a failure when bool is false. The string identifies the
failure.
@raise Failure signal a failure *)
val assert_bool : string -> bool -> unit
(** Shorthand for assert_bool
@raise Failure to signal a failure *)
val ( @? ) : string -> bool -> unit
(** Signals a failure when the string is non-empty. The string identifies the
failure.
@raise Failure signal a failure *)
val assert_string : string -> unit
(** [assert_command prg args] Run the command provided.
@param exit_code expected exit code
@param sinput provide this [char Stream.t] as input of the process
@param foutput run this function on output, it can contains an
[assert_equal] to check it
@param use_stderr redirect [stderr] to [stdout]
@param env Unix environment
@param verbose if a failure arise, dump stdout/stderr of the process to stderr
@since 1.1.0
*)
val assert_command :
?exit_code:Unix.process_status ->
?sinput:char Stream.t ->
?foutput:(char Stream.t -> unit) ->
?use_stderr:bool ->
?env:string array ->
?verbose:bool ->
string -> string list -> unit
(** [assert_equal expected real] Compares two values, when they are not equal a
failure is signaled.
@param cmp customize function to compare, default is [=]
@param printer value printer, don't print value otherwise
@param pp_diff if not equal, ask a custom display of the difference
using [diff fmt exp real] where [fmt] is the formatter to use
@param msg custom message to identify the failure
@raise Failure signal a failure
@version 1.1.0
*)
val assert_equal :
?cmp:('a -> 'a -> bool) ->
?printer:('a -> string) ->
?pp_diff:(Format.formatter -> ('a * 'a) -> unit) ->
?msg:string -> 'a -> 'a -> unit
(** Asserts if the expected exception was raised.
@param msg identify the failure
@raise Failure description *)
val assert_raises : ?msg:string -> exn -> (unit -> 'a) -> unit
(** {2 Skipping tests }
In certain condition test can be written but there is no point running it, because they
are not significant (missing OS features for example). In this case this is not a failure
nor a success. Following functions allow you to escape test, just as assertion but without
the same error status.
A test skipped is counted as success. A test todo is counted as failure.
*)
(** [skip cond msg] If [cond] is true, skip the test for the reason explain in [msg].
For example [skip_if (Sys.os_type = "Win32") "Test a doesn't run on windows"].
@since 1.0.3
*)
val skip_if : bool -> string -> unit
(** The associated test is still to be done, for the reason given.
@since 1.0.3
*)
val todo : string -> unit
(** {2 Compare Functions} *)
(** Compare floats up to a given relative error.
@param epsilon if the difference is smaller [epsilon] values are equal
*)
val cmp_float : ?epsilon:float -> float -> float -> bool
(** {2 Bracket}
A bracket is a functional implementation of the commonly used
setUp and tearDown feature in unittests. It can be used like this:
["MyTestCase" >:: (bracket test_set_up test_fun test_tear_down)]
*)
(** [bracket set_up test tear_down] The [set_up] function runs first, then
the [test] function runs and at the end [tear_down] runs. The
[tear_down] function runs even if the [test] failed and help to clean
the environment.
*)
val bracket: (unit -> 'a) -> ('a -> unit) -> ('a -> unit) -> unit -> unit
(** [bracket_tmpfile test] The [test] function takes a temporary filename
and matching output channel as arguments. The temporary file is created
before the test and removed after the test.
@param prefix see [Filename.open_temp_file]
@param suffix see [Filename.open_temp_file]
@param mode see [Filename.open_temp_file]
@since 1.1.0
*)
val bracket_tmpfile:
?prefix:string ->
?suffix:string ->
?mode:open_flag list ->
((string * out_channel) -> unit) -> unit -> unit
(** {2 Constructing Tests} *)
(** The type of test function *)
type test_fun = unit -> unit
(** The type of tests *)
type test =
TestCase of test_fun
| TestList of test list
| TestLabel of string * test
(** Create a TestLabel for a test *)
val (>:) : string -> test -> test
(** Create a TestLabel for a TestCase *)
val (>::) : string -> test_fun -> test
(** Create a TestLabel for a TestList *)
val (>:::) : string -> test list -> test
(** Some shorthands which allows easy test construction.
Examples:
- ["test1" >: TestCase((fun _ -> ()))] =>
[TestLabel("test2", TestCase((fun _ -> ())))]
- ["test2" >:: (fun _ -> ())] =>
[TestLabel("test2", TestCase((fun _ -> ())))]
- ["test-suite" >::: ["test2" >:: (fun _ -> ());]] =>
[TestLabel("test-suite", TestSuite([TestLabel("test2", TestCase((fun _ -> ())))]))]
*)
(** [test_decorate g tst] Apply [g] to test function contains in [tst] tree.
@since 1.0.3
*)
val test_decorate : (test_fun -> test_fun) -> test -> test
(** [test_filter paths tst] Filter test based on their path string representation.
@param skip] if set, just use [skip_if] for the matching tests.
@since 1.0.3
*)
val test_filter : ?skip:bool -> string list -> test -> test option
(** {2 Retrieve Information from Tests} *)
(** Returns the number of available test cases *)
val test_case_count : test -> int
(** Types which represent the path of a test *)
type node = ListItem of int | Label of string
type path = node list (** The path to the test (in reverse order). *)
(** Make a string from a node *)
val string_of_node : node -> string
(** Make a string from a path. The path will be reversed before it is
tranlated into a string *)
val string_of_path : path -> string
(** Returns a list with paths of the test *)
val test_case_paths : test -> path list
(** {2 Performing Tests} *)
(** The possible results of a test *)
type test_result =
RSuccess of path
| RFailure of path * string
| RError of path * string
| RSkip of path * string
| RTodo of path * string
(** Events which occur during a test run *)
type test_event =
EStart of path
| EEnd of path
| EResult of test_result
(** Perform the test, allows you to build your own test runner *)
val perform_test : (test_event -> 'a) -> test -> test_result list
(** A simple text based test runner. It prints out information
during the test.
@param verbose print verbose message
*)
val run_test_tt : ?verbose:bool -> test -> test_result list
(** Main version of the text based test runner. It reads the supplied command
line arguments to set the verbose level and limit the number of test to
run.
@param arg_specs add extra command line arguments
@param set_verbose call a function to set verbosity
@version 1.1.0
*)
val run_test_tt_main :
?arg_specs:(Arg.key * Arg.spec * Arg.doc) list ->
?set_verbose:(bool -> unit) ->
test -> test_result list
Property changes on: trunk/src/omega/tests/oUnit.mli
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property
Index: trunk/src/omega/tests/oUnitDiff.ml
===================================================================
--- trunk/src/omega/tests/oUnitDiff.ml (revision 4001)
+++ trunk/src/omega/tests/oUnitDiff.ml (revision 4002)
@@ -1,210 +1,212 @@
+(* $Id$ *)
+
(***********************************************************************)
(* The OUnit library *)
(* *)
(* Copyright (C) 2010 OCamlCore SARL *)
(* *)
(***********************************************************************)
(* Version 1.1.2, with minor modifications by Thorsten Ohl *)
(************************************************************************
The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL.
Permission is hereby granted, free of charge, to any person obtaining
a copy of this document and the OUnit software ("the Software"), to
deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute,
sublicense, and/or sell copies of the Software, and to permit persons
to whom the Software is furnished to do so, subject to the following
conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
The Software is provided ``as is'', without warranty of any kind,
express or implied, including but not limited to the warranties of
merchantability, fitness for a particular purpose and noninfringement.
In no event shall Maas-Maarten Zeeman be liable for any claim, damages
or other liability, whether in an action of contract, tort or
otherwise, arising from, out of or in connection with the Software or
the use or other dealings in the software.
************************************************************************)
open Format
module type DIFF_ELEMENT =
sig
type t
val pp_printer: Format.formatter -> t -> unit
val compare: t -> t -> int
val pp_print_sep: Format.formatter -> unit -> unit
end
module type S =
sig
type e
type t
val compare: t -> t -> int
val pp_printer: Format.formatter -> t -> unit
val pp_diff: Format.formatter -> (t * t) -> unit
val assert_equal: ?msg:string -> t -> t -> unit
val of_list: e list -> t
end
let assert_equal ?msg compare pp_printer pp_diff exp act =
OUnit.assert_equal
~cmp:(fun t1 t2 -> (compare t1 t2) = 0)
~printer:(fun t ->
let buff = Buffer.create 13 in
let fmt = formatter_of_buffer buff in
pp_printer fmt t;
pp_print_flush fmt ();
Buffer.contents buff)
~pp_diff
?msg
exp act
module SetMake (D: DIFF_ELEMENT) : S with type e = D.t =
struct
module Set = Set.Make(D)
type e = D.t
type t = Set.t
let compare =
Set.compare
let pp_printer fmt t =
let first = ref true in
pp_open_box fmt 0;
Set.iter
(fun e ->
if not !first then
D.pp_print_sep fmt ();
D.pp_printer fmt e;
first := false)
t;
pp_close_box fmt ()
let pp_diff fmt (t1, t2) =
let first = ref true in
let print_list c t =
Set.iter
(fun e ->
if not !first then
D.pp_print_sep fmt ();
pp_print_char fmt c;
D.pp_printer fmt e;
first := false)
t
in
pp_open_box fmt 0;
print_list '+' (Set.diff t2 t1);
print_list '-' (Set.diff t1 t2);
pp_close_box fmt ()
let assert_equal ?msg exp act =
assert_equal ?msg compare pp_printer pp_diff exp act
let of_list lst =
List.fold_left
(fun acc e ->
Set.add e acc)
Set.empty
lst
end
module ListSimpleMake (D: DIFF_ELEMENT) : S with type e = D.t and type t = D.t list =
struct
type e = D.t
type t = e list
let rec compare t1 t2 =
match t1, t2 with
| e1 :: tl1, e2 :: tl2 ->
begin
match D.compare e1 e2 with
| 0 ->
compare tl1 tl2
| n ->
n
end
| [], [] ->
0
| _, [] ->
-1
| [], _ ->
1
let pp_print_gen pre fmt t =
let first = ref true in
pp_open_box fmt 0;
List.iter
(fun e ->
if not !first then
D.pp_print_sep fmt ();
fprintf fmt "%s%a" pre D.pp_printer e;
first := false)
t;
pp_close_box fmt ()
let pp_printer fmt t =
pp_print_gen "" fmt t
let pp_diff fmt (t1, t2) =
let rec pp_diff' n t1 t2 =
match t1, t2 with
| e1 :: tl1, e2 :: tl2 ->
begin
match D.compare e1 e2 with
| 0 ->
pp_diff' (n + 1) tl1 tl2
| _ ->
fprintf fmt
"element number %d differ (%a <> %a)"
n
D.pp_printer e1
D.pp_printer e2
end
| [], [] ->
()
| [], lst ->
fprintf fmt "at end,@ ";
pp_print_gen "+" fmt lst
| lst, [] ->
fprintf fmt "at end,@ ";
pp_print_gen "-" fmt lst
in
pp_open_box fmt 0;
pp_diff' 0 t1 t2;
pp_close_box fmt ()
let assert_equal ?msg exp act =
assert_equal ?msg compare pp_printer pp_diff exp act
let of_list lst =
lst
end
let pp_comma_separator fmt () =
fprintf fmt ",@ "
Property changes on: trunk/src/omega/tests/oUnitDiff.ml
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property

File Metadata

Mime Type
text/x-diff
Expires
Tue, Nov 19, 2:50 PM (1 d, 12 h)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
3804834
Default Alt Text
(43 KB)

Event Timeline