@@ -75,7 +75,7 @@ open OUnitTypes
75
75
76
76
(** Most simple heuristic, just pick the first test. *)
77
77
let simple state =
78
- (* 118 *) List.hd state.tests_planned
78
+ (* 119 *) List.hd state.tests_planned
79
79
80
80
end
81
81
module OUnitUtils
@@ -98,22 +98,22 @@ let is_success =
98
98
let is_failure =
99
99
function
100
100
| RFailure _ -> (* 0 *) true
101
- | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 236 *) false
101
+ | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 238 *) false
102
102
103
103
let is_error =
104
104
function
105
105
| RError _ -> (* 0 *) true
106
- | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 236 *) false
106
+ | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 238 *) false
107
107
108
108
let is_skip =
109
109
function
110
110
| RSkip _ -> (* 0 *) true
111
- | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 236 *) false
111
+ | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 238 *) false
112
112
113
113
let is_todo =
114
114
function
115
115
| RTodo _ -> (* 0 *) true
116
- | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 236 *) false
116
+ | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 238 *) false
117
117
118
118
let result_flavour =
119
119
function
@@ -145,7 +145,7 @@ let rec was_successful =
145
145
| [] -> (* 3 *) true
146
146
| RSuccess _::t
147
147
| RSkip _::t ->
148
- (* 354 *) was_successful t
148
+ (* 357 *) was_successful t
149
149
150
150
| RFailure _::_
151
151
| RError _::_
@@ -155,22 +155,22 @@ let rec was_successful =
155
155
let string_of_node =
156
156
function
157
157
| ListItem n ->
158
- (* 472 *) string_of_int n
158
+ (* 476 *) string_of_int n
159
159
| Label s ->
160
- (* 708 *) s
160
+ (* 714 *) s
161
161
162
162
(* Return the number of available tests *)
163
163
let rec test_case_count =
164
164
function
165
- | TestCase _ -> (* 118 *) 1
166
- | TestLabel (_, t) -> (* 139 *) test_case_count t
165
+ | TestCase _ -> (* 119 *) 1
166
+ | TestLabel (_, t) -> (* 140 *) test_case_count t
167
167
| TestList l ->
168
168
(* 21 *) List.fold_left
169
- (fun c t -> (* 138 *) c + test_case_count t)
169
+ (fun c t -> (* 139 *) c + test_case_count t)
170
170
0 l
171
171
172
172
let string_of_path path =
173
- (* 236 *) String.concat ":" (List.rev_map string_of_node path)
173
+ (* 238 *) String.concat ":" (List.rev_map string_of_node path)
174
174
175
175
let buff_format_printf f =
176
176
(* 0 *) let buff = Buffer.create 13 in
@@ -194,12 +194,12 @@ let mapi f l =
194
194
195
195
let fold_lefti f accu l =
196
196
(* 21 *) let rec rfold_lefti cnt accup l =
197
- (* 159 *) match l with
197
+ (* 160 *) match l with
198
198
| [] ->
199
199
(* 21 *) accup
200
200
201
201
| h::t ->
202
- (* 138 *) rfold_lefti (cnt + 1) (f accup h cnt) t
202
+ (* 139 *) rfold_lefti (cnt + 1) (f accup h cnt) t
203
203
in
204
204
rfold_lefti 0 accu l
205
205
@@ -217,7 +217,7 @@ open OUnitUtils
217
217
type event_type = GlobalEvent of global_event | TestEvent of test_event
218
218
219
219
let format_event verbose event_type =
220
- (* 710 *) match event_type with
220
+ (* 716 *) match event_type with
221
221
| GlobalEvent e ->
222
222
(* 2 *) begin
223
223
match e with
@@ -276,31 +276,31 @@ let format_event verbose event_type =
276
276
end
277
277
278
278
| TestEvent e ->
279
- (* 708 *) begin
279
+ (* 714 *) begin
280
280
let string_of_result =
281
281
if verbose then
282
- (* 354 *) function
283
- | RSuccess _ -> (* 118 *) "ok\n"
282
+ (* 357 *) function
283
+ | RSuccess _ -> (* 119 *) "ok\n"
284
284
| RFailure (_, _) -> (* 0 *) "FAIL\n"
285
285
| RError (_, _) -> (* 0 *) "ERROR\n"
286
286
| RSkip (_, _) -> (* 0 *) "SKIP\n"
287
287
| RTodo (_, _) -> (* 0 *) "TODO\n"
288
288
else
289
- (* 354 *) function
290
- | RSuccess _ -> (* 118 *) "."
289
+ (* 357 *) function
290
+ | RSuccess _ -> (* 119 *) "."
291
291
| RFailure (_, _) -> (* 0 *) "F"
292
292
| RError (_, _) -> (* 0 *) "E"
293
293
| RSkip (_, _) -> (* 0 *) "S"
294
294
| RTodo (_, _) -> (* 0 *) "T"
295
295
in
296
296
if verbose then
297
- (* 354 *) match e with
297
+ (* 357 *) match e with
298
298
| EStart p ->
299
- (* 118 *) Printf.sprintf "%s start\n" (string_of_path p)
299
+ (* 119 *) Printf.sprintf "%s start\n" (string_of_path p)
300
300
| EEnd p ->
301
- (* 118 *) Printf.sprintf "%s end\n" (string_of_path p)
301
+ (* 119 *) Printf.sprintf "%s end\n" (string_of_path p)
302
302
| EResult result ->
303
- (* 118 *) string_of_result result
303
+ (* 119 *) string_of_result result
304
304
| ELog (lvl, str) ->
305
305
(* 0 *) let prefix =
306
306
match lvl with
@@ -312,21 +312,21 @@ let format_event verbose event_type =
312
312
| ELogRaw str ->
313
313
(* 0 *) str
314
314
else
315
- (* 354 *) match e with
316
- | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 236 *) ""
317
- | EResult result -> (* 118 *) string_of_result result
315
+ (* 357 *) match e with
316
+ | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 238 *) ""
317
+ | EResult result -> (* 119 *) string_of_result result
318
318
end
319
319
320
320
let file_logger fn =
321
321
(* 1 *) let chn = open_out fn in
322
322
(fun ev ->
323
- (* 355 *) output_string chn (format_event true ev);
323
+ (* 358 *) output_string chn (format_event true ev);
324
324
flush chn),
325
325
(fun () -> (* 1 *) close_out chn)
326
326
327
327
let std_logger verbose =
328
328
(* 1 *) (fun ev ->
329
- (* 355 *) print_string (format_event verbose ev);
329
+ (* 358 *) print_string (format_event verbose ev);
330
330
flush stdout),
331
331
(fun () -> (* 1 *) ())
332
332
@@ -343,7 +343,7 @@ let create output_file_opt verbose (log,close) =
343
343
(* 0 *) null_logger
344
344
in
345
345
(fun ev ->
346
- (* 355 *) std_log ev; file_log ev; log ev),
346
+ (* 358 *) std_log ev; file_log ev; log ev),
347
347
(fun () ->
348
348
(* 1 *) std_close (); file_close (); close ())
349
349
@@ -705,7 +705,7 @@ let assert_failure msg =
705
705
(* 0 *) failwith ("OUnit: " ^ msg)
706
706
707
707
let assert_bool msg b =
708
- (* 2005362 *) if not b then (* 0 *) assert_failure msg
708
+ (* 2005363 *) if not b then (* 0 *) assert_failure msg
709
709
710
710
let assert_string str =
711
711
(* 0 *) if not (str = "") then (* 0 *) assert_failure str
@@ -951,7 +951,7 @@ let (@?) = assert_bool
951
951
952
952
(* Some shorthands which allows easy test construction *)
953
953
let (>:) s t = (* 0 *) TestLabel(s, t) (* infix *)
954
- let (>::) s f = (* 118 *) TestLabel(s, TestCase(f)) (* infix *)
954
+ let (>::) s f = (* 119 *) TestLabel(s, TestCase(f)) (* infix *)
955
955
let (>:::) s l = (* 21 *) TestLabel(s, TestList(l)) (* infix *)
956
956
957
957
(* Utility function to manipulate test *)
@@ -1087,7 +1087,7 @@ let maybe_backtrace = ""
1087
1087
(* Run all tests, report starts, errors, failures, and return the results *)
1088
1088
let perform_test report test =
1089
1089
(* 1 *) let run_test_case f path =
1090
- (* 118 *) try
1090
+ (* 119 *) try
1091
1091
f ();
1092
1092
RSuccess path
1093
1093
with
@@ -1106,22 +1106,22 @@ let perform_test report test =
1106
1106
let rec flatten_test path acc =
1107
1107
function
1108
1108
| TestCase(f) ->
1109
- (* 118 *) (path, f) :: acc
1109
+ (* 119 *) (path, f) :: acc
1110
1110
1111
1111
| TestList (tests) ->
1112
1112
(* 21 *) fold_lefti
1113
1113
(fun acc t cnt ->
1114
- (* 138 *) flatten_test
1114
+ (* 139 *) flatten_test
1115
1115
((ListItem cnt)::path)
1116
1116
acc t)
1117
1117
acc tests
1118
1118
1119
1119
| TestLabel (label, t) ->
1120
- (* 139 *) flatten_test ((Label label)::path) acc t
1120
+ (* 140 *) flatten_test ((Label label)::path) acc t
1121
1121
in
1122
1122
let test_cases = List.rev (flatten_test [] [] test) in
1123
1123
let runner (path, f) =
1124
- (* 118 *) let result =
1124
+ (* 119 *) let result =
1125
1125
report (EStart path);
1126
1126
run_test_case f path
1127
1127
in
@@ -1130,18 +1130,18 @@ let perform_test report test =
1130
1130
result
1131
1131
in
1132
1132
let rec iter state =
1133
- (* 119 *) match state.tests_planned with
1133
+ (* 120 *) match state.tests_planned with
1134
1134
| [] ->
1135
1135
(* 1 *) state.results
1136
1136
| _ ->
1137
- (* 118 *) let (path, f) = !global_chooser state in
1137
+ (* 119 *) let (path, f) = !global_chooser state in
1138
1138
let result = runner (path, f) in
1139
1139
iter
1140
1140
{
1141
1141
results = result :: state.results;
1142
1142
tests_planned =
1143
1143
List.filter
1144
- (fun (path', _) -> (* 7021 *) path <> path') state.tests_planned
1144
+ (fun (path', _) -> (* 7140 *) path <> path') state.tests_planned
1145
1145
}
1146
1146
in
1147
1147
iter {results = []; tests_planned = test_cases}
@@ -1171,7 +1171,7 @@ let run_test_tt ?verbose test =
1171
1171
time_fun
1172
1172
perform_test
1173
1173
(fun ev ->
1174
- (* 354 *) log (OUnitLogger.TestEvent ev))
1174
+ (* 357 *) log (OUnitLogger.TestEvent ev))
1175
1175
test
1176
1176
in
1177
1177
@@ -1894,33 +1894,33 @@ let equal (x : string) y = (* 0 *) x = y
1894
1894
1895
1895
1896
1896
let unsafe_is_sub ~sub i s j ~len =
1897
- (* 589 *) let rec check k =
1898
- (* 753 *) if k = len
1899
- then (* 33 *) true
1897
+ (* 681 *) let rec check k =
1898
+ (* 864 *) if k = len
1899
+ then (* 34 *) true
1900
1900
else
1901
- (* 720 *) String.unsafe_get sub (i+k) =
1901
+ (* 830 *) String.unsafe_get sub (i+k) =
1902
1902
String.unsafe_get s (j+k) && check (k+1)
1903
1903
in
1904
1904
j+len <= String.length s && check 0
1905
1905
1906
1906
1907
1907
exception Local_exit
1908
1908
let find ?(start=0) ~sub s =
1909
- (* 39 *) let n = String.length sub in
1909
+ (* 40 *) let n = String.length sub in
1910
1910
let s_len = String.length s in
1911
1911
let i = ref start in
1912
1912
try
1913
1913
while !i + n <= s_len do
1914
- (* 581 *) if unsafe_is_sub ~sub 0 s !i ~len:n then
1915
- (* 31 *) raise_notrace Local_exit;
1914
+ (* 673 *) if unsafe_is_sub ~sub 0 s !i ~len:n then
1915
+ (* 32 *) raise_notrace Local_exit;
1916
1916
incr i
1917
1917
done;
1918
1918
-1
1919
1919
with Local_exit ->
1920
- (* 31 *) !i
1920
+ (* 32 *) !i
1921
1921
1922
1922
let contain_substring s sub =
1923
- (* 9 *) find s ~sub >= 0
1923
+ (* 10 *) find s ~sub >= 0
1924
1924
1925
1925
(** TODO: optimize
1926
1926
avoid nonterminating when string is empty
@@ -3528,7 +3528,7 @@ let rec safe_dup fd =
3528
3528
end
3529
3529
3530
3530
let safe_close fd =
3531
- (* 18 *) try Unix.close fd with Unix.Unix_error(_,_,_) -> (* 0 *) ()
3531
+ (* 20 *) try Unix.close fd with Unix.Unix_error(_,_,_) -> (* 0 *) ()
3532
3532
3533
3533
3534
3534
type output = {
@@ -3538,7 +3538,7 @@ type output = {
3538
3538
}
3539
3539
3540
3540
let perform command args =
3541
- (* 9 *) let new_fd_in, new_fd_out = Unix.pipe () in
3541
+ (* 10 *) let new_fd_in, new_fd_out = Unix.pipe () in
3542
3542
let err_fd_in, err_fd_out = Unix.pipe () in
3543
3543
match Unix.fork () with
3544
3544
| 0 ->
@@ -3557,28 +3557,28 @@ let perform command args =
3557
3557
when all the descriptiors on a pipe's output are closed, a call to
3558
3558
[write] on its input kills the writing process (EPIPE).
3559
3559
*)
3560
- (* 9 *) safe_close new_fd_out ;
3560
+ (* 10 *) safe_close new_fd_out ;
3561
3561
safe_close err_fd_out ;
3562
3562
let in_chan = Unix.in_channel_of_descr new_fd_in in
3563
3563
let err_in_chan = Unix.in_channel_of_descr err_fd_in in
3564
3564
let buf = Buffer.create 1024 in
3565
3565
let err_buf = Buffer.create 1024 in
3566
3566
(try
3567
3567
while true do
3568
- (* 67 *) Buffer.add_string buf (input_line in_chan );
3568
+ (* 68 *) Buffer.add_string buf (input_line in_chan );
3569
3569
Buffer.add_char buf '\n'
3570
3570
done;
3571
3571
with
3572
- End_of_file -> (* 9 *) ()) ;
3572
+ End_of_file -> (* 10 *) ()) ;
3573
3573
(try
3574
3574
while true do
3575
- (* 106 *) Buffer.add_string err_buf (input_line err_in_chan );
3575
+ (* 109 *) Buffer.add_string err_buf (input_line err_in_chan );
3576
3576
Buffer.add_char err_buf '\n'
3577
3577
done;
3578
3578
with
3579
- End_of_file -> (* 9 *) ()) ;
3579
+ End_of_file -> (* 10 *) ()) ;
3580
3580
let exit_code = match snd @@ Unix.waitpid [] pid with
3581
- | Unix.WEXITED exit_code -> (* 9 *) exit_code
3581
+ | Unix.WEXITED exit_code -> (* 10 *) exit_code
3582
3582
| Unix.WSIGNALED _signal_number
3583
3583
| Unix.WSTOPPED _signal_number -> (* 0 *) 127 in
3584
3584
{
@@ -3589,7 +3589,7 @@ let perform command args =
3589
3589
3590
3590
3591
3591
let perform_bsc args =
3592
- (* 9 *) perform bsc_exe
3592
+ (* 10 *) perform bsc_exe
3593
3593
(Array.append
3594
3594
[|bsc_exe ;
3595
3595
"-bs-package-name" ; "bs-platform";
@@ -3606,7 +3606,7 @@ let perform_bsc args =
3606
3606
|] args)
3607
3607
3608
3608
let bsc_eval str =
3609
- (* 6 *) perform_bsc [|"-bs-eval"; str|]
3609
+ (* 7 *) perform_bsc [|"-bs-eval"; str|]
3610
3610
3611
3611
let debug_output o =
3612
3612
(* 0 *) Printf.printf "\nexit_code:%d\nstdout:%s\nstderr:%s\n"
@@ -3751,10 +3751,22 @@ external err :
3751
3751
external err :
3752
3752
?hi_should_error:([`a of int | `b of string ] [@bs.string]) ->
3753
3753
unit -> _ = "" [@@bs.obj]
3754
+ |} in
3755
+ OUnit.assert_bool __LOC__
3756
+ (Ext_string.contain_substring output.stderr "hi_should_error")
3757
+ end;
3758
+ __LOC__ >:: begin fun _ ->
3759
+ (* 1 *) let output = bsc_eval {|
3760
+ external err :
3761
+ ?hi_should_error:([`a of int | `b of string ] [@bs.string]) ->
3762
+ unit -> unit = "" [@@bs.val]
3754
3763
|} in
3755
3764
OUnit.assert_bool __LOC__
3756
3765
(Ext_string.contain_substring output.stderr "hi_should_error")
3757
3766
end
3767
+
3768
+
3769
+
3758
3770
]
3759
3771
end
3760
3772
module Ext_util : sig
0 commit comments