@@ -75,7 +75,7 @@ open OUnitTypes
7575
7676(* * Most simple heuristic, just pick the first test. *)
7777let simple state =
78- (* 80 *) List. hd state.tests_planned
78+ (* 81 *) List. hd state.tests_planned
7979
8080end
8181module OUnitUtils
@@ -98,22 +98,22 @@ let is_success =
9898let is_failure =
9999 function
100100 | RFailure _ -> (* 0 *) true
101- | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 160 *) false
101+ | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 162 *) false
102102
103103let is_error =
104104 function
105105 | RError _ -> (* 0 *) true
106- | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 160 *) false
106+ | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 162 *) false
107107
108108let is_skip =
109109 function
110110 | RSkip _ -> (* 0 *) true
111- | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 160 *) false
111+ | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 162 *) false
112112
113113let is_todo =
114114 function
115115 | RTodo _ -> (* 0 *) true
116- | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 160 *) false
116+ | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 162 *) false
117117
118118let result_flavour =
119119 function
@@ -145,7 +145,7 @@ let rec was_successful =
145145 | [] -> (* 3 *) true
146146 | RSuccess _::t
147147 | RSkip _ ::t ->
148- (* 240 *) was_successful t
148+ (* 243 *) was_successful t
149149
150150 | RFailure _::_
151151 | RError _::_
@@ -155,22 +155,22 @@ let rec was_successful =
155155let string_of_node =
156156 function
157157 | ListItem n ->
158- (* 320 *) string_of_int n
158+ (* 324 *) string_of_int n
159159 | Label s ->
160- (* 480 *) s
160+ (* 486 *) s
161161
162162(* Return the number of available tests *)
163163let rec test_case_count =
164164 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
167167 | TestList l ->
168168 (* 15 *) List. fold_left
169- (fun c t -> (* 94 *) c + test_case_count t)
169+ (fun c t -> (* 95 *) c + test_case_count t)
170170 0 l
171171
172172let 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)
174174
175175let buff_format_printf f =
176176 (* 0 *) let buff = Buffer. create 13 in
@@ -194,12 +194,12 @@ let mapi f l =
194194
195195let fold_lefti f accu l =
196196 (* 15 *) let rec rfold_lefti cnt accup l =
197- (* 109 *) match l with
197+ (* 110 *) match l with
198198 | [] ->
199199 (* 15 *) accup
200200
201201 | h ::t ->
202- (* 94 *) rfold_lefti (cnt + 1 ) (f accup h cnt) t
202+ (* 95 *) rfold_lefti (cnt + 1 ) (f accup h cnt) t
203203 in
204204 rfold_lefti 0 accu l
205205
@@ -217,7 +217,7 @@ open OUnitUtils
217217type event_type = GlobalEvent of global_event | TestEvent of test_event
218218
219219let format_event verbose event_type =
220- (* 482 *) match event_type with
220+ (* 488 *) match event_type with
221221 | GlobalEvent e ->
222222 (* 2 *) begin
223223 match e with
@@ -276,18 +276,18 @@ let format_event verbose event_type =
276276 end
277277
278278 | TestEvent e ->
279- (* 480 *) begin
279+ (* 486 *) begin
280280 let string_of_result =
281281 if verbose then
282282 function
283- | RSuccess _ -> (* 80 *) " ok\n "
283+ | RSuccess _ -> (* 81 *) " ok\n "
284284 | RFailure (_ , _ ) -> (* 0 *) " FAIL\n "
285285 | RError (_ , _ ) -> (* 0 *) " ERROR\n "
286286 | RSkip (_ , _ ) -> (* 0 *) " SKIP\n "
287287 | RTodo (_ , _ ) -> (* 0 *) " TODO\n "
288288 else
289289 function
290- | RSuccess _ -> (* 80 *) " ."
290+ | RSuccess _ -> (* 81 *) " ."
291291 | RFailure (_ , _ ) -> (* 0 *) " F"
292292 | RError (_ , _ ) -> (* 0 *) " E"
293293 | RSkip (_ , _ ) -> (* 0 *) " S"
@@ -296,11 +296,11 @@ let format_event verbose event_type =
296296 if verbose then
297297 match e with
298298 | EStart p ->
299- (* 80 *) Printf. sprintf " %s start\n " (string_of_path p)
299+ (* 81 *) Printf. sprintf " %s start\n " (string_of_path p)
300300 | EEnd p ->
301- (* 80 *) Printf. sprintf " %s end\n " (string_of_path p)
301+ (* 81 *) Printf. sprintf " %s end\n " (string_of_path p)
302302 | EResult result ->
303- (* 80 *) string_of_result result
303+ (* 81 *) string_of_result result
304304 | ELog (lvl , str ) ->
305305 (* 0 *) let prefix =
306306 match lvl with
@@ -313,20 +313,20 @@ let format_event verbose event_type =
313313 (* 0 *) str
314314 else
315315 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
318318 end
319319
320320let file_logger fn =
321321 (* 1 *) let chn = open_out fn in
322322 (fun ev ->
323- (* 241 *) output_string chn (format_event true ev);
323+ (* 244 *) output_string chn (format_event true ev);
324324 flush chn),
325325 (fun () -> (* 1 *) close_out chn)
326326
327327let std_logger verbose =
328328 (* 1 *) (fun ev ->
329- (* 241 *) print_string (format_event verbose ev);
329+ (* 244 *) print_string (format_event verbose ev);
330330 flush stdout),
331331 (fun () -> (* 1 *) () )
332332
@@ -343,7 +343,7 @@ let create output_file_opt verbose (log,close) =
343343 (* 0 *) null_logger
344344 in
345345 (fun ev ->
346- (* 241 *) std_log ev; file_log ev; log ev),
346+ (* 244 *) std_log ev; file_log ev; log ev),
347347 (fun () ->
348348 (* 1 *) std_close () ; file_close () ; close () )
349349
@@ -703,13 +703,13 @@ let assert_failure msg =
703703 (* 0 *) failwith (" OUnit: " ^ msg)
704704
705705let assert_bool msg b =
706- (* 2001318 *) if not b then assert_failure msg
706+ (* 2001320 *) if not b then assert_failure msg
707707
708708let assert_string str =
709709 (* 0 *) if not (str = " " ) then assert_failure str
710710
711711let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual =
712- (* 2001401 *) let get_error_string () =
712+ (* 2001402 *) let get_error_string () =
713713 (* 0 *) let res =
714714 buff_format_printf
715715 (fun fmt ->
@@ -925,7 +925,7 @@ let (@?) = assert_bool
925925
926926(* Some shorthands which allows easy test construction *)
927927let (>:) 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 *)
929929let (>:::) s l = (* 15 *) TestLabel (s, TestList (l)) (* infix *)
930930
931931(* Utility function to manipulate test *)
@@ -1061,7 +1061,7 @@ let maybe_backtrace = ""
10611061(* Run all tests, report starts, errors, failures, and return the results *)
10621062let perform_test report test =
10631063 (* 1 *) let run_test_case f path =
1064- (* 80 *) try
1064+ (* 81 *) try
10651065 f () ;
10661066 RSuccess path
10671067 with
@@ -1080,22 +1080,22 @@ let perform_test report test =
10801080 let rec flatten_test path acc =
10811081 function
10821082 | TestCase (f ) ->
1083- (* 80 *) (path, f) :: acc
1083+ (* 81 *) (path, f) :: acc
10841084
10851085 | TestList (tests ) ->
10861086 (* 15 *) fold_lefti
10871087 (fun acc t cnt ->
1088- (* 94 *) flatten_test
1088+ (* 95 *) flatten_test
10891089 ((ListItem cnt)::path)
10901090 acc t)
10911091 acc tests
10921092
10931093 | TestLabel (label , t ) ->
1094- (* 95 *) flatten_test ((Label label)::path) acc t
1094+ (* 96 *) flatten_test ((Label label)::path) acc t
10951095 in
10961096 let test_cases = List. rev (flatten_test [] [] test) in
10971097 let runner (path , f ) =
1098- (* 80 *) let result =
1098+ (* 81 *) let result =
10991099 report (EStart path);
11001100 run_test_case f path
11011101 in
@@ -1104,18 +1104,18 @@ let perform_test report test =
11041104 result
11051105 in
11061106 let rec iter state =
1107- (* 81 *) match state.tests_planned with
1107+ (* 82 *) match state.tests_planned with
11081108 | [] ->
11091109 (* 1 *) state.results
11101110 | _ ->
1111- (* 80 *) let (path, f) = ! global_chooser state in
1111+ (* 81 *) let (path, f) = ! global_chooser state in
11121112 let result = runner (path, f) in
11131113 iter
11141114 {
11151115 results = result :: state .results;
11161116 tests_planned =
11171117 List. filter
1118- (fun (path' , _ ) -> (* 3240 *) path <> path') state.tests_planned
1118+ (fun (path' , _ ) -> (* 3321 *) path <> path') state.tests_planned
11191119 }
11201120 in
11211121 iter {results = [] ; tests_planned = test_cases}
@@ -1145,7 +1145,7 @@ let run_test_tt ?verbose test =
11451145 time_fun
11461146 perform_test
11471147 (fun ev ->
1148- (* 240 *) log (OUnitLogger. TestEvent ev))
1148+ (* 243 *) log (OUnitLogger. TestEvent ev))
11491149 test
11501150 in
11511151
@@ -8211,7 +8211,9 @@ sig
82118211 val last : t -> elt
82128212 val capacity : t -> int
82138213 val exists : (elt -> bool ) -> t -> bool
8214+ val sub : t -> int -> int -> t
82148215end
8216+ external unsafe_sub : 'a array -> int -> int -> 'a array = " caml_array_sub"
82158217
82168218type 'a t = {
82178219 mutable arr : 'a array ;
@@ -8224,7 +8226,7 @@ let compact d =
82248226 (* 0 *) let d_arr = d.arr in
82258227 if d.len <> Array. length d_arr then
82268228 begin
8227- let newarr = Array. sub d_arr 0 d.len in
8229+ let newarr = unsafe_sub d_arr 0 d.len in
82288230 d.arr < - newarr
82298231 end
82308232let singleton v =
@@ -8263,10 +8265,10 @@ let of_list lst =
82638265
82648266
82658267let to_array d =
8266- (* 0 *) Array. sub d.arr 0 d.len
8268+ (* 0 *) unsafe_sub d.arr 0 d.len
82678269
82688270let of_array src =
8269- (* 16 *) {
8271+ (* 17 *) {
82708272 len = Array. length src;
82718273 arr = Array. copy src;
82728274 (* okay to call {!Array.copy}*)
@@ -8282,15 +8284,24 @@ let copy src =
82828284 (* 1 *) let len = src.len in
82838285 {
82848286 len ;
8285- arr = Array. sub src.arr 0 len ;
8287+ arr = unsafe_sub src.arr 0 len ;
82868288 }
82878289(* FIXME *)
82888290let reverse_in_place src =
82898291 (* 1 *) Ext_array. reverse_range src.arr 0 src.len
82908292
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 }
82948305
82958306let iter f d =
82968307 (* 106 *) let arr = d.arr in
@@ -8391,10 +8402,10 @@ let filter f d =
83918402 new_d
83928403
83938404let equal eq x y : bool =
8394- (* 14 *) if x.len <> y.len then false
8405+ (* 15 *) if x.len <> y.len then false
83958406 else
83968407 let rec aux x_arr y_arr i =
8397- (* 85 *) if i < 0 then true else
8408+ (* 88 *) if i < 0 then true else
83988409 if eq (Array. unsafe_get x_arr i) (Array. unsafe_get y_arr i) then
83998410 aux x_arr y_arr (i - 1 )
84008411 else false in
@@ -8559,7 +8570,7 @@ let null = 0 (* can be optimized *)
85598570 let init = Vec_gen. init
85608571
85618572 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" ;
85638574 {
85648575
85658576 len = 0 ;
@@ -8579,7 +8590,7 @@ let null = 0 (* can be optimized *)
85798590 d.arr < - new_d_arr
85808591
85818592 let push v (d : _ Vec_gen.t ) =
8582- (* 335 *) let d_len = d.len in
8593+ (* 337 *) let d_len = d.len in
85838594 let d_arr = d.arr in
85848595 let d_arr_len = Array. length d_arr in
85858596 if d_arr_len = 0 then
@@ -10687,7 +10698,7 @@ let v = Int_vec.init 10 (fun i -> (* 10 *) i);;
1068710698let (=~) x y = (* 0 *) OUnit. assert_equal ~cmp: (Int_vec. equal (fun (x : int ) y -> (* 0 *) x= y)) x y
1068810699let (=~~) x y
1068910700 =
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)
1069110702
1069210703let suites =
1069310704 __FILE__
@@ -10713,7 +10724,16 @@ let suites =
1071310724 v =~~ [|1 ;2 ;3 ;4 ;5 |]
1071410725 end
1071510726 ;
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;
1071710737 " capacity" > :: begin fun _ ->
1071810738 (* 1 *) let v = Int_vec. of_array [|3 |] in
1071910739 Int_vec. reserve v 10 ;
0 commit comments