-
Notifications
You must be signed in to change notification settings - Fork 16
/
extra.ml
60 lines (48 loc) · 1.62 KB
/
extra.ml
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
(*
Copyright (2010-2014) INCUBAID BVBA
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
*)
let eq_string str i1 i2 =
let msg = Printf.sprintf "%s expected:%s actual:%s" str i1 i2 in
OUnit.assert_equal ~msg i1 i2
let eq_int str i1 i2 =
let msg = Printf.sprintf "%s expected:%d actual:%d" str i1 i2 in
OUnit.assert_equal ~msg i1 i2
let eq_conv conv str i1 i2 =
let c1 = conv i1 and c2 = conv i2 in
let msg = Printf.sprintf "%s expected:%s actual:%s" str c1 c2 in
OUnit.assert_equal ~msg i1 i2
open Lwt
let lwt_bracket setup testcase teardown () =
let try_lwt_ f =
Lwt.catch f (fun exn -> Lwt.fail exn)
in
Lwt_main.run
begin
try_lwt_ setup >>= fun x ->
try_lwt_ (fun () ->
Lwt.finalize (fun () -> testcase x)
(fun () -> teardown x)
) >>= fun () ->
Lwt.return ()
end
let lwt_test_wrap testcase =
let setup = Lwt.return and teardown _ = Lwt.return () in
lwt_bracket setup testcase teardown
let timeout_thread timeout_sec f =
let sleep_sec = float_of_int (timeout_sec) in
let t =
begin
Lwt_unix.sleep sleep_sec >>= fun () ->
f ()
end in
let () = Lwt.ignore_result t in
t