Commit c8720808237b040a7e9bc65521e96a7cf3583f28 - ocaml-qcheck

+1

-0

.travis.yml less more

16	16	- OCAML_VERSION="4.07"
17	17	- OCAML_VERSION="4.08"
18	18	- OCAML_VERSION="4.09"
	19	- OCAML_VERSION="4.10"

+20

-0

CHANGELOG.md less more

0	0	# Changes
	1
	2	## 0.14
	3
	4	- modify `int_range` to make it accept ranges bigger than `max_int`.
	5	- less newline-verbose stats
	6	- add `int{32,64}` shrinkers to arbitrary gens
	7	- add `int{32,int64}` shrinkers
	8	- move to ounit2 for `QCheck_ounit`
	9
	10	## 0.13
	11
	12	- make counter private
	13	- Add debug shrinking log
	14	- fix: small fix related to stdlib/pervasives
	15	- feat: add flatten combinators in `gen`
	16
	17	## 0.12
	18
	19	- fix singleton list shrinking
	20	- feat: add `Gen.char_range` and `Gen.(<$>)` (credit @spewspews)
1	21
2	22	## 0.11
3	23

+1

-1

Makefile less more

19	19	@dune exec example/ounit/QCheck_ounit_test.exe
20	20
21	21	example-runner:
22		@dune exec example/QCheck_runner_test.exe
	22	@dune exec example/QCheck_runner_test.exe -- --debug-shrink=log.tmp
23	23
24	24	example-alcotest:
25	25	@dune exec example/alcotest/QCheck_alcotest_test.exe

+1

-1

README.adoc less more

292	292
293	293	=== Integration within OUnit
294	294
295		http://ounit.forge.ocamlcore.org/[OUnit] is a popular unit-testing framework
	295	https://github.com/gildor478/ounit[OUnit] is a popular unit-testing framework
296	296	for OCaml.
297	297	QCheck provides a sub-library `qcheck-ounit` with some helpers, in `QCheck_ounit`,
298	298	to convert its random tests into OUnit tests that can be part of a wider

+1

-0

dune-project less more

0	0	(lang dune 1.0)
	1	(name qcheck)

+1

-1

qcheck-alcotest.opam less more

3	3	homepage: "https://github.com/c-cube/qcheck/"
4	4	synopsis: "Alcotest backend for qcheck"
5	5	doc: ["http://c-cube.github.io/qcheck/"]
6		version: "0.11"
	6	version: "0.14"
