Codebase list ocaml-qcheck / 49bfa30
Update upstream source from tag 'upstream/0.18.1' Update to upstream version '0.18.1' with Debian dir ee727e61298f3f78c0528691e617a92dda47f78d Stephane Glondu authored 2 years ago Stephane Glondu committed 2 years ago
19 changed file(s) with 244 addition(s) and 98 deletion(s). Raw diff Collapse all Expand all
11 Rudi Grinberg <rudi.grinberg@gmail.com>
22 Jacques-Pascal Deplaix <jp.deplaix@gmail.com>
33 Jan Midtgaard <mail@janmidtgaard.dk>
4 Valentin Chaboche <valentin.chb@gmail.com>
00 # Changes
1
2 ## 0.18.1
3
4 - fix `Gen.{nat,pos}_split{2,}`
5 - fix stack overflow in #156
16
27 ## 0.18
38
401401
402402 ----
403403
404 === Deriver
405
406 A ppx_deriver is provided to derive QCheck generators from a type declaration.
407
408 ```ocaml
409 type tree = Leaf of int | Node of tree * tree
410 [@@deriving qcheck]
411 ```
412
413 See the according https://github.com/c-cube/qcheck/tree/master/src/ppx_deriving_qcheck/[README]
414 for more information and examples.
415
404416 === Compatibility notes
405417
406418 Starting with 0.9, the library is split into several components:
00 qcheck random seed: 1234
11 Testing `my test'.
2
32 [OK] suite 0 list_rev_is_involutive.
43 > [FAIL] suite 1 fail_sort_id.
54 [FAIL] suite 2 error_raise_exn.
65 [FAIL] suite 3 fail_check_err_message.
76 [OK] suite 4 tree_rev_is_involutive.
8
97 ┌──────────────────────────────────────────────────────────────────────────────┐
108 │ [FAIL] suite 1 fail_sort_id. │
119 └──────────────────────────────────────────────────────────────────────────────┘
12
1310 test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps)
14
1511 [exception] test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps)
16
17
18
1912 ──────────────────────────────────────────────────────────────────────────────
20
2113 3 failures! 5 tests run.
1010 | grep -v 'Logs saved to' \
1111 | grep -v 'Raised at ' \
1212 | grep -v 'Called from ' \
13 | sed 's/! in .*s\./!/'
13 | sed 's/! in .*s\./!/' \
14 | sed 's/[ \t]*$//g' \
15 | tr -s "\n"
1416 exit $CODE
44 license: "BSD-2-Clause"
55 synopsis: "Alcotest backend for qcheck"
66 doc: ["http://c-cube.github.io/qcheck/"]
7 version: "0.18"
7 version: "0.18.1"
88 tags: [
99 "test"
1010 "quickcheck"
44 license: "BSD-2-Clause"
55 synopsis: "Core qcheck library"
66 doc: ["http://c-cube.github.io/qcheck/"]
7 version: "0.18"
7 version: "0.18.1"
88 tags: [
99 "test"
1010 "property"
44 homepage: "https://github.com/c-cube/qcheck/"
55 doc: ["http://c-cube.github.io/qcheck/"]
66 synopsis: "OUnit backend for qcheck"
7 version: "0.18"
7 version: "0.18.1"
88 tags: [
99 "qcheck"
1010 "quickcheck"
44 homepage: "https://github.com/c-cube/qcheck/"
55 license: "BSD-2-Clause"
66 doc: ["http://c-cube.github.io/qcheck/"]
7 version: "0.18"
7 version: "0.18.1"
88 tags: [
99 "test"
1010 "property"
247247 List.sort (fun (w1, _) (w2, _) -> poly_compare w1 w2) samples |> List.rev_map snd
248248
249249 let range_subset ~size low high st =
250 if not (low <= high && size <= high - low + 1) then invalid_arg "Gen.range_subset";
250 let range_size = high - low + 1 in
251 if not (0 <= size && size <= range_size) then
252 invalid_arg "Gen.range_subset";
251253 (* The algorithm below is attributed to Floyd, see for example
252254 https://eyalsch.wordpress.com/2010/04/01/random-sample/
253255 https://math.stackexchange.com/questions/178690
254256
255 Note: the code be made faster by checking membership in [arr]
256 directly instead of using an additional Set. None of our
257 dependencies implements dichotomic search, so using Set is
258 easier.
257 Note: the code is easier to read when drawing from [0..range_size-1]
258 rather than [low..high]. We draw in [0..bound], and shift the
259 results by adding [low] when writing them to the result array.
259260 *)
260261 let module ISet = Set.Make(Int) in
261262 let s = ref ISet.empty in
262 let arr = Array.make size 0 in
263 for i = high - size to high do
264 let pos = int_range high i st in
265 let choice =
266 if ISet.mem pos !s then i else pos
267 in
268 arr.(i - low) <- choice;
263 for i = range_size - size to range_size - 1 do
264 let pos = int_range 0 i st in
265 let choice = if ISet.mem pos !s then i else pos in
269266 s := ISet.add choice !s;
270267 done;
268 let arr = Array.make size 0 in
269 let idx = ref 0 in
270 ISet.iter (fun choice -> arr.(!idx) <- low + choice; incr idx) !s;
271271 arr
272272
273273 let array_subset size arr st =
333333
334334 (* nat splitting *)
335335
336 let nat_split2 n st =
337 if (n < 2) then invalid_arg "nat_split2";
336 let pos_split2 n st =
337 if (n < 2) then invalid_arg "pos_split2";
338338 let n1 = int_range 1 (n - 1) st in
339339 (n1, n - n1)
340340
341 let pos_split2 n st =
341 let nat_split2 n st =
342 if (n < 0) then invalid_arg "nat_split2";
342343 let n1 = int_range 0 n st in
343344 (n1, n - n1)
344345
345346 let pos_split ~size:k n st =
346 if (k > n) then invalid_arg "nat_split";
347 (* To split n into n{0}+n{1}+..+n{k-1}, we draw distinct "boundaries"
348 b{-1}..b{k-1}, with b{-1}=0 and b{k-1} = n
349 and the k-1 intermediate boundaries b{0}..b{k-2}
350 chosen randomly distinct in [1;n-1].
351
352 Then each n{i} is defined as b{i}-b{i-1}. *)
353 let b = range_subset ~size:(k-1) 1 (n - 1) st in
354 Array.init k (fun i ->
355 if i = 0 then b.(0)
356 else if i = k-1 then n - b.(i-1)
357 else b.(i) - b.(i-1)
358 )
347 if (n < 0) then invalid_arg "pos_split";
348 if 0 = k && 0 = n then [||]
349 else begin
350 if not (0 < k && k <= n) then invalid_arg "pos_split";
351 (* To split n into n{0}+n{1}+..+n{k-1}, we draw distinct "boundaries"
352 b{-1}..b{k-1}, with b{-1}=0 and b{k-1} = n
353 and the k-1 intermediate boundaries b{0}..b{k-2}
354 chosen randomly distinct in [1;n-1].
355
356 Then each n{i} is defined as b{i}-b{i-1}. *)
357 let b = range_subset ~size:(k-1) 1 (n - 1) st in
358 if k = 1 then [|n|]
359 else Array.init k (fun i ->
360 if i = 0 then b.(0)
361 else if i = k-1 then n - b.(i-1)
362 else b.(i) - b.(i-1)
363 )
364 end
359365
360366 let nat_split ~size:k n st =
367 if not (0 <= k && 0 <= n) then invalid_arg "nat_split";
361368 pos_split ~size:k (n+k) st
362369 |> Array.map (fun v -> v - 1)
363370
466466
467467 This is useful to split sizes to combine sized generators.
468468
469 @raise Invalid_argument unless [n >= 2].
470
471469 @since 0.18
472470 *)
473471
474472 val pos_split2 : int -> (int * int) t
475 (** [nat_split2 n] generates pairs [(n1, n2)] of strictly positive
473 (** [pos_split2 n] generates pairs [(n1, n2)] of strictly positive
476474 (nonzero) natural numbers with [n1 + n2 = n].
475
476 @raise Invalid_argument unless [n >= 2].
477477
478478 This is useful to split sizes to combine sized generators.
479479
481481 *)
482482
483483 val nat_split : size:int -> int -> int array t
484 (** [nat_split2 ~size:k n] generates [k]-sized arrays [n1,n2,..nk]
484 (** [nat_split ~size:k n] generates [k]-sized arrays [n1,n2,..nk]
485485 of natural numbers in [[0;n]] with [n1 + n2 + ... + nk = n].
486486
487487 This is useful to split sizes to combine sized generators.
492492 *)
493493
494494 val pos_split : size:int -> int -> int array t
495 (** [nat_split2 ~size:k n] generates [k]-sized arrays [n1,n2,..nk]
495 (** [pos_split ~size:k n] generates [k]-sized arrays [n1,n2,..nk]
496496 of strictly positive (non-zero) natural numbers with
497497 [n1 + n2 + ... + nk = n].
498498
500500
501501 Complexity O(k log k).
502502
503 @raise Invalid_argument unless [k <= n].
503 @raise Invalid_argument unless [0 < k <= n] or [0 = k = n].
504504
505505 @since 0.18
506506 *)
527527
528528 let ui64 : int64 t = map Int64.abs int64
529529
530 (* A tail-recursive implementation over Tree.t *)
530531 let list_size (size : int t) (gen : 'a t) : 'a list t =
531 size >>= fun size ->
532 let rec loop n =
532 fun st ->
533 Tree.bind (size st) @@ fun size ->
534 let rec loop n acc =
533535 if n <= 0
534 then pure []
535 else liftA2 List.cons gen (loop (n - 1))
536 in
537 loop size
536 then acc
537 else (loop [@tailcall]) (n - 1) (Tree.liftA2 List.cons (gen st) acc)
538 in
539 loop size (Tree.pure [])
538540
539541 let list (gen : 'a t) : 'a list t = list_size nat gen
540542
3838 {[
3939 let test =
4040 QCheck2.(Test.make ~count:1000
41 ~pp:Print.(list int)
41 ~print:Print.(list int)
4242 Gen.(list int)
4343 (fun l -> List.rev (List.rev l) = l));;
4444
5757 Test.make
5858 ~name:"All lists are sorted"
5959 ~count:10_000
60 ~pp:Print.(list small_nat)
60 ~print:Print.(list int)
6161 Gen.(list small_nat)
6262 (fun l -> l = List.sort compare l));;
6363
222222 Printf.fprintf out "\n~~~ %a %s\n\n"
223223 (Color.pp_str_c ~colors `Cyan) "Shrink" (String.make 69 '~');
224224 Printf.fprintf out
225 "Test %s sucessfully shrunk counter example (step %d) to:\n\n%a\n%!"
225 "Test %s successfully shrunk counter example (step %d) to:\n\n%a\n%!"
226226 name i
227227 (debug_shrinking_counter_example cell) x
228228
9999 (** Run a suite of tests, and print its results. This is an heritage from
100100 the "qcheck" library.
101101 @return an error code, [0] if all tests passed, [1] otherwise.
102 @param colors if true, colorful output
103 @param verbose if true, prints more information about test cases *)
102 @param colors if true (default), colorful output
103 @param verbose if true, prints more information about test cases (default: [false])
104 @param long if true, runs the long versions of the tests (default: [false])
105 @param debug_shrink [debug_shrink:(Some ch)] writes a log of successful shrink
106 attempts to channel [ch], for example [~debug_shrink:(Some (open_out "mylog.txt"))].
107 Use together with a non-empty list in [~debug_shrink_list].
108 @param debug_shrink_list the test names to log successful shrink attempts for,
109 for example [~debug_shrink_list:["list_rev_is_involutive"]].
110 Requires [~debug_shrink] to be [Some ch].
111 @param out print output to the provided channel (default: [stdout])
112 @param rand start the test runner in the provided RNG state *)
104113
105114 val run_tests_main : ?argv:string array -> QCheck2.Test.t list -> 'a
106115 (** Can be used as the main function of a test file. Exits with a non-0 code
181181
182182 let strings_are_empty =
183183 Test.make ~name:"strings are empty" ~count:1000 ~print:Print.string
184 Gen.string (fun s -> (*Printf.printf "\"%s\"\n" (String.escaped s);*) s = "")
184 Gen.string (fun s -> s = "")
185185
186186 let string_never_has_000_char =
187187 Test.make ~name:"string never has a \\000 char" ~count:1000 ~print:Print.string
202202
203203 let list_shorter_10 =
204204 Test.make ~name:"lists shorter than 10" ~print:Print.(list int)
205 Gen.(list small_int) (fun xs -> (*print_list xs;*) List.length xs < 10)
205 Gen.(list small_int) (fun xs -> List.length xs < 10)
206206
207207 let length_printer xs =
208208 Printf.sprintf "[...] list length: %i" (List.length xs)
211211
212212 let list_shorter_432 =
213213 Test.make ~name:"lists shorter than 432" ~print:length_printer
214 Gen.(list_size size_gen small_int) (*Gen.(list small_int)*)
215 (fun xs -> (*print_list xs;*) List.length xs < 432)
214 Gen.(list_size size_gen small_int)
215 (fun xs -> List.length xs < 432)
216216
217217 let list_shorter_4332 =
218218 Test.make ~name:"lists shorter than 4332" ~print:length_printer
219 Gen.(list_size size_gen small_int) (*Gen.(list small_int)*)
220 (fun xs -> (*print_list xs;*) List.length xs < 4332)
219 Gen.(list_size size_gen small_int)
220 (fun xs -> List.length xs < 4332)
221221
222222 let list_equal_dupl =
223 Test.make ~name:"lists equal to duplication" ~print:length_printer
224 Gen.(list_size size_gen small_int) (*Gen.(list small_int)*)
223 Test.make ~name:"lists equal to duplication" ~print:Print.(list int)
224 Gen.(list_size size_gen small_int)
225225 (fun xs -> try xs = xs @ xs
226226 with Stack_overflow -> false)
227227
8282 true)
8383 end
8484
85 (* positive tests of the various generators *)
85 (* positive tests of the various generators
86
87 Note: it is important to disable shrinking for these tests, as the
88 shrinkers will suggest inputs that are coming from the generator
89 themselves -- which we want to test -- so their reduced
90 counter-example are confusing rather than helpful.
91
92 This is achieved by using (Test.make ~print ...), without a ~shrink
93 argument.
94 *)
8695 module Generator = struct
8796 open QCheck
8897
126135 ~name:"tree_rev_is_involutive"
127136 QCheck.(make IntTree.gen_tree)
128137 (fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree)
138
139 let nat_split2_spec =
140 Test.make ~name:"nat_split2 spec"
141 (make
142 ~print:Print.(pair int (pair int int))
143 Gen.(small_nat >>= fun n ->
144 pair (return n) (nat_split2 n)))
145 (fun (n, (a, b)) ->
146 0 <= a && 0 <= b && a + b = n)
147
148 let pos_split2_spec =
149 Test.make ~name:"pos_split2 spec"
150 (make
151 ~print:Print.(pair int (pair int int))
152 Gen.(small_nat >>= fun n ->
153 (* we need n > 2 *)
154 let n = n + 2 in
155 pair (return n) (pos_split2 n)))
156 (fun (n, (a, b)) ->
157 (0 < a && 0 < b && a + b = n))
158
159 let range_subset_spec =
160 Test.make ~name:"range_subset_spec"
161 (make
162 ~print:Print.(quad int int int (array int))
163 Gen.(pair small_nat small_nat >>= fun (m, n) ->
164 (* we must guarantee [low <= high]
165 and [size <= high - low + 1] *)
166 let low = m and high = m + n in
167 int_range 0 (high - low + 1) >>= fun size ->
168 quad (return size) (return low) (return high)
169 (range_subset ~size low high)))
170 (fun (size, low, high, arr) ->
171 if size = 0 then arr = [||]
172 else
173 Array.length arr = size
174 && low <= arr.(0)
175 && Array.for_all (fun (a, b) -> a < b)
176 (Array.init (size - 1) (fun k -> arr.(k), arr.(k+1)))
177 && arr.(size - 1) <= high)
178
179 let nat_split_n_way =
180 Test.make ~name:"nat_split n-way"
181 (make
182 ~print:Print.(pair int (array int))
183 Gen.(small_nat >>= fun n ->
184 pair (return n) (nat_split ~size:n n)))
185 (fun (n, arr) ->
186 Array.length arr = n
187 && Array.for_all (fun k -> 0 <= k) arr
188 && Array.fold_left (+) 0 arr = n)
189
190 let nat_split_smaller =
191 Test.make ~name:"nat_split smaller"
192 (make
193 ~print:Print.(triple int int (array int))
194 Gen.(small_nat >>= fun size ->
195 int_bound size >>= fun n ->
196 triple (return size) (return n) (nat_split ~size n)))
197 (fun (m, n, arr) ->
198 Array.length arr = m
199 && Array.for_all (fun k -> 0 <= k) arr
200 && Array.fold_left (+) 0 arr = n)
201
202 let pos_split =
203 Test.make ~name:"pos_split"
204 (make
205 ~print:Print.(triple int int (array int))
206 Gen.(pair small_nat small_nat >>= fun (m, n) ->
207 (* we need both size>0 and n>0 and size <= n *)
208 let size = 1 + min m n and n = 1 + max m n in
209 triple (return size) (return n) (pos_split ~size n)))
210 (fun (m, n, arr) ->
211 Array.length arr = m
212 && Array.for_all (fun k -> 0 < k) arr
213 && Array.fold_left (+) 0 arr = n)
129214 end
130215
131216 (* negative tests that exercise shrinking behaviour *)
177262
178263 let strings_are_empty =
179264 Test.make ~name:"strings are empty" ~count:1000
180 string (fun s -> (*Printf.printf "\"%s\"\n" (String.escaped s);*) s = "")
265 string (fun s -> s = "")
181266
182267 let string_never_has_000_char =
183268 Test.make ~name:"string never has a \\000 char" ~count:1000
197282
198283 let list_shorter_10 =
199284 Test.make ~name:"lists shorter than 10"
200 (list small_int) (fun xs -> (*print_list xs;*) List.length xs < 10)
285 (list small_int) (fun xs -> List.length xs < 10)
201286
202287 let length_printer xs =
203288 Printf.sprintf "[...] list length: %i" (List.length xs)
206291
207292 let list_shorter_432 =
208293 Test.make ~name:"lists shorter than 432"
209 (set_print length_printer (list_of_size size_gen small_int)) (*(list small_int)*)
210 (fun xs -> (*print_list xs;*) List.length xs < 432)
294 (set_print length_printer (list_of_size size_gen small_int))
295 (fun xs -> List.length xs < 432)
211296
212297 let list_shorter_4332 =
213298 Test.make ~name:"lists shorter than 4332"
214299 (set_shrink Shrink.list_spine (set_print length_printer (list_of_size size_gen small_int)))
215 (fun xs -> (*print_list xs;*) List.length xs < 4332)
300 (fun xs -> List.length xs < 4332)
216301
217302 let list_equal_dupl =
218303 Test.make ~name:"lists equal to duplication"
219 (set_print length_printer (list_of_size size_gen small_int))
220 (*(set_print length_printer (list small_int))*)
304 (list_of_size size_gen small_int)
221305 (fun xs -> try xs = xs @ xs
222306 with Stack_overflow -> false)
223307
385469 let tree_depth_test =
386470 let depth = ("depth", IntTree.depth) in
387471 Test.make ~name:"tree's depth" ~count:1000 (add_stat depth (make IntTree.gen_tree)) (fun _ -> true)
472
473 let range_subset_test =
474 Test.make ~name:"range_subset_spec" ~count:5_000
475 (add_stat ("dist", fun a -> a.(0)) (make (Gen.range_subset ~size:1 0 20)))
476 (fun a -> Array.length a = 1)
388477 end
389478
390479 (* Calling runners *)
407496 Generator.list_repeat_test;
408497 Generator.array_repeat_test;
409498 Generator.passing_tree_rev;
499 Generator.nat_split2_spec;
500 Generator.pos_split2_spec;
501 Generator.range_subset_spec;
502 Generator.nat_split_n_way;
503 Generator.nat_split_smaller;
504 Generator.pos_split;
410505 (*Shrink.test_fac_issue59;*)
411506 Shrink.big_bound_issue59;
412507 Shrink.long_shrink;
435530 FindExample.find_ex_uncaught_issue_99_2_succeed;
436531 Stats.bool_dist;
437532 Stats.char_dist;
438 Stats.tree_depth_test]
533 Stats.tree_depth_test;
534 Stats.range_subset_test]
439535 @ Stats.string_len_tests
440536 @ Stats.list_len_tests
441537 @ Stats.array_len_tests
317317
318318 --- Failure --------------------------------------------------------------------
319319
320 Test lists shorter than 432 failed:
321
322 ERROR: uncaught exception in generator for test lists shorter than 432 after 100 steps:
323 Exception: Stack overflow
324 Backtrace:
325
326 --- Failure --------------------------------------------------------------------
327
328 Test lists shorter than 4332 failed:
329
330 ERROR: uncaught exception in generator for test lists shorter than 4332 after 100 steps:
331 Exception: Stack overflow
332 Backtrace:
333
334 --- Failure --------------------------------------------------------------------
335
336 Test lists equal to duplication failed:
337
338 ERROR: uncaught exception in generator for test lists equal to duplication after 100 steps:
339 Exception: Stack overflow
340 Backtrace:
320 Test lists shorter than 432 failed (412 shrink steps):
321
322 [...] list length: 432
323
324 --- Failure --------------------------------------------------------------------
325
326 Test lists shorter than 4332 failed (4022 shrink steps):
327
328 [...] list length: 4332
329
330 --- Failure --------------------------------------------------------------------
331
332 Test lists equal to duplication failed (4 shrink steps):
333
334 [0]
341335
342336 --- Failure --------------------------------------------------------------------
343337
266266
267267 Test lists equal to duplication failed (20 shrink steps):
268268
269 [...] list length: 1
269 [0]
270270
271271 --- Failure --------------------------------------------------------------------
272272
376376 13: # 9
377377 14: # 7
378378 15: 4
379
380 +++ Stats for range_subset_spec ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
381
382 stats dist:
383 num: 5000, avg: 9.97, stddev: 6.08, median 10, min 0, max 20
384 0: ################################################# 246
385 1: ################################################ 244
386 2: ################################################ 240
387 3: ################################################ 243
388 4: ############################################## 232
389 5: ############################################## 230
390 6: ############################################### 239
391 7: ############################################### 235
392 8: ####################################################### 274
393 9: ############################################## 233
394 10: ########################################## 212
395 11: ############################################## 231
396 12: ############################################### 239
397 13: ############################################# 226
398 14: ############################################# 225
399 15: ################################################### 256
400 16: ################################################ 240
401 17: ############################################# 229
402 18: ################################################ 243
403 19: ################################################## 253
404 20: ############################################## 230
379405
380406 +++ Stats for string_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
381407
862888 4150517416584649600.. 4611686018427387903: ################# 189
863889 ================================================================================
864890 1 warning(s)
865 failure (26 tests failed, 1 tests errored, ran 66 tests)
891 failure (26 tests failed, 1 tests errored, ran 73 tests)
866892 random seed: 153870556
867893
868894 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++