File: testOUnit2.ml

package info (click to toggle)
ounit 2.2.7-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 712 kB
  • sloc: ml: 5,932; makefile: 69; javascript: 59; ansic: 9
file content (103 lines) | stat: -rw-r--r-- 4,178 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
(**************************************************************************)
(* The OUnit library                                                      *)
(*                                                                        *)
(* Copyright (C) 2002-2008 Maas-Maarten Zeeman.                           *)
(* Copyright (C) 2010 OCamlCore SARL                                      *)
(* Copyright (C) 2013 Sylvain Le Gall                                     *)
(*                                                                        *)
(* The package OUnit is copyright by Maas-Maarten Zeeman, OCamlCore SARL  *)
(* and Sylvain Le Gall.                                                   *)
(*                                                                        *)
(* 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.                             *)
(*                                                                        *)
(* See LICENSE.txt for details.                                           *)
(**************************************************************************)

open OUnit2

let test_normal = "Normal" >:: (fun _ -> ())
let test_assert = "Assert" >:: (fun _ -> assert_equal 1 1)
let test_todo = "Todo" >:: (fun _ -> todo "test")
let test_skip = "Skip" >:: (fun _ -> skip_if true "to be skipped")
let test_fail = "Fail" >:: (fun _ -> assert_equal 1 2)
let test_error = "Error" >:: (fun _ -> failwith "Not expected")

let test_ounit2 suite test_ctxt =
  let log_fn, _ = bracket_tmpfile test_ctxt in
  let conf =
    OUnitConf.default
      ~preset:["chooser", "simple";
               "runner", "sequential";
               "output_file", log_fn;
               "display", "false"]
      ()
  in
  let old_get_conf =
    (* TODO: acquire lock *)
    !OUnitCore.run_test_tt_main_conf
  in
  let [@warning "-27"] override_conf ?preset ?argv _ =
    OUnitCore.run_test_tt_main_conf := old_get_conf;
    (* TODO: release lock *)
    conf
  in
  let exit_code = ref 0 in
    OUnitCore.run_test_tt_main_conf := override_conf;
    run_test_tt_main ~exit:(fun i -> exit_code := i) suite;
    !exit_code, log_fn

let test_ok ctxt =
  let exit_code, _ =
    test_ounit2
      ("OK" >:::
       [test_normal;
        test_assert;
        test_skip])
      ctxt
  in
    assert_equal ~printer:string_of_int 0 exit_code

let test_ko =
  let one lst ctxt =
    let exit_code, _ =
      test_ounit2
        ("KO" >:::
         [test_normal;
          test_assert;
          test_skip] @ lst)
        ctxt
    in
      assert_equal ~printer:string_of_int 1 exit_code
  in
    List.map
      (fun lst -> test_case (one lst))
      [
        [test_todo];
        [test_fail];
        [test_error];
        [test_todo; test_fail; test_error];
      ]
(* Construct the test suite *)
let tests =
  "OUnit2" >:::
  [
    "test_ok" >:: test_ok;
    "test_ko" >::: test_ko;
  ]