7	7	tags: [
8	8	"test"
9	9	"quickcheck"

+1

-1

qcheck-core.opam less more

3	3	homepage: "https://github.com/c-cube/qcheck/"
4	4	synopsis: "Core qcheck library"
5	5	doc: ["http://c-cube.github.io/qcheck/"]
6		version: "0.11"
	6	version: "0.14"
7	7	tags: [
8	8	"test"
9	9	"property"

+2

-2

qcheck-ounit.opam less more

3	3	homepage: "https://github.com/c-cube/qcheck/"
4	4	doc: ["http://c-cube.github.io/qcheck/"]
5	5	synopsis: "OUnit backend for qcheck"
6		version: "0.11"
	6	version: "0.14"
7	7	tags: [
8	8	"qcheck"
9	9	"quickcheck"

19	19	"base-bytes"
20	20	"base-unix"
21	21	"qcheck-core" { = version }
22		"ounit" {>= "2.0"}
	22	"ounit2"
23	23	"odoc" {with-doc}
24	24	"ocaml" {>= "4.03.0"}
25	25	]

+1

-1

qcheck.opam less more

3	3	synopsis: "Compatibility package for qcheck"
4	4	homepage: "https://github.com/c-cube/qcheck/"
5	5	doc: ["http://c-cube.github.io/qcheck/"]
6		version: "0.11"
	6	version: "0.14"
7	7	tags: [
8	8	"test"
9	9	"property"

+55

-9

src/core/QCheck.ml less more

0
1	0	(*
2	1	QCheck: Random testing for OCaml
3	2	copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard

6	5
7	6	(** {1 Quickcheck inspired property-based testing} *)
8	7
	8	let poly_compare=compare
9	9	open Printf
10	10
11	11	module RS = Random.State

74	74	let map2 f x y st = f (x st) (y st)
75	75	let map3 f x y z st = f (x st) (y st) (z st)
76	76	let map_keep_input f gen st = let x = gen st in x, f x
77		let (>\|=) x f = map f x
	77	let (>\|=) x f st = f (x st)
	78	let (<$>) f x st = f (x st)
78	79
79	80	let oneof l st = List.nth l (Random.State.int st (List.length l)) st
80	81	let oneofl xs st = List.nth xs (Random.State.int st (List.length xs))

160	161	else fun st -> let r = pint st in r mod (n + 1)
161	162	let int_range a b =
162	163	if b < a then invalid_arg "Gen.int_range";
163		fun st -> a + (int_bound (b-a) st)
	164	if a >= 0 \|\| b <= 0 then (* range smaller than max_int *)
	165	fun st -> a + (int_bound (b-a) st)
	166	else
	167	(* range potentially bigger than max_int: we split on 0 and
	168	choose the itv wrt to their size ratio *)
	169	fun st ->
	170	let f_a = float_of_int a in
	171	let ratio = (-.f_a) /. (float_of_int b -. f_a) in
	172	if Random.float 1. < ratio then - (int_bound a st)
	173	else int_bound b st
	174
164	175	let (--) = int_range
165	176
166	177	(* NOTE: we keep this alias to not break code that uses [small_int]

171	182	if bool st
172	183	then small_nat st
173	184	else - (small_nat st)
	185
	186	let char_range a b = map Char.chr (Char.code a -- Char.code b)
174	187
175	188	let random_binary_string st length =
176	189	(* 0b011101... *)

195	208	let array gen st = array_size nat gen st
196	209	let array_repeat n g = array_size (return n) g
197	210
	211	let flatten_l l st = List.map (fun f->f st) l
	212	let flatten_a a st = Array.map (fun f->f st) a
	213	let flatten_opt o st =
	214	match o with
	215	\| None -> None
	216	\| Some f -> Some (f st)
	217	let flatten_res r st =
	218	match r with
	219	\| Ok f -> Ok (f st)
	220	\| Error e -> Error e
	221
198	222	let shuffle_a a st =
199	223	for i = Array.length a-1 downto 1 do
200	224	let j = Random.State.int st (i+1) in

214	238	(float_bound_inclusive 1. st ** (1. /. fl_w), v)
215	239	in
216	240	let samples = List.rev_map sample l in
217		List.sort (fun (w1, _) (w2, _) -> compare w1 w2) samples \|> List.rev_map snd
	241	List.sort (fun (w1, _) (w2, _) -> poly_compare w1 w2) samples \|> List.rev_map snd
218	242
219	243	let pair g1 g2 st = (g1 st, g2 st)
220	244

366	390	while !y < -2 \|\| !y >2 do y := !y / 2; yield (x - !y); done; (* fast path *)
367	391	if x>0 then yield (x-1);
368	392	if x<0 then yield (x+1);
	393	()
	394
	395	let int32 x yield =
	396	let open Int32 in
	397	let y = ref x in
	398	(* try some divisors *)
	399	while !y < -2l \|\| !y > 2l do y := div !y 2l; yield (sub x !y); done; (* fast path *)
	400	if x>0l then yield (pred x);
	401	if x<0l then yield (succ x);
	402	()
	403
	404	let int64 x yield =
	405	let open Int64 in
	406	let y = ref x in
	407	(* try some divisors *)
	408	while !y < -2L \|\| !y > 2L do y := div !y 2L; yield (sub x !y); done; (* fast path *)
	409	if x>0L then yield (pred x);
	410	if x<0L then yield (succ x);
369	411	()
370	412
371	413	(* aggressive shrinker for integers,

420	462
421	463	let list_spine l yield =
422	464	let n = List.length l in
423		let chunk_size = ref (n/2) in
	465	let chunk_size = ref ((n+1)/2) in
424	466
425	467	(* push the [n] first elements of [l] into [q], return the rest of the list *)
426	468	let rec fill_queue n l q = match n,l with

656	698	let small_int_corners () = make_int (Gen.nng_corners ())
657	699	let neg_int = make_int Gen.neg_int
658	700
659		let int32 = make_scalar ~print:(fun i -> Int32.to_string i ^ "l") Gen.ui32
660		let int64 = make_scalar ~print:(fun i -> Int64.to_string i ^ "L") Gen.ui64
	701	let int32 =
	702	make ~print:(fun i -> Int32.to_string i ^ "l") ~small:small1
	703	~shrink:Shrink.int32 Gen.ui32
	704	let int64 =
	705	make ~print:(fun i -> Int64.to_string i ^ "L") ~small:small1
	706	~shrink:Shrink.int64 Gen.ui64
661	707
662	708	let char = make_scalar ~print:(sprintf "%C") Gen.char
663	709	let printable_char = make_scalar ~print:(sprintf "%C") Gen.printable

1166	1212	(* all counter-examples in [l] have same size according to [small],
1167	1213	so we just compare to the first one, and we enforce
1168	1214	the invariant *)
1169		begin match Pervasives.compare (small instance) (small c_ex'.instance) with
	1215	begin match poly_compare (small instance) (small c_ex'.instance) with
1170	1216	\| 0 -> res.state <- Failed {instances=c_ex :: l} (* same size: add [c_ex] to [l] *)
1171	1217	\| n when n<0 -> res.state <- Failed {instances=[c_ex]} (* drop [l] *)
1172	1218	\| _ -> () (* drop [c_ex], not small enough *)

1569	1615	let median = ref 0 in
1570	1616	let median_num = ref 0 in (* how many values have we seen yet? once >= !n/2 we set median *)
1571	1617	(Hashtbl.fold (fun i cnt acc -> (i,cnt)::acc) tbl [])
1572		\|> List.sort (fun (i,_) (j,_) -> compare i j)
	1618	\|> List.sort (fun (i,_) (j,_) -> poly_compare i j)
1573	1619	\|> List.iter
1574	1620	(fun (i,cnt) ->
1575	1621	if !median_num < !num/2 then (

+63

-16

src/core/QCheck.mli less more

162	162	val (>\|=) : 'a t -> ('a -> 'b) -> 'b t
163	163	(** An infix synonym for {!map}. *)
164	164
	165	val (<$>) : ('a -> 'b) -> 'a t -> 'b t
	166	(** An infix synonym for {!map}
	167	@since 0.13 *)
	168
165	169	val oneof : 'a t list -> 'a t
166	170	(** Constructs a generator that selects among a given list of generators. *)
167	171

236	240
237	241	val nat : int t (** Generates small natural numbers. *)
238	242
239		val big_nat : int t (** Generates natural numbers, possibly large. @since 0.10 *)
240
241		val neg_int : int t (** Generates non-strictly negative integers (0 included). *)
	243	val big_nat : int t
	244	(** Generates natural numbers, possibly large.
	245	@since 0.10 *)
	246
	247	val neg_int : int t
	248	(** Generates non-strictly negative integers (0 included). *)
242	249
243	250	val pint : int t (** Generates non-strictly positive integers uniformly (0 included). *)
244	251
245	252	val int : int t (** Generates integers uniformly. *)
246	253
247		val small_nat : int t (** Small integers (< 100) @since 0.5.1 *)
	254	val small_nat : int t
	255	(** Small integers (< 100)
	256	@since 0.5.1 *)
248	257
249	258	val small_int : int t
250	259	(** Small UNSIGNED integers, for retrocompatibility.

261	270
262	271	val int_range : int -> int -> int t
263	272	(** Uniform integer generator producing integers within [low,high].
264		@raise Invalid_argument if [low > high] or if the range is larger than [max_int]. *)
	273	@raise Invalid_argument if [low > high]. *)
265	274
266	275	val graft_corners : 'a t -> 'a list -> unit -> 'a t
267	276	(** [graft_corners gen l ()] makes a new generator that enumerates

306	315
307	316	val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t (** Generates triples. *)
308	317
309		val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t (** Generates quadruples. @since 0.5.1 *)
310
311		val char : char t (** Generates characters upto character code 255. *)
	318	val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
	319	(** Generates quadruples.
	320	@since 0.5.1 *)
	321
	322	val char : char t
	323	(** Generates characters upto character code 255. *)
312	324
313	325	val printable : char t (** Generates printable characters. *)
314	326
315	327	val numeral : char t (** Generates numeral characters. *)
	328
	329	val char_range : char -> char -> char t
	330	(** Generates chars between the two bounds, inclusive.
	331	Example: [char_range 'a' 'z'] for all lower case ascii letters.
	332	@since 0.13 *)
316	333
317	334	val string_size : ?gen:char t -> int t -> string t
318	335	(** Builds a string generator from a (non-negative) size generator.

339	356	val small_list : 'a t -> 'a list t
340	357	(** Generates lists of small size (see {!small_nat}).
341	358	@since 0.5.3 *)
	359
	360	val flatten_l : 'a t list -> 'a list t
	361	(** Generate a list of elements from individual generators
	362	@since 0.13 *)
	363
	364	val flatten_a : 'a t array -> 'a array t
	365	(** Generate an array of elements from individual generators
	366	@since 0.13 *)
	367
	368	val flatten_opt : 'a t option -> 'a option t
	369	(** Generate an option from an optional generator
	370	@since 0.13 *)
	371
	372	val flatten_res : ('a t, 'e) result -> ('a,'e) result t
	373	(** Generate a result from [Ok g], an error from [Error e]
	374	@since 0.13 *)
342	375
343	376	val small_array : 'a t -> 'a array t
344	377	(** Generates arrays of small size (see {!small_nat}).

490	523	val char : char t (** @since 0.6 *)
491	524
492	525	val int : int t
	526
	527	val int32 : int32 t
	528	(** @since 0.14 *)
	529
	530	val int64 : int64 t
	531	(** @since 0.14 *)
493	532
494	533	val option : 'a t -> 'a option t
495	534

608	647	{b NOTE} the collect field is unstable and might be removed, or
609	648	moved into {!Test}.
610	649
611		Made private @since 0.8
	650	Made private since 0.8
612	651	*)
613	652
614	653	val make :

664	703	module TestResult : sig
665	704	type 'a counter_ex = {
666	705	instance: 'a; (** The counter-example(s) *)
	706
667	707	shrink_steps: int; (** How many shrinking steps for this counterex *)
668		msg_l: string list; (** messages. @since 0.7 *)
	708
	709	msg_l: string list;
	710	(** messages.
	711	@since 0.7 *)
669	712	}
670	713
671	714	type 'a failed_state = 'a counter_ex list

783	826	See {!make_cell} for a description of the parameters.
784	827	*)
785	828
786		(** {6 Running the test} *)
	829	(** {3 Running the test} *)
787	830
788	831	exception Test_fail of string * string list
789	832	(** Exception raised when a test failed, with the list of counter-examples.

915	958	@raise No_example_found if no example was found within [count] tries.
916	959	@since 0.6 *)
917	960
918		(** {2 Combinators for {!arbitrary}} *)
	961	(** {2 Combinators for arbitrary} *)
919	962
920	963	val choose : 'a arbitrary list -> 'a arbitrary
921	964	(** Choose among the given list of generators. The list must not

1077	1120	- when given the same argument (as decided by Pervasives.(=)), it returns the same value
1078	1121	- it never does side effects, like printing or never raise exceptions etc.
1079	1122	The functions generated are really printable.
1080		renamed from {!fun1}. @since 0.6
1081		@deprecated use {!fun_} instead. @since 0.6
	1123
	1124	renamed from {!fun1} since 0.6
	1125
	1126	@deprecated use {!fun_} instead.
	1127
	1128	@since 0.6
1082	1129	*)
1083	1130
1084	1131	val fun2_unsafe : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> ('a -> 'b -> 'c) arbitrary
1085	1132	(** Generator of functions of arity 2. The remark about [fun1] also apply
1086	1133	here.
1087		renamed from {!fun2}. @since 0.6
1088		@deprecated use {!fun_} instead. @since 0.6
	1134	renamed from {!fun2} since 0.6
	1135	@deprecated use {!fun_} instead since 0.6
1089	1136	*)
1090	1137
1091	1138	type _ fun_repr

+3

-2

src/ounit/QCheck_ounit.mli less more

16	16	(** Same as {!to_ounit_test} but with a polymorphic test cell *)
17	17
18	18	val (>:::) : string -> QCheck.Test.t list -> OUnit.test
19		(** Same as {!OUnit.>:::} but with a list of QCheck tests *)
	19	(** Same as [OUnit.(>:::)] but with a list of QCheck tests *)
20	20
21	21	val to_ounit2_test : ?rand:Random.State.t -> QCheck.Test.t -> OUnit2.test
22	22	(** [to_ounit2_test ?rand t] wraps [t] into a OUnit2 test

53	53	This test runner displays execution in a compact way, making it good
54	54	for suites that have lots of tests.
55	55
56		Output example: {v
	56	Output example:
	57	{v
57	58	random seed: 101121210
58	59	random seed: 101121210
59	60	\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

+1

-1

src/ounit/dune less more

3	3	(public_name qcheck-ounit)
4	4	(optional)
5	5	(wrapped false)
6		(libraries unix bytes qcheck-core qcheck-core.runner oUnit)
	6	(libraries unix bytes qcheck-core qcheck-core.runner ounit2)
7	7	(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string)
8	8	)

+99

-25

src/runner/QCheck_base_runner.ml less more

93	93	let r = ref false in
94	94	(fun () -> !r), (fun b -> r := b)
95	95
	96	let debug_shrink, set_debug_shrink =
	97	let r = ref None in
	98	(fun () -> !r), (fun s -> r := Some (open_out s))
	99
	100	let debug_shrink_list, set_debug_shrink_list =
	101	let r = ref [] in
	102	(fun () -> !r), (fun b -> r := b :: !r)
	103
96	104	module Raw = struct
97	105	type ('b,'c) printer = {
98	106	info: 'a. ('a,'b,'c,unit) format4 -> 'a;

107	115	cli_rand : Random.State.t;
108	116	cli_slow_test : int; (* how many slow tests to display? *)
109	117	cli_colors: bool;
	118	cli_debug_shrink : out_channel option;
	119	cli_debug_shrink_list : string list;
110	120	}
111	121
112	122	(* main callback for individual tests

164	174	; "--seed", Arg.Set_int seed, " set random seed (to repeat tests)"
165	175	; "--long", Arg.Unit set_long_tests, " run long tests"
166	176	; "-bt", Arg.Unit set_backtraces, " enable backtraces"
	177	; "--debug-shrink", Arg.String set_debug_shrink, " enable shrinking debug to <file>"
	178	; "--debug-shrink-list", Arg.String set_debug_shrink_list, " filter test to debug shrinking on"
167	179	]
168	180	) in
169	181	Arg.parse_argv argv options (fun _ ->()) "run qtest suite";
170	182	let cli_rand = setup_random_state_ () in
171	183	{ cli_verbose=verbose(); cli_long_tests=long_tests(); cli_rand;
172	184	cli_print_list= !print_list; cli_slow_test= !slow;
173		cli_colors= !colors; }
	185	cli_colors= !colors; cli_debug_shrink = debug_shrink();
	186	cli_debug_shrink_list = debug_shrink_list(); }
174	187	end
175	188
176	189	open Raw

188	201	type res =
189	202	\| Res : 'a QCheck.Test.cell * 'a QCheck.TestResult.t -> res
190	203
	204	type handler = {
	205	handler : 'a. 'a QCheck.Test.handler;
	206	}
	207
	208	type handler_gen =
	209	colors:bool ->
	210	debug_shrink:(out_channel option) ->
	211	debug_shrink_list:(string list) ->
	212	size:int -> out:out_channel -> verbose:bool -> counter -> handler
	213
191	214	let pp_counter ~size out c =
192	215	let t = Unix.gettimeofday () -. c.start in
193	216	Printf.fprintf out "%d %d %d %d / %*d %7.1fs"
194	217	size c.gen size c.errored size c.failed
195	218	size c.passed size c.expected t
196	219
197		let handler ~size ~out ~verbose c name _ r =
198		let st = function
199		\| QCheck.Test.Generating -> "generating"
200		\| QCheck.Test.Collecting _ -> "collecting"
201		\| QCheck.Test.Testing _ -> " testing"
202		\| QCheck.Test.Shrunk (i, _) ->
203		Printf.sprintf "shrinking: %4d" i
204		\| QCheck.Test.Shrinking (i, j, _) ->
205		Printf.sprintf "shrinking: %4d.%04d" i j
	220	let debug_shrinking_counter_example cell out x =
	221	match (QCheck.Test.get_arbitrary cell).QCheck.print with
	222	\| None -> Printf.fprintf out "<no printer provided>"
	223	\| Some print -> Printf.fprintf out "%s" (print x)
	224
	225	let debug_shrinking_size cell out x =
	226	match (QCheck.Test.get_arbitrary cell).QCheck.small with
	227	\| None -> ()
	228	\| Some f -> Printf.fprintf out ", size %d" (f x)
	229
	230	let debug_shrinking_choices_aux ~colors out name i cell x =
	231	Printf.fprintf out "\n~~~ %a %s\n\n"
	232	(Color.pp_str_c ~colors `Cyan) "Shrink" (String.make 69 '~');
	233	Printf.fprintf out
	234	"Test %s sucessfully shrunk counter example (step %d%a) to:\n\n%a\n%!"
	235	name i
	236	(debug_shrinking_size cell) x
	237	(debug_shrinking_counter_example cell) x
	238
	239	let debug_shrinking_choices
	240	~colors ~debug_shrink ~debug_shrink_list name cell i x =
	241	match debug_shrink with
	242	\| None -> ()
	243	\| Some out ->
	244	begin match debug_shrink_list with
	245	\| [] ->
	246	debug_shrinking_choices_aux ~colors out name i cell x
	247	\| l when List.mem name l ->
	248	debug_shrinking_choices_aux ~colors out name i cell x
	249	\| _ -> ()
	250	end
	251
	252
	253	let default_handler
	254	~colors ~debug_shrink ~debug_shrink_list
	255	~size ~out ~verbose c =
	256	let handler name cell r =
	257	let st = function
	258	\| QCheck.Test.Generating -> "generating"
	259	\| QCheck.Test.Collecting _ -> "collecting"
	260	\| QCheck.Test.Testing _ -> " testing"
	261	\| QCheck.Test.Shrunk (i, _) ->
	262	Printf.sprintf "shrinking: %4d" i
	263	\| QCheck.Test.Shrinking (i, j, _) ->
	264	Printf.sprintf "shrinking: %4d.%04d" i j
	265	in
	266	(* debug shrinking choices *)
	267	begin match r with
	268	\| QCheck.Test.Shrunk (i, x) ->
	269	debug_shrinking_choices
	270	~colors ~debug_shrink ~debug_shrink_list name cell i x
	271	\| _ ->
	272	()
	273	end;
	274	(* use timestamps for rate-limiting *)
	275	let now=Unix.gettimeofday() in
	276	if verbose && now -. !last_msg > get_time_between_msg () then (
	277	last_msg := now;
	278	Printf.fprintf out "%s[ ] %a %s (%s)%!"
	279	Color.reset_line (pp_counter ~size) c name (st r)
	280	)
206	281	in
207		(* use timestamps for rate-limiting *)
208		let now=Unix.gettimeofday() in
209		if verbose && now -. !last_msg > get_time_between_msg () then (
210		last_msg := now;
211		Printf.fprintf out "%s[ ] %a %s (%s)%!"
212		Color.reset_line (pp_counter ~size) c name (st r)
213		)
214
	282	{ handler; }
215	283
216	284	let step ~size ~out ~verbose c name _ _ r =
217	285	let aux = function

277	345	(Color.pp_str_c ~colors `Yellow) "Warning" (String.make 68 '!')
278	346	(QCheck.Test.get_name cell) msg)
279	347	(QCheck.TestResult.warnings r);
	348
	349	if QCheck.TestResult.stats r <> [] then
	350	Printf.fprintf out
	351	"\n+++ %a %s\n%!"
	352	(Color.pp_str_c ~colors `Blue) ("Stats for " ^ QCheck.Test.get_name cell)
	353	(String.make 56 '+');
280	354	List.iter
281		(fun st ->
282		Printf.fprintf out
283		"\n+++ %a %s\n\nStat for test %s:\n\n%s%!"
284		(Color.pp_str_c ~colors `Blue) "Stat" (String.make 68 '+')
285		(QCheck.Test.get_name cell) (QCheck.Test.print_stat st))
	355	(fun st -> Printf.fprintf out "\n%s%!" (QCheck.Test.print_stat st))
286	356	(QCheck.TestResult.stats r);
287	357	()
288	358

308	378	print_messages ~colors out cell c_ex.QCheck.TestResult.msg_l
309	379
310	380	let run_tests
311		?(colors=true) ?(verbose=verbose()) ?(long=long_tests()) ?(out=stdout) ?(rand=random_state()) l =
	381	?(handler=default_handler)
	382	?(colors=true) ?(verbose=verbose()) ?(long=long_tests())
	383	?(debug_shrink=debug_shrink()) ?(debug_shrink_list=debug_shrink_list())
	384	?(out=stdout) ?(rand=random_state()) l =
312	385	let module T = QCheck.Test in
313	386	let module R = QCheck.TestResult in
314	387	let pp_color = Color.pp_str_c ~bold:true ~colors in

330	403	Printf.fprintf out "%s[ ] %a %s%!"
331	404	Color.reset_line (pp_counter ~size) c (T.get_name cell);
332	405	let r = QCheck.Test.check_cell ~long ~rand
333		~handler:(handler ~size ~out ~verbose c)
	406	~handler:(handler ~colors ~debug_shrink ~debug_shrink_list
	407	~size ~out ~verbose c).handler
334	408	~step:(step ~size ~out ~verbose c)
335	409	~call:(callback ~size ~out ~verbose ~colors c)
336	410	cell

+37

-1

src/runner/QCheck_base_runner.mli less more

57	57	(** Set the minimum tiem between messages.
58	58	@since 0.9 *)
59	59
	60
	61	(** {2 Event handlers} *)
	62
	63	type counter = private {
	64	start : float;
	65	expected : int;
	66	mutable gen : int;
	67	mutable passed : int;
	68	mutable failed : int;
	69	mutable errored : int;
	70	}
	71	(** The type of counter used to keep tracks of the events received for a given
	72	test cell. *)
	73
	74	type handler = {
	75	handler : 'a. 'a QCheck.Test.handler;
	76	}
	77	(** A type to represent polymorphic-enough handlers for test cells. *)
	78
	79	type handler_gen =
	80	colors:bool ->
	81	debug_shrink:(out_channel option) ->
	82	debug_shrink_list:(string list) ->
	83	size:int -> out:out_channel -> verbose:bool -> counter -> handler
	84	(** An alias type to a generator of handlers for test cells. *)
	85
	86	val default_handler : handler_gen
	87	(** The default handler used. *)
	88
	89
60	90	(** {2 Run a Suite of Tests and Get Results} *)
61	91
62	92	val run_tests :
	93	?handler:handler_gen ->
63	94	?colors:bool -> ?verbose:bool -> ?long:bool ->
	95	?debug_shrink:(out_channel option) ->
	96	?debug_shrink_list:(string list) ->
64	97	?out:out_channel -> ?rand:Random.State.t ->
65	98	QCheck.Test.t list -> int
66	99	(** Run a suite of tests, and print its results. This is an heritage from

81	114	- "--long" for running the long versions of the tests
82	115
83	116	Below is an example of the output of the [run_tests] and [run_tests_main]
84		function: {v
	117	function:
	118	{v
85	119	random seed: 438308050
86	120	generated error; fail; pass / total - time -- test name
87	121	[✓] (1000) 0 ; 0 ; 1000 / 1000 -- 0.5s -- list_rev_is_involutive

163	197	cli_rand : Random.State.t;
164	198	cli_slow_test : int; (* how many slow tests to display? *)
165	199	cli_colors: bool;
	200	cli_debug_shrink : out_channel option;
	201	cli_debug_shrink_list : string list;
166	202	}
167	203
168	204	val parse_cli : full_options:bool -> string array -> cli_args