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
include Monad
module Operators = struct
let ( >>= ) = bind
end
open Operators
let protect func ~finally =
let safe_finally () =
catch finally (fun exn trace ->
Testo_util.Error.user_error
(Printf.sprintf
"Internal error in test framework: exception raised by 'finally': \
%s\n\
%s\n"
(Printexc.to_string exn)
(Printexc.raw_backtrace_to_string trace)))
in
catch
(fun () ->
func () >>= fun res ->
safe_finally () >>= fun () -> return res)
(fun exn trace ->
safe_finally () >>= fun () -> Printexc.raise_with_backtrace exn trace)