@@ -75,7 +75,7 @@ open OUnitTypes
75
75
76
76
(* * Most simple heuristic, just pick the first test. *)
77
77
let simple state =
78
- (* 80 *) List. hd state.tests_planned
78
+ (* 81 *) 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 _ -> (* 160 *) false
101
+ | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 162 *) false
102
102
103
103
let is_error =
104
104
function
105
105
| RError _ -> (* 0 *) true
106
- | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 160 *) false
106
+ | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 162 *) false
107
107
108
108
let is_skip =
109
109
function
110
110
| RSkip _ -> (* 0 *) true
111
- | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 160 *) false
111
+ | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 162 *) false
112
112
113
113
let is_todo =
114
114
function
115
115
| RTodo _ -> (* 0 *) true
116
- | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 160 *) false
116
+ | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 162 *) 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
- (* 240 *) was_successful t
148
+ (* 243 *) 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
- (* 320 *) string_of_int n
158
+ (* 324 *) string_of_int n
159
159
| Label s ->
160
- (* 480 *) s
160
+ (* 486 *) s
161
161
162
162
(* Return the number of available tests *)
163
163
let rec test_case_count =
164
164
function
165
- | TestCase _ -> (* 80 *) 1
166
- | TestLabel (_ , t ) -> (* 95 *) test_case_count t
165
+ | TestCase _ -> (* 81 *) 1
166
+ | TestLabel (_ , t ) -> (* 96 *) test_case_count t
167
167
| TestList l ->
168
168
(* 15 *) List. fold_left
169
- (fun c t -> (* 94 *) c + test_case_count t)
169
+ (fun c t -> (* 95 *) c + test_case_count t)
170
170
0 l
171
171
172
172
let string_of_path path =
173
- (* 160 *) String. concat " :" (List. rev_map string_of_node path)
173
+ (* 162 *) 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
(* 15 *) let rec rfold_lefti cnt accup l =
197
- (* 109 *) match l with
197
+ (* 110 *) match l with
198
198
| [] ->
199
199
(* 15 *) accup
200
200
201
201
| h ::t ->
202
- (* 94 *) rfold_lefti (cnt + 1 ) (f accup h cnt) t
202
+ (* 95 *) 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
- (* 482 *) match event_type with
220
+ (* 488 *) match event_type with
221
221
| GlobalEvent e ->
222
222
(* 2 *) begin
223
223
match e with
@@ -276,18 +276,18 @@ let format_event verbose event_type =
276
276
end
277
277
278
278
| TestEvent e ->
279
- (* 480 *) begin
279
+ (* 486 *) begin
280
280
let string_of_result =
281
281
if verbose then
282
282
function
283
- | RSuccess _ -> (* 80 *) " ok\n "
283
+ | RSuccess _ -> (* 81 *) " 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
289
function
290
- | RSuccess _ -> (* 80 *) " ."
290
+ | RSuccess _ -> (* 81 *) " ."
291
291
| RFailure (_ , _ ) -> (* 0 *) " F"
292
292
| RError (_ , _ ) -> (* 0 *) " E"
293
293
| RSkip (_ , _ ) -> (* 0 *) " S"
@@ -296,11 +296,11 @@ let format_event verbose event_type =
296
296
if verbose then
297
297
match e with
298
298
| EStart p ->
299
- (* 80 *) Printf. sprintf " %s start\n " (string_of_path p)
299
+ (* 81 *) Printf. sprintf " %s start\n " (string_of_path p)
300
300
| EEnd p ->
301
- (* 80 *) Printf. sprintf " %s end\n " (string_of_path p)
301
+ (* 81 *) Printf. sprintf " %s end\n " (string_of_path p)
302
302
| EResult result ->
303
- (* 80 *) string_of_result result
303
+ (* 81 *) string_of_result result
304
304
| ELog (lvl , str ) ->
305
305
(* 0 *) let prefix =
306
306
match lvl with
@@ -313,20 +313,20 @@ let format_event verbose event_type =
313
313
(* 0 *) str
314
314
else
315
315
match e with
316
- | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 160 *) " "
317
- | EResult result -> (* 80 *) string_of_result result
316
+ | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 162 *) " "
317
+ | EResult result -> (* 81 *) 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
- (* 241 *) output_string chn (format_event true ev);
323
+ (* 244 *) 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
- (* 241 *) print_string (format_event verbose ev);
329
+ (* 244 *) 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
- (* 241 *) std_log ev; file_log ev; log ev),
346
+ (* 244 *) std_log ev; file_log ev; log ev),
347
347
(fun () ->
348
348
(* 1 *) std_close () ; file_close () ; close () )
349
349
@@ -703,13 +703,13 @@ let assert_failure msg =
703
703
(* 0 *) failwith (" OUnit: " ^ msg)
704
704
705
705
let assert_bool msg b =
706
- (* 2001318 *) if not b then assert_failure msg
706
+ (* 2001320 *) if not b then assert_failure msg
707
707
708
708
let assert_string str =
709
709
(* 0 *) if not (str = " " ) then assert_failure str
710
710
711
711
let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual =
712
- (* 2001401 *) let get_error_string () =
712
+ (* 2001402 *) let get_error_string () =
713
713
(* 0 *) let res =
714
714
buff_format_printf
715
715
(fun fmt ->
@@ -925,7 +925,7 @@ let (@?) = assert_bool
925
925
926
926
(* Some shorthands which allows easy test construction *)
927
927
let (>:) s t = (* 0 *) TestLabel (s, t) (* infix *)
928
- let (>::) s f = (* 80 *) TestLabel (s, TestCase (f)) (* infix *)
928
+ let (>::) s f = (* 81 *) TestLabel (s, TestCase (f)) (* infix *)
929
929
let (>:::) s l = (* 15 *) TestLabel (s, TestList (l)) (* infix *)
930
930
931
931
(* Utility function to manipulate test *)
@@ -1061,7 +1061,7 @@ let maybe_backtrace = ""
1061
1061
(* Run all tests, report starts, errors, failures, and return the results *)
1062
1062
let perform_test report test =
1063
1063
(* 1 *) let run_test_case f path =
1064
- (* 80 *) try
1064
+ (* 81 *) try
1065
1065
f () ;
1066
1066
RSuccess path
1067
1067
with
@@ -1080,22 +1080,22 @@ let perform_test report test =
1080
1080
let rec flatten_test path acc =
1081
1081
function
1082
1082
| TestCase (f ) ->
1083
- (* 80 *) (path, f) :: acc
1083
+ (* 81 *) (path, f) :: acc
1084
1084
1085
1085
| TestList (tests ) ->
1086
1086
(* 15 *) fold_lefti
1087
1087
(fun acc t cnt ->
1088
- (* 94 *) flatten_test
1088
+ (* 95 *) flatten_test
1089
1089
((ListItem cnt)::path)
1090
1090
acc t)
1091
1091
acc tests
1092
1092
1093
1093
| TestLabel (label , t ) ->
1094
- (* 95 *) flatten_test ((Label label)::path) acc t
1094
+ (* 96 *) flatten_test ((Label label)::path) acc t
1095
1095
in
1096
1096
let test_cases = List. rev (flatten_test [] [] test) in
1097
1097
let runner (path , f ) =
1098
- (* 80 *) let result =
1098
+ (* 81 *) let result =
1099
1099
report (EStart path);
1100
1100
run_test_case f path
1101
1101
in
@@ -1104,18 +1104,18 @@ let perform_test report test =
1104
1104
result
1105
1105
in
1106
1106
let rec iter state =
1107
- (* 81 *) match state.tests_planned with
1107
+ (* 82 *) match state.tests_planned with
1108
1108
| [] ->
1109
1109
(* 1 *) state.results
1110
1110
| _ ->
1111
- (* 80 *) let (path, f) = ! global_chooser state in
1111
+ (* 81 *) let (path, f) = ! global_chooser state in
1112
1112
let result = runner (path, f) in
1113
1113
iter
1114
1114
{
1115
1115
results = result :: state .results;
1116
1116
tests_planned =
1117
1117
List. filter
1118
- (fun (path' , _ ) -> (* 3240 *) path <> path') state.tests_planned
1118
+ (fun (path' , _ ) -> (* 3321 *) path <> path') state.tests_planned
1119
1119
}
1120
1120
in
1121
1121
iter {results = [] ; tests_planned = test_cases}
@@ -1145,7 +1145,7 @@ let run_test_tt ?verbose test =
1145
1145
time_fun
1146
1146
perform_test
1147
1147
(fun ev ->
1148
- (* 240 *) log (OUnitLogger. TestEvent ev))
1148
+ (* 243 *) log (OUnitLogger. TestEvent ev))
1149
1149
test
1150
1150
in
1151
1151
@@ -8211,7 +8211,9 @@ sig
8211
8211
val last : t -> elt
8212
8212
val capacity : t -> int
8213
8213
val exists : (elt -> bool ) -> t -> bool
8214
+ val sub : t -> int -> int -> t
8214
8215
end
8216
+ external unsafe_sub : 'a array -> int -> int -> 'a array = " caml_array_sub"
8215
8217
8216
8218
type 'a t = {
8217
8219
mutable arr : 'a array ;
@@ -8224,7 +8226,7 @@ let compact d =
8224
8226
(* 0 *) let d_arr = d.arr in
8225
8227
if d.len <> Array. length d_arr then
8226
8228
begin
8227
- let newarr = Array. sub d_arr 0 d.len in
8229
+ let newarr = unsafe_sub d_arr 0 d.len in
8228
8230
d.arr < - newarr
8229
8231
end
8230
8232
let singleton v =
@@ -8263,10 +8265,10 @@ let of_list lst =
8263
8265
8264
8266
8265
8267
let to_array d =
8266
- (* 0 *) Array. sub d.arr 0 d.len
8268
+ (* 0 *) unsafe_sub d.arr 0 d.len
8267
8269
8268
8270
let of_array src =
8269
- (* 16 *) {
8271
+ (* 17 *) {
8270
8272
len = Array. length src;
8271
8273
arr = Array. copy src;
8272
8274
(* okay to call {!Array.copy}*)
@@ -8282,15 +8284,24 @@ let copy src =
8282
8284
(* 1 *) let len = src.len in
8283
8285
{
8284
8286
len ;
8285
- arr = Array. sub src.arr 0 len ;
8287
+ arr = unsafe_sub src.arr 0 len ;
8286
8288
}
8287
8289
(* FIXME *)
8288
8290
let reverse_in_place src =
8289
8291
(* 1 *) Ext_array. reverse_range src.arr 0 src.len
8290
8292
8291
- let sub src start len =
8292
- (* 0 *) { len ;
8293
- arr = Array. sub src.arr start len }
8293
+
8294
+
8295
+
8296
+ (* {!Array.sub} is not enough for error checking, it
8297
+ may contain some garbage
8298
+ *)
8299
+ let sub (src : _ t ) start len =
8300
+ (* 3 *) let src_len = src.len in
8301
+ if len < 0 || start > src_len - len then invalid_arg " Vec_gen.sub"
8302
+ else
8303
+ { len ;
8304
+ arr = unsafe_sub src.arr start len }
8294
8305
8295
8306
let iter f d =
8296
8307
(* 106 *) let arr = d.arr in
@@ -8391,10 +8402,10 @@ let filter f d =
8391
8402
new_d
8392
8403
8393
8404
let equal eq x y : bool =
8394
- (* 14 *) if x.len <> y.len then false
8405
+ (* 15 *) if x.len <> y.len then false
8395
8406
else
8396
8407
let rec aux x_arr y_arr i =
8397
- (* 85 *) if i < 0 then true else
8408
+ (* 88 *) if i < 0 then true else
8398
8409
if eq (Array. unsafe_get x_arr i) (Array. unsafe_get y_arr i) then
8399
8410
aux x_arr y_arr (i - 1 )
8400
8411
else false in
@@ -8559,7 +8570,7 @@ let null = 0 (* can be optimized *)
8559
8570
let init = Vec_gen. init
8560
8571
8561
8572
let make initsize : _ Vec_gen.t =
8562
- (* 1 *) if initsize < 0 then invalid_arg " Resize_array.make" ;
8573
+ (* 2 *) if initsize < 0 then invalid_arg " Resize_array.make" ;
8563
8574
{
8564
8575
8565
8576
len = 0 ;
@@ -8579,7 +8590,7 @@ let null = 0 (* can be optimized *)
8579
8590
d.arr < - new_d_arr
8580
8591
8581
8592
let push v (d : _ Vec_gen.t ) =
8582
- (* 335 *) let d_len = d.len in
8593
+ (* 337 *) let d_len = d.len in
8583
8594
let d_arr = d.arr in
8584
8595
let d_arr_len = Array. length d_arr in
8585
8596
if d_arr_len = 0 then
@@ -10687,7 +10698,7 @@ let v = Int_vec.init 10 (fun i -> (* 10 *) i);;
10687
10698
let (=~) x y = (* 0 *) OUnit. assert_equal ~cmp: (Int_vec. equal (fun (x : int ) y -> (* 0 *) x= y)) x y
10688
10699
let (=~~) x y
10689
10700
=
10690
- (* 14 *) OUnit. assert_equal ~cmp: (Int_vec. equal (fun (x : int ) y -> (* 71 *) x= y)) x (Int_vec. of_array y)
10701
+ (* 15 *) OUnit. assert_equal ~cmp: (Int_vec. equal (fun (x : int ) y -> (* 73 *) x= y)) x (Int_vec. of_array y)
10691
10702
10692
10703
let suites =
10693
10704
__FILE__
@@ -10713,7 +10724,16 @@ let suites =
10713
10724
v =~~ [|1 ;2 ;3 ;4 ;5 |]
10714
10725
end
10715
10726
;
10716
-
10727
+ " sub" > :: begin fun _ ->
10728
+ (* 1 *) let v = Int_vec. make 5 in
10729
+ OUnit. assert_bool __LOC__
10730
+ (try ignore @@ Int_vec. sub v 0 2 ; false with Invalid_argument _ -> true );
10731
+ Int_vec. push 1 v;
10732
+ OUnit. assert_bool __LOC__
10733
+ (try ignore @@ Int_vec. sub v 0 2 ; false with Invalid_argument _ -> true );
10734
+ Int_vec. push 2 v ;
10735
+ ( Int_vec. sub v 0 2 =~~ [|1 ;2 |])
10736
+ end;
10717
10737
" capacity" > :: begin fun _ ->
10718
10738
(* 1 *) let v = Int_vec. of_array [|3 |] in
10719
10739
Int_vec. reserve v 10 ;
0 commit comments