File: testCommon.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 (97 lines) | stat: -rw-r--r-- 4,473 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
(**************************************************************************)
(* 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 OUnitTest
open OUnit2

let perform_test test =
  let null_logger = OUnitLogger.null_logger in
  let conf = OUnitConf.default () in
    OUnitCore.perform_test
      conf
      null_logger
      OUnitRunner.sequential_runner
      OUnitChooser.simple
      test

let assert_equal_test_result exp res =
  let norm lst =
   let norm_one (path, test_result, pos) =
     let test_result' =
       match test_result with
         | RSuccess -> RSuccess
         | RFailure (str, _, _) -> RFailure (str, None, None)
         | RError (str, _) -> RError(str, None)
         | RSkip str -> RSkip str
         | RTodo str -> RTodo str
         | RTimeout test_length -> RTimeout test_length
     in
       (path, test_result', pos)
   in
     List.sort Stdlib.compare (List.rev_map norm_one lst)
  in
  assert_equal
    ~cmp:
    (fun a b -> norm a = norm b)
    ~printer:
    (fun results ->
      String.concat "; "
        (List.map
           (fun (path, test_result, _) ->
              let spf fmt = Printf.sprintf fmt in
              let string_of_backtrace =
                function
                  | Some str -> spf "Some (%S)" str
                  | None -> "None"
              in
              let test_result_string =
                match test_result with
                  | RSuccess ->
                      "RSuccess"
                  | RFailure (str, _, backtrace) ->
                      spf "RFailure(%S, _, %s)"
                        str (string_of_backtrace backtrace)
                  | RError (str, backtrace) ->
                      spf "RError(%S, %s)" str (string_of_backtrace backtrace)
                  | RSkip str ->
                      spf "RSkip(%S)" str
                  | RTodo str ->
                      spf "RTodo(%S)" str
                  | RTimeout _ ->
                      "RTimeout(_)"
              in
                Printf.sprintf "%S, %s"
                  (OUnitTest.string_of_path path) test_result_string)
           (norm results)))
    exp res

let skip_if_notunix () = skip_if (Sys.os_type <> "Unix") "Only run on Unix."