Commit 433859b9040a97b3d16fcb30238ca74735c22400 - ocaml-qcheck

New upstream version 0.18 Stephane Glondu authored 2 years ago Stéphane Glondu committed 2 years ago

44 changed file(s) with 7696 addition(s) and 927 deletion(s). Raw diff Collapse all Expand all

+43

-0

.github/workflows/gh-pages.yml less more

	0	name: github pages
	1
	2	on:
	3	push:
	4	branches:
	5	- master # Set a branch name to trigger deployment
	6
	7	jobs:
	8	deploy:
	9	runs-on: ubuntu-latest
	10	steps:
	11	- uses: actions/checkout@main
	12
	13	- name: Cache opam
	14	id: cache-opam
	15	uses: actions/cache@v2
	16	with:
	17	path: ~/.opam
	18	key: opam-ubuntu-latest-4.12.0
	19
	20	- uses: avsm/setup-ocaml@v1
	21	with:
	22	ocaml-version: '4.12.0'
	23
	24	- name: Pin
	25	run: opam pin -n .
	26
	27	- name: Depext
	28	run: opam depext -yt qcheck-ounit qcheck-core qcheck
	29
	30	- name: Deps
	31	run: opam install -d . --deps-only
	32
	33	- name: Build
	34	run: opam exec -- dune build @doc
	35
	36	- name: Deploy
	37	uses: peaceiris/actions-gh-pages@v3
	38	with:
	39	github_token: ${{ secrets.GITHUB_TOKEN }}
	40	publish_dir: ./_build/default/_doc/_html/
	41	destination_dir: dev
	42	enable_jekyll: true

+32

-0

.github/workflows/main.yml less more

	0	name: build
	1	on:
	2	push:
	3	branches:
	4	- master
	5	pull_request:
	6	branches:
	7	- master
	8	jobs:
	9	run:
	10	name: Build
	11	strategy:
	12	matrix:
	13	os:
	14	- macos-latest
	15	- ubuntu-latest
	16	- windows-latest
	17	ocaml-compiler:
	18	- 4.08.x
	19	- 4.12.x
	20	runs-on: ${{ matrix.os }}
	21	steps:
	22	- uses: actions/checkout@v2
	23	- uses: ocaml/setup-ocaml@v2
	24	with:
	25	ocaml-compiler: ${{ matrix.ocaml-compiler }}
	26	- run: opam pin -n .
	27	- run: opam depext -yt qcheck qcheck-core qcheck-ounit qcheck-alcotest
	28	- run: opam install -t . --deps-only
	29	- run: opam exec -- dune build
	30	- run: opam exec -- dune runtest
	31	if: ${{ matrix.os == 'ubuntu-latest'}}

-0

.gitignore less more

9	9	*.tar.gz
10	10	*.byte
11	11	.merlin
	12	_opam/

-6

.travis.yml less more

9	9	- PACKAGE="qcheck"
10	10	- DEPOPTS="ounit alcotest"
11	11	matrix:
12		- OCAML_VERSION="4.03"
13		#- OCAML_VERSION="4.04"
14		#- OCAML_VERSION="4.05"
15		- OCAML_VERSION="4.06"
16		#- OCAML_VERSION="4.07"
	12	# OCAML_VERSION is used by https://github.com/ocaml/ocaml-ci-scripts/blob/master/README-travis.md
17	13	- OCAML_VERSION="4.08"
18		#- OCAML_VERSION="4.09"
	14	- OCAML_VERSION="4.09"
19	15	- OCAML_VERSION="4.10"
	16	- OCAML_VERSION="4.11"
	17	- OCAML_VERSION="4.12"

+22

-0

CHANGELOG.md less more

0	0	# Changes
	1
	2	## 0.18
	3
	4	This releases marks the addition of `QCheck2`, a module where generation
	5	and shrinking are better integrated.
	6	See [#109](https://github.com/c-cube/qcheck/pull/109) and [#116](https://github.com/c-cube/qcheck/pull/116).
	7
	8	This API is still experimental. The normal `QCheck` module is still there
	9	and hasn't changed much.
	10
	11	deprecations and breakges:
	12
	13	- make `QCheck.Test_result.t` abstract and add missing getters
	14	- deprecate `QCheck.oneof`
	15	- deprecate `Gen.string_readable` in favor of `Gen.(string_of char)` or the new `Gen.string_printable`
	16	- require at least OCaml 4.08
	17
	18	other changes:
	19
	20	- unsigned int32 and int64
	21	- rename `small_int_corners`
	22	- add `?ratio` to `opt`, to modify random distribution of options
1	23
2	24	## 0.17
3	25

-2

Makefile less more

4	4	@dune build @install
5	5
6	6	test:
7		@dune runtest --no-buffer
	7	@dune runtest --no-buffer --force
8	8
9	9	clean:
10	10	@dune clean

41	41	watch:
42	42	@dune build @all -w
43	43
44		.PHONY: benchs tests examples update_next_tag watch release
	44	.PHONY: benchs test examples update_next_tag watch release

-3

README.adoc less more

5	5	QuickCheck inspired property-based testing for OCaml, and combinators to
6	6	generate random values to run tests on.
7	7
	8	image::https://github.com/c-cube/qcheck/actions/workflows/main.yml/badge.svg[alt="build", link=https://github.com/c-cube/qcheck/actions/workflows/main.yml]
	9
8	10
9	11	The documentation can be found https://c-cube.github.io/qcheck/[here].
10	12	This library spent some time in

17	19	- https://gitlab.inria.fr/fpottier/feat/[Feat]
18	20	- @gasche's https://github.com/gasche/random-generator/[generator library]
19	21
20		Jan Midtgaard has http://janmidtgaard.dk/quickcheck/index.html[a lecture] about
	22	Jan Midtgaard (@jmid) has http://janmidtgaard.dk/quickcheck/index.html[a lecture] about
21	23	property-based testing that relies on QCheck.
22	24
23	25	toc::[]
24
25		image::https://travis-ci.org/c-cube/qcheck.svg?branch=master[alt="Build Status", link="https://travis-ci.org/c-cube/qcheck"]
26	26
27	27	== Use
28	28

-1

dune-project less more

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

+26

-0

example/QCheck_runner_test.ml less more

137	137	(add_stat ("dist",fun x -> x) small_signed_int))
138	138	(fun _ -> true)
139	139
	140	type tree = Leaf of int \| Node of tree * tree
	141
	142	let leaf x = Leaf x
	143	let node x y = Node (x,y)
	144
	145	let gen_tree = QCheck.Gen.(sized @@ fix
	146	(fun self n -> match n with
	147	\| 0 -> map leaf nat
	148	\| n ->
	149	frequency
	150	[1, map leaf nat;
	151	2, map2 node (self (n/2)) (self (n/2))]
	152	))
	153
	154	let rec rev_tree = function
	155	\| Node (x, y) -> Node (rev_tree y, rev_tree x)
	156	\| Leaf x -> Leaf x
	157
	158	let passing_tree_rev =
	159	QCheck.Test.make ~count:1000
	160	~name:"tree_rev_is_involutive"
	161	QCheck.(make gen_tree)
	162	(fun tree -> rev_tree (rev_tree tree) = tree)
	163
	164
140	165	let stats_tests =
141	166	let open QCheck in
142	167	[

166	191	stats_negs;
167	192	bad_assume_warn;
168	193	bad_assume_fail;
	194	passing_tree_rev;
169	195	] @ find_ex_uncaught_issue_99 @ stats_tests)
170	196

+25

-1

example/alcotest/QCheck_alcotest_test.ml less more

23	23	QCheck.small_int
24	24	(fun _ -> QCheck.Test.fail_reportf "@[<v>this@ will@ always@ fail@]")
25	25
	26	type tree = Leaf of int \| Node of tree * tree
	27
	28	let leaf x = Leaf x
	29	let node x y = Node (x,y)
	30
	31	let gen_tree = QCheck.Gen.(sized @@ fix
	32	(fun self n -> match n with
	33	\| 0 -> map leaf nat
	34	\| n ->
	35	frequency
	36	[1, map leaf nat;
	37	2, map2 node (self (n/2)) (self (n/2))]
	38	))
	39
	40	let rec rev_tree = function
	41	\| Node (x, y) -> Node (rev_tree y, rev_tree x)
	42	\| Leaf x -> Leaf x
	43
	44	let passing_tree_rev =
	45	QCheck.Test.make ~count:1000
	46	~name:"tree_rev_is_involutive"
	47	QCheck.(make gen_tree)
	48	(fun tree -> rev_tree (rev_tree tree) = tree)
	49
26	50	let () =
27	51	Printexc.record_backtrace true;
28	52	let module A = Alcotest in
29	53	let suite =
30	54	List.map QCheck_alcotest.to_alcotest
31		[ passing; failing; error; simple_qcheck ]
	55	[ passing; failing; error; simple_qcheck; passing_tree_rev ]
32	56	in
33	57	A.run "my test" [
34	58	"suite", suite

+19

-0

example/alcotest/dune less more

1	1	(executable
2	2	(name QCheck_alcotest_test)
3	3	(libraries qcheck-core qcheck-alcotest alcotest))
	4
	5	(rule
	6	(targets output.txt)
	7	(deps ./QCheck_alcotest_test.exe)
	8	(enabled_if (= %{os_type} "Unix"))
	9	(action
	10	(with-accepted-exit-codes
	11	1
	12	(setenv
	13	QCHECK_SEED 1234
	14	(with-stdout-to
	15	%{targets}
	16	(run ./run_alcotest.sh --color=never))))))
	17
	18	(rule
	19	(alias runtest)
	20	(package qcheck-alcotest)
	21	(enabled_if (= %{os_type} "Unix"))
	22	(action (diff output.txt.expected output.txt)))

+22

-0

example/alcotest/output.txt.expected less more

	0	qcheck random seed: 1234
	1	Testing `my test'.
	2
	3	[OK] suite 0 list_rev_is_involutive.
	4	> [FAIL] suite 1 fail_sort_id.
	5	[FAIL] suite 2 error_raise_exn.
	6	[FAIL] suite 3 fail_check_err_message.
	7	[OK] suite 4 tree_rev_is_involutive.
	8
	9	┌──────────────────────────────────────────────────────────────────────────────┐
	10	│ [FAIL] suite 1 fail_sort_id. │
	11	└──────────────────────────────────────────────────────────────────────────────┘
	12
	13	test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps)
	14
	15	[exception] test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps)
	16
	17
	18
	19	──────────────────────────────────────────────────────────────────────────────
	20
	21	3 failures! 5 tests run.

+15

-0

example/alcotest/run_alcotest.sh less more

	0	#!/usr/bin/env sh
	1
	2	# custom script to run qcheck-alcotest and filter non reproducible parts
	3
	4	OUT=`./QCheck_alcotest_test.exe $@`
	5	CODE=$?
	6
	7	# remove non deterministic output
	8	echo "$OUT" \| grep -v 'This run has ID' \
	9	\| grep -v 'Full test results in' \
	10	\| grep -v 'Logs saved to' \
	11	\| grep -v 'Raised at ' \
	12	\| grep -v 'Called from ' \
	13	\| sed 's/! in .*s\./!/'
	14	exit $CODE

+18

-2

example/dune less more

0	0
1	1	(executables
2	2	(names QCheck_runner_test)
3		(libraries qcheck)
4		)
	3	(libraries qcheck))
	4
	5	(rule
	6	(targets output.txt)
	7	(deps ./QCheck_runner_test.exe)
	8	(enabled_if (= %{os_type} "Unix"))
	9	(action
	10	(with-accepted-exit-codes
	11	1
	12	(with-stdout-to
	13	%{targets}
	14	(run ./QCheck_runner_test.exe --no-colors -s 1234)))))
	15
	16	(rule
	17	(alias runtest)
	18	(enabled_if (= %{os_type} "Unix"))
	19	(package qcheck)
	20	(action (diff output.txt.expected output.txt)))

+27

-1

example/ounit/QCheck_ounit_test.ml less more

23	23	QCheck.small_int
24	24	(fun _ -> QCheck.Test.fail_reportf "@[<v>this@ will@ always@ fail@]")
25	25
	26
	27	type tree = Leaf of int \| Node of tree * tree
	28
	29	let leaf x = Leaf x
	30	let node x y = Node (x,y)
	31
	32	let gen_tree = QCheck.Gen.(sized @@ fix
	33	(fun self n -> match n with
	34	\| 0 -> map leaf nat
	35	\| n ->
	36	frequency
	37	[1, map leaf nat;
	38	2, map2 node (self (n/2)) (self (n/2))]
	39	))
	40
	41	let rec rev_tree = function
	42	\| Node (x, y) -> Node (rev_tree y, rev_tree x)
	43	\| Leaf x -> Leaf x
	44
	45	let passing_tree_rev =
	46	QCheck.Test.make ~count:1000
	47	~name:"tree_rev_is_involutive"
	48	QCheck.(make gen_tree)
	49	(fun tree -> rev_tree (rev_tree tree) = tree)
	50
26	51	let () =
27	52	Printexc.record_backtrace true;
28	53	let open OUnit2 in
29	54	run_test_tt_main
30	55	("tests" >:::
31		List.map QCheck_ounit.to_ounit2_test [passing; failing; error; simple_qcheck])
	56	List.map QCheck_ounit.to_ounit2_test
	57	[passing; failing; error; simple_qcheck; passing_tree_rev])

+18

-2

example/ounit/dune less more

0	0
1	1	(executables
2	2	(names QCheck_ounit_test QCheck_test)
3		(libraries qcheck ounit2 qcheck-ounit)
4		)
	3	(libraries ounit2 qcheck-ounit))
	4
	5	(rule
	6	(targets output.txt)
	7	(deps ./QCheck_ounit_test.exe)
	8	(enabled_if (= %{os_type} "Unix"))
	9	(action
	10	(with-accepted-exit-codes
	11	1
	12	(with-stdout-to
	13	%{targets}
	14	(run ./run_ounit.sh -runner=sequential -seed 1234)))))
	15
	16	(rule
	17	(alias runtest)
	18	(package qcheck-ounit)
	19	(enabled_if (= %{os_type} "Unix"))
	20	(action (diff output.txt.expected output.txt)))

+43

-0

example/ounit/output.txt.expected less more

	0	.FEF.
	1	==============================================================================
	2	Error: tests:2:error_raise_exn.
	3
	4	Error: tests:2:error_raise_exn (in the log).
	5
	6
	7	test `error_raise_exn` raised exception `Dune__exe__QCheck_ounit_test.Error`
	8	on `0 (after 63 shrink steps)`
	9
	10	------------------------------------------------------------------------------
	11	==============================================================================
	12	Error: tests:3:fail_check_err_message.
	13
	14	Error: tests:3:fail_check_err_message (in the log).
	15
	16	Error: tests:3:fail_check_err_message (in the code).
	17
	18
	19	test `fail_check_err_message` failed on ≥ 1 cases:
	20	0 (after 7 shrink steps)
	21	this
	22	will
	23	always
	24	fail
	25
	26
	27
	28	------------------------------------------------------------------------------
	29	==============================================================================
	30	Error: tests:1:fail_sort_id.
	31
	32	Error: tests:1:fail_sort_id (in the log).
	33
	34	Error: tests:1:fail_sort_id (in the code).
	35
	36
	37	test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps)
	38
	39
	40	------------------------------------------------------------------------------
	41	Ran: 5 tests in: <nondet> seconds.
	42	FAILED: Cases: 5 Tried: 5 Errors: 1 Failures: 2 Skip: 0 Todo: 0 Timeouts: 0.

+14

-0

example/ounit/run_ounit.sh less more

	0	#!/usr/bin/env sh
	1
	2	# custom script to run qcheck-ounit and filter non reproducible parts
	3
	4	OUT=`./QCheck_ounit_test.exe $@`
	5	CODE=$?
	6
	7	# remove non deterministic output
	8	echo "$OUT" \
	9	\| grep -v 'File ., line .' \
	10	\| grep -v 'Called from ' \
	11	\| grep -v 'Raised at ' \
	12	\| sed 's/in: .*seconds/in: <nondet> seconds/'
	13	exit $CODE

+318

-0

example/output.txt.expected less more

	0	random seed: 1234
	1
	2	--- Failure --------------------------------------------------------------------
	3
	4	Test should_fail_sort_id failed (18 shrink steps):
	5
	6	[1; 0]
	7
	8	=== Error ======================================================================
	9
	10	Test should_error_raise_exn errored on (63 shrink steps):
	11
	12	0
	13
	14	exception Dune__exe__QCheck_runner_test.Error
	15
	16
	17	+++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	18
	19	Collect results for test collect_results:
	20
	21	4: 20 cases
	22	3: 25 cases
	23	2: 17 cases
	24	1: 18 cases
	25	0: 20 cases
	26
	27	+++ Stats for with_stats ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	28
	29	stats mod4:
	30	num: 100, avg: 1.68, stddev: 1.09, median 2, min 0, max 3
	31	0: ############################## 17
	32	1: ################################################### 29
	33	2: ######################################## 23
	34	3: ####################################################### 31
	35
	36	stats num:
	37	num: 100, avg: 66.84, stddev: 31.94, median 65, min 2, max 120
	38	2.. 7: ################## 3
	39	8.. 13: ################## 3
	40	14.. 19: 0
	41	20.. 25: ########################################## 7
	42	26.. 31: ######################## 4
	43	32.. 37: ######################## 4
	44	38.. 43: ################## 3
	45	44.. 49: ################################################ 8
	46	50.. 55: #################################### 6
	47	56.. 61: #################################### 6
	48	62.. 67: ####################################################### 9
	49	68.. 73: ########################################## 7
	50	74.. 79: ######################## 4
	51	80.. 85: ################## 3
	52	86.. 91: ############ 2
	53	92.. 97: ########################################## 7
	54	98..103: #################################### 6
	55	104..109: #################################### 6
	56	110..115: ####################################################### 9
	57	116..121: ################## 3
	58
	59	--- Failure --------------------------------------------------------------------
	60
	61	Test FAIL_pred_map_commute failed (127 shrink steps):
	62
	63	([3], {_ -> 0}, {3 -> false; _ -> true})
	64
	65	--- Failure --------------------------------------------------------------------
	66
	67	Test FAIL_fun2_pred_strings failed (1 shrink steps):
	68
	69	{some random string -> true; _ -> false}
	70
	71	--- Failure --------------------------------------------------------------------
	72
	73	Test fold_left fold_right failed (25 shrink steps):
	74
	75	(0, [1], {(1, 0) -> 1; _ -> 0})
	76
	77	+++ Messages ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	78
	79	Messages for test fold_left fold_right:
	80
	81	l=[1], fold_left=1, fold_right=0
	82
	83
	84	--- Failure --------------------------------------------------------------------
	85
	86	Test fold_left fold_right uncurried failed (111 shrink steps):
	87
	88	({(5, 7) -> 0; _ -> 7}, 0, [5; 0])
	89
	90	--- Failure --------------------------------------------------------------------
	91
	92	Test long_shrink failed (149 shrink steps):
	93
	94	([0], [-1])
	95
	96	--- Failure --------------------------------------------------------------------
	97
	98	Test mod3_should_fail failed (84 shrink steps):
	99
	100	-21
	101
	102	+++ Stats for stats_neg ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	103
	104	stats dist:
	105	num: 5000, avg: 0.17, stddev: 29.68, median 0, min -99, max 99
	106	-99..-90: # 65
	107	-89..-80: # 63
	108	-79..-70: # 64
	109	-69..-60: # 58
	110	-59..-50: # 67
	111	-49..-40: # 72
	112	-39..-30: # 61
	113	-29..-20: # 61
	114	-19..-10: # 67
	115	-9.. 0: ####################################################### 2076
	116	1.. 10: ############################################## 1764
	117	11.. 20: # 66
	118	21.. 30: # 64
	119	31.. 40: # 64
	120	41.. 50: # 67
	121	51.. 60: # 60
	122	61.. 70: # 75
	123	71.. 80: # 60
	124	81.. 90: # 60
	125	91..100: # 66
	126
	127	!!! Warning !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	128
	129	Warning for test WARN_unlikely_precond:
	130
	131	WARNING: only 0.5% tests (of 2000) passed precondition for "WARN_unlikely_precond"
	132
	133	NOTE: it is likely that the precondition is too strong, or that the generator is buggy.
	134
	135	--- Failure --------------------------------------------------------------------
	136
	137	Test FAIL_unlikely_precond failed:
	138
	139	ERROR: only 0.5% tests (of 2000) passed precondition for "FAIL_unlikely_precond"
	140
	141	NOTE: it is likely that the precondition is too strong, or that the generator is buggy.
	142
	143
	144	--- Failure --------------------------------------------------------------------
	145
	146	Test FAIL_#99_1 failed:
	147
	148	ERROR: uncaught exception in generator for test FAIL_#99_1 after 100 steps:
	149	Exception: QCheck.No_example_found("<example>")
	150	Backtrace:
	151
	152	+++ Stats for stat_display_test_1 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	153
	154	stats dist:
	155	num: 1000, avg: 0.90, stddev: 28.23, median 0, min -99, max 99
	156	-99..-90: # 12
	157	-89..-80: # 11
	158	-79..-70: # 9
	159	-69..-60: 6
	160	-59..-50: # 11
	161	-49..-40: # 13
	162	-39..-30: # 9
	163	-29..-20: # 13
	164	-19..-10: 8
	165	-9.. 0: ####################################################### 453
	166	1.. 10: ######################################### 340
	167	11.. 20: # 15
	168	21.. 30: # 11
	169	31.. 40: # 12
	170	41.. 50: # 13
	171	51.. 60: # 13
	172	61.. 70: # 16
	173	71.. 80: # 9
	174	81.. 90: # 16
	175	91..100: # 10
	176
	177	+++ Stats for stat_display_test_2 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	178
	179	stats dist:
	180	num: 1000, avg: 15.11, stddev: 23.27, median 6, min 0, max 99
	181	0.. 4: #################################################### 377
	182	5.. 9: ####################################################### 392
	183	10.. 14: ## 20
	184	15.. 19: ## 15
	185	20.. 24: # 11
	186	25.. 29: ## 17
	187	30.. 34: ## 19
	188	35.. 39: ## 17
	189	40.. 44: # 10
	190	45.. 49: # 9
	191	50.. 54: # 8
	192	55.. 59: # 9
	193	60.. 64: ## 15
	194	65.. 69: # 10
	195	70.. 74: # 13
	196	75.. 79: ## 19
	197	80.. 84: # 11
	198	85.. 89: # 13
	199	90.. 94: 5
	200	95.. 99: # 10
	201
	202	+++ Stats for stat_display_test_3 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	203
	204	stats dist:
	205	num: 1000, avg: 195335.64, stddev: 136803.99, median 195583, min -43624, max 435210
	206	-43624..-19683: ############################################ 52
	207	-19682.. 4259: ######################################## 47
	208	4260.. 28201: ############################## 36
	209	28202.. 52143: ############################################ 52
	210	52144.. 76085: ########################################## 50
	211	76086..100027: ####################################################### 64
	212	100028..123969: ############################################### 55
	213	123970..147911: ######################################## 47
	214	147912..171853: ############################################## 54
	215	171854..195795: #################################### 43
	216	195796..219737: ############################################## 54
	217	219738..243679: ########################################### 51
	218	243680..267621: ################################################ 57
	219	267622..291563: ########################################## 49
	220	291564..315505: #################################### 42
	221	315506..339447: ###################################### 45
	222	339448..363389: ################################################ 57
	223	363390..387331: ###################################### 45
	224	387332..411273: ########################################## 49
	225	411274..435215: ########################################### 51
	226
	227	+++ Stats for stat_display_test_4 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	228
	229	stats dist:
	230	num: 1000, avg: -173.78, stddev: 23042.92, median 180, min -39859, max 39942
	231	-39859..-35869: ############################################# 56
	232	-35868..-31878: ################################### 43
	233	-31877..-27887: ################################################# 60
	234	-27886..-23896: ##################################### 46
	235	-23895..-19905: ######################################## 49
	236	-19904..-15914: #################################### 45
	237	-15913..-11923: ############################################ 54
	238	-11922.. -7932: ############################################### 58
	239	-7931.. -3941: ######################################### 51
	240	-3940.. 50: ############################ 35
	241	51.. 4041: ####################################### 48
	242	4042.. 8032: ########################################## 52
	243	8033.. 12023: ######################################### 51
	244	12024.. 16014: ########################################### 53
	245	16015.. 20005: ############################################ 54
	246	20006.. 23996: ################################## 42
	247	23997.. 27987: ####################################################### 67
	248	27988.. 31978: ################################ 40
	249	31979.. 35969: ######################################### 51
	250	35970.. 39960: #################################### 45
	251
	252	+++ Stats for stat_display_test_5 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	253
	254	stats dist:
	255	num: 1000, avg: 0.02, stddev: 2.55, median 0, min -4, max 4
	256	-4: ############################################ 99
	257	-3: ##################################################### 118
	258	-2: ################################################## 111
	259	-1: ################################################## 113
	260	0: ################################################## 113
	261	1: ##################################################### 118
	262	2: ############################################# 102
	263	3: ####################################################### 122
	264	4: ############################################## 104
	265
	266	+++ Stats for stat_display_test_6 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	267
	268	stats dist:
	269	num: 1000, avg: 6.67, stddev: 6.39, median 7, min -4, max 17
	270	-4..-3: ############################################# 90
	271	-2..-1: ############################################# 91
	272	0.. 1: ########################################## 84
	273	2.. 3: ############################################## 92
	274	4.. 5: ########################################### 87
	275	6.. 7: ########################################### 86
	276	8.. 9: ############################################ 89
	277	10..11: ########################################### 87
	278	12..13: ####################################################### 110
	279	14..15: ############################################# 91
	280	16..17: ############################################## 93
	281	18..19: 0
	282	20..21: 0
	283	22..23: 0
	284	24..25: 0
	285	26..27: 0
	286	28..29: 0
	287	30..31: 0
	288	32..33: 0
	289	34..35: 0
	290
	291	+++ Stats for stat_display_test_7 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	292
	293	stats dist:
	294	num: 100000, avg: 2541076923587387.50, stddev: 2660730801206827008.00, median 158655268318060, min -4611522359435274428, max 4611540922436307689
	295	-4611522359435274428..-4150369195341695293: ##################################################### 4976
	296	-4150369195341695292..-3689216031248116157: ##################################################### 4963
	297	-3689216031248116156..-3228062867154537021: ###################################################### 5038
	298	-3228062867154537020..-2766909703060957885: ##################################################### 4979
	299	-2766909703060957884..-2305756538967378749: ##################################################### 5001
	300	-2305756538967378748..-1844603374873799613: ##################################################### 4982
	301	-1844603374873799612..-1383450210780220477: ##################################################### 5025
	302	-1383450210780220476.. -922297046686641341: #################################################### 4901
	303	-922297046686641340.. -461143882593062205: ####################################################### 5126
	304	-461143882593062204.. 9281500516931: ##################################################### 5008
	305	9281500516932.. 461162445594096067: ###################################################### 5041
	306	461162445594096068.. 922315609687675203: ##################################################### 5001
	307	922315609687675204.. 1383468773781254339: ##################################################### 4986
	308	1383468773781254340.. 1844621937874833475: ##################################################### 4949
	309	1844621937874833476.. 2305775101968412611: ##################################################### 5025
	310	2305775101968412612.. 2766928266061991747: ##################################################### 5022
	311	2766928266061991748.. 3228081430155570883: ##################################################### 4958
	312	3228081430155570884.. 3689234594249150019: ##################################################### 4998
	313	3689234594249150020.. 4150387758342729155: ##################################################### 4982
	314	4150387758342729156.. 4611540922436308291: ###################################################### 5039
	315	================================================================================
	316	1 warning(s)
	317	failure (9 tests failed, 1 tests errored, ran 25 tests)

-4

qcheck-alcotest.opam less more

0	0	opam-version: "2.0"
1	1	maintainer: "simon.cruanes.2007@m4x.org"
2		author: [ "Simon Cruanes <simon.cruanes.2007@m4x.org>" ]
	2	author: [ "the qcheck contributors" ]
3	3	homepage: "https://github.com/c-cube/qcheck/"
	4	license: "BSD-2-Clause"
4	5	synopsis: "Alcotest backend for qcheck"
5	6	doc: ["http://c-cube.github.io/qcheck/"]
6		version: "0.17"
	7	version: "0.18"
7	8	tags: [
8	9	"test"
9	10	"quickcheck"

16	17	["dune" "runtest" "-p" name "-j" jobs] {with-test}
17	18	]
18	19	depends: [
19		"dune"
	20	"dune" { >= "2.2" }
20	21	"base-bytes"
21	22	"base-unix"
22	23	"qcheck-core" { = version }
23	24	"alcotest"
24	25	"odoc" {with-doc}
25		"ocaml" {>= "4.03.0"}
	26	"ocaml" {>= "4.08.0"}
26	27	]
27	28	dev-repo: "git+https://github.com/c-cube/qcheck.git"
28	29	bug-reports: "https://github.com/c-cube/qcheck/issues"

-4

qcheck-core.opam less more

0	0	opam-version: "2.0"
1	1	maintainer: "simon.cruanes.2007@m4x.org"
2		author: [ "Simon Cruanes <simon.cruanes.2007@m4x.org>" ]
	2	author: [ "the qcheck contributors" ]
3	3	homepage: "https://github.com/c-cube/qcheck/"
	4	license: "BSD-2-Clause"
4	5	synopsis: "Core qcheck library"
5	6	doc: ["http://c-cube.github.io/qcheck/"]
6		version: "0.17"
	7	version: "0.18"
7	8	tags: [
8	9	"test"
9	10	"property"

15	16	["dune" "runtest" "-p" name "-j" jobs] {with-test}
16	17	]
17	18	depends: [
18		"dune"
	19	"dune" { >= "2.2" }
19	20	"base-bytes"
20	21	"base-unix"
	22	"alcotest" {with-test}
21	23	"odoc" {with-doc}
22		"ocaml" {>= "4.03.0"}
	24	"ocaml" {>= "4.08.0"}
23	25	]
24	26	dev-repo: "git+https://github.com/c-cube/qcheck.git"
25	27	bug-reports: "https://github.com/c-cube/qcheck/issues"

-4

qcheck-ounit.opam less more

0	0	opam-version: "2.0"
1	1	maintainer: "simon.cruanes.2007@m4x.org"
2		author: [ "Simon Cruanes <simon.cruanes.2007@m4x.org>" ]
	2	author: [ "the qcheck contributors" ]
	3	license: "BSD-2-Clause"
3	4	homepage: "https://github.com/c-cube/qcheck/"
4	5	doc: ["http://c-cube.github.io/qcheck/"]
5	6	synopsis: "OUnit backend for qcheck"
6		version: "0.17"
	7	version: "0.18"
7	8	tags: [
8	9	"qcheck"
9	10	"quickcheck"

15	16	["dune" "runtest" "-p" name "-j" jobs] {with-test}
16	17	]
17	18	depends: [
18		"dune"
	19	"dune" { >= "2.2" }
19	20	"base-bytes"
20	21	"base-unix"
21	22	"qcheck-core" { = version }
22	23	"ounit2"
23	24	"odoc" {with-doc}
24		"ocaml" {>= "4.03.0"}
	25	"ocaml" {>= "4.08.0"}
25	26	]
26	27	dev-repo: "git+https://github.com/c-cube/qcheck.git"
27	28	bug-reports: "https://github.com/c-cube/qcheck/issues"

-4

qcheck.opam less more

0	0	opam-version: "2.0"
1	1	maintainer: "simon.cruanes.2007@m4x.org"
2		author: [ "Simon Cruanes <simon.cruanes.2007@m4x.org>" ]
	2	author: [ "the qcheck contributors" ]
3	3	synopsis: "Compatibility package for qcheck"
4	4	homepage: "https://github.com/c-cube/qcheck/"
	5	license: "BSD-2-Clause"
5	6	doc: ["http://c-cube.github.io/qcheck/"]
6		version: "0.17"
	7	version: "0.18"
7	8	tags: [
8	9	"test"
9	10	"property"

15	16	["dune" "runtest" "-p" name "-j" jobs] {with-test}
16	17	]
17	18	depends: [
18		"dune"
	19	"dune" { >= "2.2" }
19	20	"base-bytes"
20	21	"base-unix"
21	22	"qcheck-core" { = version }
22	23	"qcheck-ounit" { = version }
	24	"alcotest" {with-test}
23	25	"odoc" {with-doc}
24		"ocaml" {>= "4.03.0"}
	26	"ocaml" {>= "4.08.0"}
25	27	]
26	28	dev-repo: "git+https://github.com/c-cube/qcheck.git"
27	29	bug-reports: "https://github.com/c-cube/qcheck/issues"

-2

src/alcotest/QCheck_alcotest.ml less more

0	0
1		module Q = QCheck
2		module T = QCheck.Test
	1	module Q = QCheck2
	2	module T = QCheck2.Test
3	3	module Raw = QCheck_base_runner.Raw
4	4
5	5	let seed_ = lazy (

-1

src/alcotest/QCheck_alcotest.mli less more

12	12
13	13	val to_alcotest :
14	14	?verbose:bool -> ?long:bool -> ?rand:Random.State.t ->
15		QCheck.Test.t -> unit Alcotest.test_case
	15	QCheck2.Test.t -> unit Alcotest.test_case
16	16	(** Convert a qcheck test into an alcotest test
17	17	@param verbose used to print information on stdout (default: [verbose()])
18	18	@param rand the random generator to use (default: [random_state ()])

+155

-550

src/core/QCheck.ml less more

47	47
48	48	let sum_int = List.fold_left (+) 0
49	49
50		exception FailedPrecondition
51		(* raised if precondition is false *)
52
53	50	exception No_example_found of string
54	51	(* raised if an example failed to be found *)
55	52
56		let assume b = if not b then raise FailedPrecondition
57
58		let assume_fail () = raise FailedPrecondition
59
60		let (==>) b1 b2 = if b1 then b2 else raise FailedPrecondition
	53	let assume = QCheck2.assume
	54
	55	let assume_fail = QCheck2.assume_fail
	56
	57	let (==>) = QCheck2.(==>)
61	58
62	59	module Gen = struct
63	60	type 'a t = RS.t -> 'a

138	135
139	136	let neg_int st = -(nat st)
140	137
141		let opt f st =
	138	let opt ?(ratio = 0.85) f st =
142	139	let p = RS.float st 1. in
143		if p < 0.15 then None
	140	if p < (1.0 -. ratio) then None
144	141	else Some (f st)
145	142
146	143	(* Uniform random int generator *)

149	146	fun st -> RS.bits st
150	147	else (* word size = 64 *)
151	148	fun st ->
152		RS.bits st (* Bottom 30 bits *)
153		lor (RS.bits st lsl 30) (* Middle 30 bits *)
154		lor ((RS.bits st land 3) lsl 60) (* Top 2 bits ) ( top bit = 0 *)
	149	(* Technically we could write [3] but this is clearer *)
	150	let two_bits_mask = 0b11 in
	151	(* Top 2 bits *)
	152	let left = ((RS.bits st land two_bits_mask) lsl 60) in
	153	(* Middle 30 bits *)
	154	let middle = (RS.bits st lsl 30) in
	155	(* Bottom 30 bits *)
	156	let right = RS.bits st in
	157	left lor middle lor right
155	158
156	159	let int st = if RS.bool st then - (pint st) - 1 else pint st
157	160	let int_bound n =

243	246	let samples = List.rev_map sample l in
244	247	List.sort (fun (w1, _) (w2, _) -> poly_compare w1 w2) samples \|> List.rev_map snd
245	248
	249	let range_subset ~size low high st =
	250	if not (low <= high && size <= high - low + 1) then invalid_arg "Gen.range_subset";
	251	(* The algorithm below is attributed to Floyd, see for example
	252	https://eyalsch.wordpress.com/2010/04/01/random-sample/
	253	https://math.stackexchange.com/questions/178690
	254
	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.
	259	*)
	260	let module ISet = Set.Make(Int) in
	261	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;
	269	s := ISet.add choice !s;
	270	done;
	271	arr
	272
	273	let array_subset size arr st =
	274	range_subset ~size 0 (Array.length arr - 1) st
	275	\|> Array.map (fun i -> arr.(i))
	276
246	277	let pair g1 g2 st = (g1 st, g2 st)
247	278
248	279	let triple g1 g2 g3 st = (g1 st, g2 st, g3 st)

271	302	Bytes.unsafe_to_string s
272	303	let string ?gen st = string_size ?gen nat st
273	304	let string_of gen = string_size ~gen nat
274		let string_readable = string_size ~gen:char nat
	305	let string_printable = string_size ~gen:printable nat
	306	let string_readable = string_printable
275	307	let small_string ?gen st = string_size ?gen small_nat st
276	308	let small_list gen = list_size small_nat gen
277	309	let small_array gen = array_size small_nat gen

299	331	let rec f' n st = f f' n st in
300	332	f'
301	333
	334	(* nat splitting *)
	335
	336	let nat_split2 n st =
	337	if (n < 2) then invalid_arg "nat_split2";
	338	let n1 = int_range 1 (n - 1) st in
	339	(n1, n - n1)
	340
	341	let pos_split2 n st =
	342	let n1 = int_range 0 n st in
	343	(n1, n - n1)
	344
	345	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	)
	359
	360	let nat_split ~size:k n st =
	361	pos_split ~size:k (n+k) st
	362	\|> Array.map (fun v -> v - 1)
	363
302	364	let generate ?(rand=Random.State.make_self_init()) ~n g =
303	365	list_repeat n g rand
304	366

306	368
307	369	let delay f st = f () st
308	370
309		include Qcheck_ops.Make(struct
310		type nonrec 'a t = 'a t
311		let (>\|=) = (>\|=)
312		let monoid_product a b = map2 (fun x y -> x,y) a b
313		let (>>=) = (>>=)
314		end)
	371	let (let+) = (>\|=)
	372
	373	let (and+) = pair
	374
	375	let (let*) = (>>=)
	376
	377	let (and*) = pair
315	378	end
316	379
317	380	module Print = struct

387	450
388	451	let find p iter = find_map (fun x->if p x then Some x else None) iter
389	452
390		include Qcheck_ops.Make(struct
391		type nonrec 'a t = 'a t
392		let (>\|=) = (>\|=)
393		let monoid_product a b = map2 (fun x y -> x,y) a b
394		let (>>=) = (>>=)
395		end)
	453	let (let+) = (>\|=)
	454
	455	let (and+) = pair
	456
	457	let (let*) = (>>=)
	458
	459	let (and*) = pair
396	460	end
397	461
398	462	module Shrink = struct

669	733	\| None -> o
670	734	\| Some shr -> {o with shrink=Some (Shrink.filter f shr)}
671	735
672		let gen o = o.gen
	736	let get_gen o = o.gen
	737	let gen = get_gen
	738	let get_print o = o.print
673	739
674	740	let small1 _ = 1
675	741

802	868	(_opt_or d.shrink Shrink.nil))
803	869	(Gen.quad a.gen b.gen c.gen d.gen)
804	870
805		let option a =
806		let g = Gen.opt a.gen
	871	let option ?ratio a =
	872	let g = Gen.opt ?ratio a.gen
807	873	and shrink = _opt_map a.shrink ~f:Shrink.option
808	874	and small =
809	875	_opt_map_or a.small ~d:(function None -> 0 \| Some _ -> 1)

1183	1249	Gen.(map_keep_input f a.gen)
1184	1250
1185	1251	module TestResult = struct
1186		type 'a counter_ex = {
	1252	type 'a counter_ex = 'a QCheck2.TestResult.counter_ex = {
1187	1253	instance: 'a; (** The counter-example(s) *)
1188	1254	shrink_steps: int; (** How many shrinking steps for this counterex *)
1189	1255	msg_l: string list; (** messages. @since 0.7 *)

1193	1259
1194	1260	(** Result state.
1195	1261	changed in 0.10 (move to inline records) *)
1196		type 'a state =
	1262	type 'a state = 'a QCheck2.TestResult.state =
1197	1263	\| Success
1198	1264	\| Failed of {
1199	1265	instances: 'a failed_state; (** Failed instance(s) *)

1207	1273
1208	1274
1209	1275	(* result returned by running a test *)
1210		type 'a t = {
1211		mutable state : 'a state;
1212		mutable count: int; (* number of tests *)
1213		mutable count_gen: int; (* number of generated cases *)
1214		collect_tbl: (string, int) Hashtbl.t lazy_t;
1215		stats_tbl: ('a stat * (int, int) Hashtbl.t) list;
1216		mutable warnings: string list;
1217		mutable instances: 'a list;
1218		}
1219
1220		(* indicate failure on the given [instance] *)
1221		let fail ~msg_l ~small ~steps:shrink_steps res instance =
1222		let c_ex = {instance; shrink_steps; msg_l; } in
1223		match res.state with
1224		\| Success -> res.state <- Failed {instances=[ c_ex ]}
1225		\| Error _
1226		\| Failed_other _ -> ()
1227		\| Failed {instances=[]} -> assert false
1228		\| Failed {instances=((c_ex'::_) as l)} ->
1229		match small with
1230		\| Some small ->
1231		(* all counter-examples in [l] have same size according to [small],
1232		so we just compare to the first one, and we enforce
1233		the invariant *)
1234		begin match poly_compare (small instance) (small c_ex'.instance) with
1235		\| 0 -> res.state <- Failed {instances=c_ex :: l} (* same size: add [c_ex] to [l] *)
1236		\| n when n<0 -> res.state <- Failed {instances=[c_ex]} (* drop [l] *)
1237		\| _ -> () (* drop [c_ex], not small enough *)
1238		end
1239		\| _ ->
1240		(* no [small] function, keep all counter-examples *)
1241		res.state <-
1242		Failed {instances=c_ex :: l}
1243
1244		let error ~msg_l ~steps res instance exn backtrace =
1245		res.state <- Error {instance={instance; shrink_steps=steps; msg_l; }; exn; backtrace}
1246
1247		let collect r =
1248		if Lazy.is_val r.collect_tbl then Some (Lazy.force r.collect_tbl) else None
1249
1250		let stats r = r.stats_tbl
1251		let warnings r = r.warnings
1252
1253		let is_success r = match r.state with
1254		\| Success -> true
1255		\| Failed _ \| Error _ \| Failed_other _ -> false
	1276	type 'a t = 'a QCheck2.TestResult.t
	1277
	1278	let get_count = QCheck2.TestResult.get_count
	1279	let get_count_gen = QCheck2.TestResult.get_count_gen
	1280	let get_state = QCheck2.TestResult.get_state
	1281	let stats = QCheck2.TestResult.stats
	1282	let collect = QCheck2.TestResult.collect
	1283	let warnings = QCheck2.TestResult.warnings
	1284	let is_success = QCheck2.TestResult.is_success
1256	1285	end
1257	1286
1258	1287	module Test = struct
1259		type 'a cell = {
1260		count : int; (* number of tests to do *)
1261		long_factor : int; (* multiplicative factor for long test count *)
1262		max_gen : int; (* max number of instances to generate (>= count) *)
1263		max_fail : int; (* max number of failures *)
1264		law : 'a -> bool; (* the law to check *)
1265		arb : 'a arbitrary; (* how to generate/print/shrink instances *)
1266		if_assumptions_fail: [`Fatal \| `Warning] * float;
1267		mutable name : string; (* name of the law *)
1268		}
1269
1270		type t = \| Test : 'a cell -> t
1271
1272		let get_name {name; _} = name
1273		let set_name c name = c.name <- name
1274		let get_law {law; _} = law
1275		let get_arbitrary {arb; _} = arb
1276
1277		let get_count {count; _ } = count
1278		let get_long_factor {long_factor; _} = long_factor
1279
1280		let default_count = 100
1281
1282		let fresh_name =
1283		let r = ref 0 in
1284		(fun () -> incr r; Printf.sprintf "anon_test_%d" !r)
1285
1286		let default_if_assumptions_fail = `Warning, 0.05
1287
1288		let make_cell ?(if_assumptions_fail=default_if_assumptions_fail)
1289		?(count=default_count) ?(long_factor=1) ?max_gen
1290		?(max_fail=1) ?small ?(name=fresh_name()) arb law
1291		=
1292		let max_gen = match max_gen with None -> count + 200 \| Some x->x in
1293		let arb = match small with None -> arb \| Some f -> set_small f arb in
1294		{
1295		law;
1296		arb;
1297		max_gen;
1298		max_fail;
1299		name;
1300		count;
1301		long_factor;
1302		if_assumptions_fail;
1303		}
1304
1305		let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?name arb law =
1306		Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?name arb law)
1307
1308		(** {6 Running the test} *)
1309
1310		module R = TestResult
1311
1312		(* Result of an instance run *)
1313		type res =
	1288	type res = QCheck2.Test.res =
1314	1289	\| Success
1315	1290	\| Failure
1316	1291	\| FalseAssumption
1317	1292	\| Error of exn * string
1318
1319		(* Step function, called after each instance test *)
1320		type 'a step = string -> 'a cell -> 'a -> res -> unit
1321
1322		let step_nil_ _ _ _ _ = ()
1323
1324		(* Events of a test *)
1325		type 'a event =
	1293	type 'a event = 'a QCheck2.Test.event =
1326	1294	\| Generating
1327	1295	\| Collecting of 'a
1328	1296	\| Testing of 'a
1329	1297	\| Shrunk of int * 'a
1330	1298	\| Shrinking of int * int * 'a
1331	1299
1332		type 'a handler = string -> 'a cell -> 'a event -> unit
1333
1334		let handler_nil_ _ _ _ = ()
1335
1336		(* state required by {!check} to execute *)
1337		type 'a state = {
1338		test: 'a cell;
1339		step: 'a step;
1340		handler : 'a handler;
1341		rand: Random.State.t;
1342		mutable res: 'a TestResult.t;
1343		mutable cur_count: int; (** number of iterations remaining to do *)
1344		mutable cur_max_gen: int; (** maximum number of generations allowed *)
1345		mutable cur_max_fail: int; (** maximum number of counter-examples allowed *)
1346		}
1347
1348		let is_done state = state.cur_count <= 0 \|\| state.cur_max_gen <= 0
1349
1350		let decr_count state =
1351		state.res.R.count <- state.res.R.count + 1;
1352		state.cur_count <- state.cur_count - 1
1353
1354		let new_input state =
1355		state.res.R.count_gen <- state.res.R.count_gen + 1;
1356		state.cur_max_gen <- state.cur_max_gen - 1;
1357		state.test.arb.gen state.rand
1358
1359		(* statistics on inputs *)
1360		let collect st i = match st.test.arb.collect with
1361		\| None -> ()
1362		\| Some f ->
1363		let key = f i in
1364		let (lazy tbl) = st.res.R.collect_tbl in
1365		let n = try Hashtbl.find tbl key with Not_found -> 0 in
1366		Hashtbl.replace tbl key (n+1)
1367
1368		let update_stats st i =
1369		List.iter
1370		(fun ((_,f), tbl) ->
1371		let key = f i in
1372		let n = try Hashtbl.find tbl key with Not_found -> 0 in
1373		Hashtbl.replace tbl key (n+1))
1374		st.res.R.stats_tbl
1375
1376		type res_or_exn =
1377		\| Shrink_fail
1378		\| Shrink_exn of exn
1379
1380		(* triggered by user to fail with a message *)
1381		exception User_fail of string
1382
1383		let fail_report m = raise (User_fail m)
1384
1385		let fail_reportf m =
1386		let buf = Buffer.create 64 in
1387		Format.kfprintf
1388		(fun out -> Format.fprintf out "@?"; fail_report (Buffer.contents buf))
1389		(Format.formatter_of_buffer buf) m
1390
1391		type 'a run_res =
1392		\| Run_ok
1393		\| Run_fail of string list
1394
1395		let run_law law x =
1396		try
1397		if law x then Run_ok else Run_fail []
1398		with User_fail msg -> Run_fail [msg]
1399
1400		(* try to shrink counter-ex [i] into a smaller one. Returns
1401		shrinked value and number of steps *)
1402		let shrink st (i:'a) (r:res_or_exn) m : 'a * res_or_exn * string list * int =
1403		let is_err = match r with
1404		\| Shrink_exn _ -> true \| _ -> false
1405		in
1406		let rec shrink_ st i r m ~steps =
1407		st.handler st.test.name st.test (Shrunk (steps, i));
1408		match st.test.arb.shrink with
1409		\| None -> i, r, m, steps
1410		\| Some f ->
1411		let count = ref 0 in
1412		let i' = Iter.find_map
1413		(fun x ->
1414		try
1415		incr count;
1416		st.handler st.test.name st.test (Shrinking (steps, !count, x));
1417		begin match run_law st.test.law x with
1418		\| Run_fail m when not is_err -> Some (x, Shrink_fail, m)
1419		\| _ -> None
1420		end
1421		with
1422		\| FailedPrecondition \| No_example_found _ -> None
1423		\| e when is_err -> Some (x, Shrink_exn e, []) (* fail test (by error) *)
1424		) (f i)
1425		in
1426		match i' with
1427		\| None -> i, r, m, steps
1428		\| Some (i',r',m') -> shrink_ st i' r' m' ~steps:(steps+1) (* shrink further *)
1429		in
1430		shrink_ ~steps:0 st i r m
1431
1432		type 'a check_result =
1433		\| CR_continue
1434		\| CR_yield of 'a TestResult.t
1435
1436		(* test raised [e] on [input]; try to shrink then fail *)
1437		let handle_exn state input e bt : _ check_result =
1438		(* first, shrink
1439		TODO: shall we shrink differently (i.e. expected only an error)? *)
1440		let input, r, msg_l, steps = shrink state input (Shrink_exn e) [] in
1441		(* recover exception of shrunk input *)
1442		let e = match r with
1443		\| Shrink_fail -> e
1444		\| Shrink_exn e' -> e'
1445		in
1446		state.step state.test.name state.test input (Error (e, bt));
1447		R.error state.res ~steps ~msg_l input e bt;
1448		CR_yield state.res
1449
1450		(* test failed on [input], which means the law is wrong. Continue if
1451		we should. *)
1452		let handle_fail state input msg_l : _ check_result =
1453		(* first, shrink *)
1454		let input, _, msg_l, steps = shrink state input Shrink_fail msg_l in
1455		(* fail *)
1456		decr_count state;
1457		state.step state.test.name state.test input Failure;
1458		state.cur_max_fail <- state.cur_max_fail - 1;
1459		R.fail ~small:state.test.arb.small state.res ~steps ~msg_l input;
1460		if _is_some state.test.arb.small && state.cur_max_fail > 0
1461		then CR_continue
1462		else CR_yield state.res
1463
1464		(* [check_state state] applies [state.test] repeatedly ([iter] times)
1465		on output of [test.rand], and if [state.test] ever returns false,
1466		then the input that caused the failure is returned in [Failed].
1467		If [func input] raises [FailedPrecondition] then the input is discarded, unless
1468		max_gen is 0. *)
1469		let rec check_state state : _ R.t =
1470		if is_done state then state.res
1471		else (
1472		state.handler state.test.name state.test Generating;
1473		match new_input state with
1474		\| i ->
1475		check_state_input state i
1476		\| exception e ->
1477		(* turn it into an error *)
1478		let bt = Printexc.get_backtrace() in
1479		let msg =
1480		Printf.sprintf
1481		"ERROR: uncaught exception in generator for test %s after %d steps:\n%s\n%s"
1482		state.test.name state.test.count (Printexc.to_string e) bt
1483		in
1484		state.res.R.state <- R.Failed_other {msg};
1485		state.res
1486		)
1487		and check_state_input state input =
1488		state.handler state.test.name state.test (Collecting input);
1489		state.res.R.instances <- input :: state.res.R.instances;
1490		collect state input;
1491		update_stats state input;
1492		let res =
1493		try
1494		state.handler state.test.name state.test (Testing input);
1495		begin match run_law state.test.law input with
1496		\| Run_ok ->
1497		(* one test ok *)
1498		decr_count state;
1499		state.step state.test.name state.test input Success;
1500		CR_continue
1501		\| Run_fail msg_l ->
1502		handle_fail state input msg_l
1503		end
1504		with
1505		\| FailedPrecondition \| No_example_found _ ->
1506		state.step state.test.name state.test input FalseAssumption;
1507		CR_continue
1508		\| e ->
1509		let bt = Printexc.get_backtrace () in
1510		handle_exn state input e bt
1511		in
1512		match res with
1513		\| CR_continue -> check_state state
1514		\| CR_yield x -> x
1515
1516		type 'a callback = string -> 'a cell -> 'a TestResult.t -> unit
1517
1518		let callback_nil_ : _ callback = fun _ _ _ -> ()
1519
1520		(* check that there are sufficiently many tests which passed, to avoid
1521		the case where they all passed by failed precondition *)
1522		let check_if_assumptions target_count cell res : unit =
1523		let percentage_of_count = float_of_int res.R.count /. float_of_int target_count in
1524		let assm_flag, assm_frac = cell.if_assumptions_fail in
1525		if R.is_success res && percentage_of_count < assm_frac then (
1526		let msg =
1527		format_of_string "%s: \
1528		only %.1f%% tests (of %d) passed precondition for %S\n\n\
1529		NOTE: it is likely that the precondition is too strong, or that \
1530		the generator is buggy.\n%!"
1531		in
1532		match assm_flag with
1533		\| `Warning ->
1534		let msg = Printf.sprintf
1535		msg "WARNING"
1536		(percentage_of_count *. 100.) cell.count cell.name in
1537		res.R.warnings <- msg :: res.R.warnings
1538		\| `Fatal ->
1539		(* turn it into an error *)
1540		let msg = Printf.sprintf
1541		msg "ERROR"
1542		(percentage_of_count *. 100.) cell.count cell.name in
1543		res.R.state <- R.Failed_other {msg}
1544		)
1545
1546		(* main checking function *)
1547		let check_cell ?(long=false) ?(call=callback_nil_)
1548		?(step=step_nil_) ?(handler=handler_nil_)
1549		?(rand=Random.State.make [\| 0 \|]) cell =
1550		let factor = if long then cell.long_factor else 1 in
1551		let target_count = factor*cell.count in
1552		let state = {
1553		test=cell; rand;
1554		step; handler;
1555		cur_count=target_count;
1556		cur_max_gen=factor*cell.max_gen;
1557		cur_max_fail=factor*cell.max_fail;
1558		res = {R.
1559		state=R.Success; count=0; count_gen=0;
1560		collect_tbl=lazy (Hashtbl.create 10);
1561		instances=[]; warnings=[];
1562		stats_tbl= List.map (fun stat -> stat, Hashtbl.create 10) cell.arb.stats;
1563		};
1564		} in
1565		let res = check_state state in
1566		check_if_assumptions target_count cell res;
1567		call cell.name cell res;
1568		res
1569
1570		exception Test_fail of string * string list
1571		exception Test_error of string * string * exn * string
1572
1573		(* print instance using [arb] *)
1574		let print_instance arb i = match arb.print with
1575		\| None -> "<instance>"
1576		\| Some pp -> pp i
1577
1578		let print_c_ex arb c : string =
1579		let buf = Buffer.create 64 in
1580		begin
1581		if c.R.shrink_steps > 0
1582		then Printf.bprintf buf "%s (after %d shrink steps)"
1583		(print_instance arb c.R.instance) c.R.shrink_steps
1584		else Buffer.add_string buf (print_instance arb c.R.instance)
1585		end;
1586		List.iter
1587		(fun msg ->
1588		Buffer.add_char buf '\n';
1589		Buffer.add_string buf msg;
1590		Buffer.add_char buf '\n')
1591		c.R.msg_l;
1592		Buffer.contents buf
1593
1594		let pp_print_test_fail name out l =
1595		let rec pp_list out = function
1596		\| [] -> ()
1597		\| [x] -> Format.fprintf out "%s@," x
1598		\| x :: y -> Format.fprintf out "%s@,%a" x pp_list y
1599		in
1600		Format.fprintf out "@[test `%s`@ failed on ≥ %d cases:@ @[<v>%a@]@]"
1601		name (List.length l) pp_list l
1602
1603		let asprintf fmt =
1604		let buf = Buffer.create 128 in
1605		let out = Format.formatter_of_buffer buf in
1606		Format.kfprintf (fun _ -> Buffer.contents buf) out fmt
1607
1608		let print_test_fail name l = asprintf "@[%a@]@?" (pp_print_test_fail name) l
1609
1610		let print_test_error name i e stack =
1611		Format.sprintf "@[test `%s`@ raised exception `%s`@ on `%s`@,%s@]"
1612		name (Printexc.to_string e) i stack
1613
1614		let print_collect c =
1615		let out = Buffer.create 64 in
1616		Hashtbl.iter
1617		(fun case num -> Printf.bprintf out "%s: %d cases\n" case num) c;
1618		Buffer.contents out
1619
1620		let stat_max_lines = 20 (* maximum number of lines for a histogram *)
1621
1622		let print_stat ((name,_), tbl) =
1623		let avg = ref 0. in
1624		let num = ref 0 in
1625		let min_idx, max_idx =
1626		Hashtbl.fold
1627		(fun i res (m1,m2) ->
1628		avg := !avg +. float_of_int (i * res);
1629		num := !num + res;
1630		min i m1, max i m2)
1631		tbl (max_int,min_int)
1632		in
1633		(* compute average *)
1634		if !num > 0 then (
1635		avg := !avg /. float_of_int !num
1636		);
1637		(* compute std-dev: sqroot of sum of squared distance-to-average
1638		https://en.wikipedia.org/wiki/Standard_deviation *)
1639		let stddev =
1640		Hashtbl.fold
1641		(fun i res m -> m +. (float_of_int i -. !avg) ** 2. *. float_of_int res)
1642		tbl 0.
1643		\|> (fun s -> if !num>0 then s /. float_of_int !num else s)
1644		\|> sqrt
1645		in
1646		(* compute median *)
1647		let median = ref 0 in
1648		let median_num = ref 0 in (* how many values have we seen yet? once >= !n/2 we set median *)
1649		(Hashtbl.fold (fun i cnt acc -> (i,cnt)::acc) tbl [])
1650		\|> List.sort (fun (i,_) (j,_) -> poly_compare i j)
1651		\|> List.iter
1652		(fun (i,cnt) ->
1653		if !median_num < !num/2 then (
1654		median_num := !median_num + cnt;
1655		(* just went above median! *)
1656		if !median_num >= !num/2 then
1657		median := i));
1658		(* group by buckets, if there are too many entries: *)
1659		(* first compute histogram and bucket size *)
1660		let hist_size, bucket_size =
1661		let sample_width = Int64.(sub (of_int max_idx) (of_int min_idx)) in
1662		if sample_width > Int64.of_int stat_max_lines
1663		then stat_max_lines,
1664		int_of_float (ceil (Int64.to_float sample_width /. float_of_int stat_max_lines))
1665		else max_idx-min_idx, 1
1666		in
1667		let hist_size = if min_idx + bucket_size * hist_size <= max_idx then 1+hist_size else hist_size in
1668		(* accumulate bucket counts *)
1669		let max_val = ref 0 in (* max value after grouping by buckets *)
1670		let bucket_count = Array.init hist_size (fun _ -> 0) in
1671		Hashtbl.iter
1672		(fun j count ->
1673		let bucket = Int64.(to_int (div (sub (of_int j) (of_int min_idx)) (of_int bucket_size))) in
1674		let new_count = bucket_count.(bucket) + count in
1675		bucket_count.(bucket) <- new_count;
1676		max_val := max !max_val new_count) tbl;
1677		(* print entries of the table, sorted by increasing index *)
1678		let out = Buffer.create 128 in
1679		Printf.bprintf out "stats %s:\n" name;
1680		Printf.bprintf out
1681		" num: %d, avg: %.2f, stddev: %.2f, median %d, min %d, max %d\n"
1682		!num !avg stddev !median min_idx max_idx;
1683		let indwidth =
1684		max (String.length (Printf.sprintf "%d" min_idx))
1685		(max (String.length (Printf.sprintf "%d" max_idx))
1686		(String.length (Printf.sprintf "%d" (min_idx + bucket_size * hist_size)))) in
1687		let labwidth = if bucket_size=1 then indwidth else 2+2*indwidth in
1688		for i = 0 to hist_size - 1 do
1689		let i' = min_idx + i * bucket_size in
1690		let blabel =
1691		if bucket_size=1
1692		then Printf.sprintf "%*d" indwidth i'
1693		else
1694		let bucket_bound = i'+bucket_size-1 in
1695		Printf.sprintf "%d..%d" indwidth i' indwidth (if bucket_bound < i' then max_int else bucket_bound) in
1696		let bcount = bucket_count.(i) in
1697		(* NOTE: keep in sync *)
1698		let bar_len = bcount * 55 / !max_val in
1699		Printf.bprintf out " %*s: %-56s %10d\n" labwidth blabel (String.make bar_len '#') bcount
1700		done;
1701		Buffer.contents out
1702
1703		let () = Printexc.register_printer
1704		(function
1705		\| Test_fail (name,l) -> Some (print_test_fail name l)
1706		\| Test_error (name,i,e,st) -> Some (print_test_error name i e st)
1707		\| User_fail s -> Some ("qcheck: user fail:\n" ^ s)
1708		\| _ -> None)
1709
1710		let print_fail arb name l =
1711		print_test_fail name (List.map (print_c_ex arb) l)
1712
1713		let print_fail_other name ~msg =
1714		print_test_fail name [msg]
1715
1716		let print_error ?(st="") arb name (i,e) =
1717		print_test_error name (print_c_ex arb i) e st
1718
1719		let check_result cell res = match res.R.state with
1720		\| R.Success -> ()
1721		\| R.Error {instance; exn; backtrace} ->
1722		raise (Test_error (cell.name, print_c_ex cell.arb instance, exn, backtrace))
1723		\| R.Failed {instances=l} ->
1724		let l = List.map (print_c_ex cell.arb) l in
1725		raise (Test_fail (cell.name, l))
1726		\| R.Failed_other {msg} ->
1727		raise (Test_fail (cell.name, [msg]))
1728
1729		let check_cell_exn ?long ?call ?step ?rand cell =
1730		let res = check_cell ?long ?call ?step ?rand cell in
1731		check_result cell res
1732
1733		let check_exn ?long ?rand (Test cell) = check_cell_exn ?long ?rand cell
	1300	type 'a cell = 'a QCheck2.Test.cell
	1301	type 'a handler = 'a QCheck2.Test.handler
	1302	type 'a step = 'a QCheck2.Test.step
	1303	type 'a callback = 'a QCheck2.Test.callback
	1304	type t = QCheck2.Test.t
	1305
	1306	include QCheck2.Test_exceptions
	1307
	1308	let print_instance = QCheck2.Test.print_instance
	1309	let print_c_ex = QCheck2.Test.print_c_ex
	1310	let print_error = QCheck2.Test.print_error
	1311	let print_fail = QCheck2.Test.print_fail
	1312	let print_fail_other = QCheck2.Test.print_fail_other
	1313	let print_test_fail = QCheck2.Test.print_test_fail
	1314	let print_test_error = QCheck2.Test.print_test_error
	1315
	1316	let set_name = QCheck2.Test.set_name
	1317	let get_law = QCheck2.Test.get_law
	1318	let get_name = QCheck2.Test.get_name
	1319	let get_count = QCheck2.Test.get_count
	1320	let get_long_factor = QCheck2.Test.get_long_factor
	1321
	1322	let make_cell ?if_assumptions_fail
	1323	?count ?long_factor ?max_gen
	1324	?max_fail ?small:_removed_in_qcheck_2 ?name arb law
	1325	=
	1326	let {gen; shrink; print; collect; stats; _} = arb in
	1327	QCheck2.Test.make_cell_from_QCheck1 ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ~gen ?shrink ?print ?collect ~stats law
	1328
	1329	let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?name arb law =
	1330	QCheck2.Test.Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?name arb law)
	1331
	1332	let fail_report = QCheck2.Test.fail_report
	1333
	1334	let fail_reportf = QCheck2.Test.fail_reportf
	1335
	1336	let check_cell_exn = QCheck2.Test.check_cell_exn
	1337	let check_exn = QCheck2.Test.check_exn
	1338	let check_cell = QCheck2.Test.check_cell
1734	1339	end
1735	1340
1736	1341	let find_example ?(name="<example>") ?count ~f g : _ Gen.t =

1741	1346	let arb = make g in
1742	1347	Test.make_cell ~max_fail:1 ?count arb (fun x -> not (f x))
1743	1348	in
1744		let res = Test.check_cell ~rand:st cell in
1745		begin match res.TestResult.state with
1746		\| TestResult.Success -> raise (No_example_found name)
1747		\| TestResult.Error _ -> raise (No_example_found name)
1748		\| TestResult.Failed {instances=[]} -> assert false
1749		\| TestResult.Failed {instances=failed::_} ->
	1349	let res = QCheck2.Test.check_cell ~rand:st cell in
	1350	begin match QCheck2.TestResult.get_state res with
	1351	\| QCheck2.TestResult.Success -> raise (No_example_found name)
	1352	\| QCheck2.TestResult.Error _ -> raise (No_example_found name)
	1353	\| QCheck2.TestResult.Failed {instances=[]} -> assert false
	1354	\| QCheck2.TestResult.Failed {instances=failed::_} ->
1750	1355	(* found counter-example! *)
1751		failed.TestResult.instance
1752		\| TestResult.Failed_other {msg=_} ->
	1356	failed.QCheck2.TestResult.instance
	1357	\| QCheck2.TestResult.Failed_other {msg=_} ->
1753	1358	raise (No_example_found name)
1754	1359
1755	1360	end

+261

-207

src/core/QCheck.mli less more

0	0	(*
1	1	QCheck: Random testing for OCaml
2		copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard
	2	copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot,
	3	Jan Midtgaard, Julien Debon, Valentin Chaboche
3	4	all rights reserved.
4	5	*)
5	6
6	7	(** {1 Quickcheck inspired property-based testing} *)
7	8
8	9	(** The library takes inspiration from Haskell's QuickCheck library. The
9		rough idea is that the programmer describes invariants that values of
10		a certain type need to satisfy ("properties"), as functions from this type
11		to bool. She also needs to describe how to generate random values of the type,
12		so that the property is tried and checked on a number of random instances.
13
14		This explains the organization of this module:
15
16		- {! 'a arbitrary} is used to describe how to generate random values,
17		shrink them (make counter-examples as small as possible), print
18		them, etc. Auxiliary modules such as {!Gen}, {!Print}, and {!Shrink}
19		can be used along with {!make} to build one's own arbitrary instances.
20
21		- {!Test} is used to describe a single test, that is, a property of
22		type ['a -> bool] combined with an ['a arbitrary] that is used to generate
23		the test cases for this property. Optional parameters
24		allow to specify the random generator state, number of instances to generate
25		and test, etc.
26
27
28		Examples:
29
30		- List.rev is involutive:
31
32		{[
33
34		let test =
35		QCheck.(Test.make ~count:1000
36		(list int) (fun l -> List.rev (List.rev l) = l));;
37
38		QCheck.Test.check_exn test;;
39		]}
40
41		- Not all lists are sorted (false property that will fail. The 15 smallest
42		counter-example lists will be printed):
43
44		{[
45		let test = QCheck.(
46		Test.make
47		~count:10_000 ~max_fail:3
48		(list small_nat)
49		(fun l -> l = List.sort compare l));;
50		QCheck.Test.check_exn test;;
51		]}
52
53
54		- generate 20 random trees using {! Gen.fix} :
55
56		{[
57		type tree = Leaf of int \| Node of tree * tree
58
59		let leaf x = Leaf x
60		let node x y = Node (x,y)
61
62		let g = QCheck.Gen.(sized @@ fix
63		(fun self n -> match n with
64		\| 0 -> map leaf nat
65		\| n ->
66		frequency
67		[1, map leaf nat;
68		2, map2 node (self (n/2)) (self (n/2))]
69		))
70
71		Gen.generate ~n:20 g;;
72		]}
73
74		More complex and powerful combinators can be found in Gabriel Scherer's
75		{!Generator} module. Its documentation can be found
76		{{:http://gasche.github.io/random-generator/doc/Generator.html } here}.
	10	rough idea is that the programmer describes invariants that values of
	11	a certain type need to satisfy ("properties"), as functions from this type
	12	to bool. She also needs to describe how to generate random values of the type,
	13	so that the property is tried and checked on a number of random instances.
	14
	15	This explains the organization of this module:
	16
	17	- {! 'a arbitrary} is used to describe how to generate random values,
	18	shrink them (make counter-examples as small as possible), print
	19	them, etc. Auxiliary modules such as {!Gen}, {!Print}, and {!Shrink}
	20	can be used along with {!make} to build one's own arbitrary instances.
	21
	22	- {!Test} is used to describe a single test, that is, a property of
	23	type ['a -> bool] combined with an ['a arbitrary] that is used to generate
	24	the test cases for this property. Optional parameters
	25	allow to specify the random generator state, number of instances to generate
	26	and test, etc.
	27
	28
	29	Examples:
	30
	31	- List.rev is involutive:
	32
	33	{[
	34
	35	let test =
	36	QCheck.(Test.make ~count:1000
	37	(list int) (fun l -> List.rev (List.rev l) = l));;
	38
	39	QCheck.Test.check_exn test;;
	40	]}
	41
	42	- Not all lists are sorted (false property that will fail. The 15 smallest
	43	counter-example lists will be printed):
	44
	45	{[
	46	let test = QCheck.(
	47	Test.make
	48	~count:10_000 ~max_fail:3
	49	(list small_nat)
	50	(fun l -> l = List.sort compare l));;
	51	QCheck.Test.check_exn test;;
	52	]}
	53
	54
	55	- generate 20 random trees using {! Gen.fix} :
	56
	57	{[
	58	type tree = Leaf of int \| Node of tree * tree
	59
	60	let leaf x = Leaf x
	61	let node x y = Node (x,y)
	62
	63	let g = QCheck.Gen.(sized @@ fix
	64	(fun self n -> match n with
	65	\| 0 -> map leaf nat
	66	\| n ->
	67	frequency
	68	[1, map leaf nat;
	69	2, map2 node (self (n/2)) (self (n/2))]
	70	))
	71
	72	Gen.generate ~n:20 g;;
	73	]}
	74
	75	More complex and powerful combinators can be found in Gabriel Scherer's
	76	{!Generator} module. Its documentation can be found
	77	{{:http://gasche.github.io/random-generator/doc/Generator.html } here}.
77	78	*)
78	79
79	80	val (==>) : bool -> bool -> bool

99	100	Example:
100	101	{[
101	102	Test.make (list int) (fun l ->
102		assume (l <> []);
103		List.hd l :: List.tl l = l)
	103	assume (l <> []);
	104	List.hd l :: List.tl l = l)
104	105	]}
105	106
106	107	@since 0.5.1

114	115	Example:
115	116	{[
116	117	Test.make (list int) (function
117		\| [] -> assume_fail ()
118		\| _::_ as l -> List.hd l :: List.tl l = l)
	118	\| [] -> assume_fail ()
	119	\| _::_ as l -> List.hd l :: List.tl l = l)
119	120	]}
120	121
121	122	@since 0.5.1

167	168	@since 0.13 *)
168	169
169	170	val oneof : 'a t list -> 'a t
170		(** Constructs a generator that selects among a given list of generators. *)
	171	(** Constructs a generator that selects among a given list of generators.
	172	@raise Invalid_argument or Failure if list is empty *)
171	173
172	174	val oneofl : 'a list -> 'a t
173		(** Constructs a generator that selects among a given list of values. *)
	175	(** Constructs a generator that selects among a given list of values.
	176	@raise Invalid_argument or Failure if list is empty *)
174	177
175	178	val oneofa : 'a array -> 'a t
176		(** Constructs a generator that selects among a given array of values. *)
	179	(** Constructs a generator that selects among a given array of values.
	180	@raise Invalid_argument or Failure if list is empty *)
177	181
178	182	val frequency : (int * 'a t) list -> 'a t
179	183	(** Constructs a generator that selects among a given list of generators.

207	211	@since 0.11
208	212	*)
209	213
	214	val range_subset : size:int -> int -> int -> int array t
	215	(** [range_subset ~size:k low high] generates an array of length [k]
	216	of sorted distinct integers in the range [low..high] (included).
	217
	218	Complexity O(k log k), drawing [k] random integers.
	219
	220	@raise Invalid_argument outside the valid region [0 <= k <= high-low+1].
	221
	222	@since 0.18
	223	*)
	224
	225	val array_subset : int -> 'a array -> 'a array t
	226	(** [array_subset k arr] generates a sub-array of [k] elements
	227	at distinct positions in the input array [arr],
	228	in the same order.
	229
	230	Complexity O(k log k), drawing [k] random integers.
	231
	232	@raise Invalid_argument outside the valid region
	233	[0 <= size <= Array.length arr].
	234
	235	@since 0.18
	236	*)
	237
210	238	val unit : unit t (** The unit generator. *)
211	239
212	240	val bool : bool t (** The boolean generator. *)

309	337	val array_repeat : int -> 'a t -> 'a array t
310	338	(** [array_repeat i g] builds an array generator from exactly [i] elements generated by [g]. *)
311	339
312		val opt : 'a t -> 'a option t (** An option generator. *)
	340	val opt : ?ratio:float -> 'a t -> 'a option t
	341	(** An option generator, with optional ratio.
	342	@param ratio a float between [0.] and [1.] indicating the probability of a sample to be [Some _]
	343	rather than [None].
	344	@since 0.18 ([?ratio] parameter)
	345	*)
313	346
314	347	val pair : 'a t -> 'b t -> ('a * 'b) t (** Generates pairs. *)
315	348

346	379	@since 0.11 *)
347	380
348	381	val string_readable : string t
349		(** Builds a string generator using the {!char} character generator.
350		@since 0.11 *)
	382	(** Builds a string generator using the {!printable} character generator.
	383	@since 0.11
	384	@deprecated use {!string_printable} *)
	385	[@@deprecated "see string_printable"]
	386
	387	val string_printable : string t
	388	(** Builds a string generator using the {!printable} character generator.
	389	@since 0.18 *)
351	390
352	391	val small_string : ?gen:char t -> string t
353	392	(** Builds a string generator, length is {!small_nat}

402	441	The passed size-parameter should decrease to ensure termination. *)
403	442
404	443	(** Example:
405		{[
406		type tree = Leaf of int \| Node of tree * tree
407
408		let leaf x = Leaf x
409		let node x y = Node (x,y)
410
411		let g = QCheck.Gen.(sized @@ fix
412		(fun self n -> match n with
413		\| 0 -> map leaf nat
414		\| n ->
415		frequency
416		[1, map leaf nat;
417		2, map2 node (self (n/2)) (self (n/2))]
418		))
419
420		]}
421
	444	{[
	445	type tree = Leaf of int \| Node of tree * tree
	446
	447	let leaf x = Leaf x
	448	let node x y = Node (x,y)
	449
	450	let g = QCheck.Gen.(sized @@ fix
	451	(fun self n -> match n with
	452	\| 0 -> map leaf nat
	453	\| n ->
	454	frequency
	455	[1, map leaf nat;
	456	2, map2 node (self (n/2)) (self (n/2))]
	457	))
	458
	459	]}
	460
	461	*)
	462
	463	val nat_split2 : int -> (int * int) t
	464	(** [nat_split2 n] generates pairs [(n1, n2)] of natural numbers
	465	with [n1 + n2 = n].
	466
	467	This is useful to split sizes to combine sized generators.
	468
	469	@raise Invalid_argument unless [n >= 2].
	470
	471	@since 0.18
	472	*)
	473
	474	val pos_split2 : int -> (int * int) t
	475	(** [nat_split2 n] generates pairs [(n1, n2)] of strictly positive
	476	(nonzero) natural numbers with [n1 + n2 = n].
	477
	478	This is useful to split sizes to combine sized generators.
	479
	480	@since 0.18
	481	*)
	482
	483	val nat_split : size:int -> int -> int array t
	484	(** [nat_split2 ~size:k n] generates [k]-sized arrays [n1,n2,..nk]
	485	of natural numbers in [[0;n]] with [n1 + n2 + ... + nk = n].
	486
	487	This is useful to split sizes to combine sized generators.
	488
	489	Complexity O(k log k).
	490
	491	@since 0.18
	492	*)
	493
	494	val pos_split : size:int -> int -> int array t
	495	(** [nat_split2 ~size:k n] generates [k]-sized arrays [n1,n2,..nk]
	496	of strictly positive (non-zero) natural numbers with
	497	[n1 + n2 + ... + nk = n].
	498
	499	This is useful to split sizes to combine sized generators.
	500
	501	Complexity O(k log k).
	502
	503	@raise Invalid_argument unless [k <= n].
	504
	505	@since 0.18
422	506	*)
423	507
424	508	val delay : (unit -> 'a t) -> 'a t

433	517	val generate1 : ?rand:Random.State.t -> 'a t -> 'a
434	518	(** [generate1 g] generates one instance of [g]. *)
435	519
436		include Qcheck_ops.S with type 'a t_let := 'a t
437		(** @since 0.15 *)
	520	val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
	521
	522	val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
	523
	524	val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
	525
	526	val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
438	527	end
439	528
440	529	(** {2 Pretty printing} *)

512	601	val flatten : 'a t t -> 'a t
513	602	(** @since 0.8 *)
514	603
515		include Qcheck_ops.S with type 'a t_let := 'a t
516		(** @since 0.15 *)
	604	val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
	605
	606	val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
	607
	608	val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
	609
	610	val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
517	611	end
518	612
519	613	(** {2 Shrink Values}

699	793	(** Access the underlying random generator of this arbitrary object.
700	794	@since 0.6 *)
701	795
	796	val get_gen : 'a arbitrary -> 'a Gen.t
	797	(** Access the underlying random generator of this arbitrary object.
	798	@since 0.6 *)
	799
	800	val get_print : 'a arbitrary -> 'a Print.t option
	801
702	802	(** {2 Tests}
703	803
704	804	A test is a universal property of type [foo -> bool] for some type [foo],

713	813
714	814	(** Result of running a test *)
715	815	module TestResult : sig
716		type 'a counter_ex = {
	816	type 'a counter_ex = 'a QCheck2.TestResult.counter_ex = {
717	817	instance: 'a; (** The counter-example(s) *)
718	818
719	819	shrink_steps: int; (** How many shrinking steps for this counterex *)

727	827
728	828	(** Result state.
729	829	changed in 0.10 (move to inline records, add Fail_other) *)
730		type 'a state =
	830	type 'a state = 'a QCheck2.TestResult.state =
731	831	\| Success
732	832	\| Failed of {
733	833	instances: 'a failed_state; (** Failed instance(s) *)

740	840	} (** Error, backtrace, and instance that triggered it *)
741	841
742	842	(* result returned by running a test *)
743		type 'a t = private {
744		mutable state : 'a state;
745		mutable count: int; (* Number of tests *)
746		mutable count_gen: int; (* Number of generated cases *)
747		collect_tbl: (string, int) Hashtbl.t lazy_t;
748		stats_tbl: ('a stat * (int, int) Hashtbl.t) list; (** @since 0.6 *)
749		mutable warnings: string list;
750		mutable instances: 'a list;
751		(** List of instances used for this test, in no particular order.
752		@since 0.9 *)
753		}
	843	type 'a t = 'a QCheck2.TestResult.t
	844
	845	val get_count : _ t -> int
	846	(** Get the count of a cell.
	847	@since 0.5.3 *)
	848
	849	val get_count_gen : _ t -> int
	850
	851	val get_state : 'a t -> 'a state
754	852
755	853	val collect : _ t -> (string,int) Hashtbl.t option
756	854	(** Obtain statistics

769	867	@since 0.9 *)
770	868	end
771	869
	870	(** Module related to individual tests.
	871	@since 0.18 most of it moved to {!QCheck2},
	872	and the type ['a cell] was made a private implementation detail.
	873	*)
772	874	module Test : sig
773		type 'a cell
774		(** A single property test *)
	875	type res = QCheck2.Test.res =
	876	\| Success
	877	\| Failure
	878	\| FalseAssumption
	879	\| Error of exn * string
	880	type 'a event = 'a QCheck2.Test.event =
	881	\| Generating
	882	\| Collecting of 'a
	883	\| Testing of 'a
	884	\| Shrunk of int * 'a
	885	\| Shrinking of int * int * 'a
	886
	887	type 'a cell = 'a QCheck2.Test.cell
	888	type 'a handler = 'a QCheck2.Test.handler
	889	type 'a step = 'a QCheck2.Test.step
	890	type 'a callback = 'a QCheck2.Test.callback
	891
	892	type t = QCheck2.Test.t
775	893
776	894	val fail_report : string -> 'a
777	895	(** Fail the test with some additional message that will

812	930	(since 0.10)
813	931	*)
814	932
815		val get_arbitrary : 'a cell -> 'a arbitrary
816	933	val get_law : 'a cell -> ('a -> bool)
	934	(** @deprecated use {!QCheck2.Test.get_law} instead *)
817	935	val get_name : _ cell -> string
	936	(** @deprecated use {!QCheck2.Test.get_name} instead *)
818	937	val set_name : _ cell -> string -> unit
	938	(** @deprecated use {!QCheck2.Test.set_name} instead *)
819	939
820	940	val get_count : _ cell -> int
821	941	(** Get the count of a cell.
	942	@deprecated use {!QCheck2.Test.get_count} instead
822	943	@since 0.5.3 *)
823	944
824	945	val get_long_factor : _ cell -> int
825	946	(** Get the long factor of a cell.
	947	@deprecated use {!QCheck2.Test.get_long_factor} instead
826	948	@since 0.5.3 *)
827
828		type t = Test : 'a cell -> t
829		(** Same as ['a cell], but masking the type parameter. This allows to
830		put tests on different types in the same list of tests. *)
831	949
832	950	val make :
833	951	?if_assumptions_fail:([`Fatal \| `Warning] * float) ->

838	956	See {!make_cell} for a description of the parameters.
839	957	*)
840	958
841		(** {3 Running the test} *)
842
843		exception Test_fail of string * string list
844		(** Exception raised when a test failed, with the list of counter-examples.
845		[Test_fail (name, l)] means test [name] failed on elements of [l]. *)
846
847		exception Test_error of string * string * exn * string
848		(** Exception raised when a test raised an exception [e], with
849		the sample that triggered the exception.
850		[Test_error (name, i, e, st)]
851		means [name] failed on [i] with exception [e], and [st] is the
852		stacktrace (if enabled) or an empty string. *)
853
854		val print_instance : 'a arbitrary -> 'a -> string
855		val print_c_ex : 'a arbitrary -> 'a TestResult.counter_ex -> string
856		val print_fail : 'a arbitrary -> string -> 'a TestResult.counter_ex list -> string
	959	include module type of QCheck2.Test_exceptions
	960
	961	val print_instance : 'a cell -> 'a -> string
	962	val print_c_ex : 'a cell -> 'a TestResult.counter_ex -> string
	963	val print_fail : 'a cell -> string -> 'a TestResult.counter_ex list -> string
857	964	val print_fail_other : string -> msg:string -> string
858		val print_error : ?st:string -> 'a arbitrary -> string -> 'a TestResult.counter_ex * exn -> string
	965	val print_error : ?st:string -> 'a cell -> string -> 'a TestResult.counter_ex * exn -> string
859	966	val print_test_fail : string -> string list -> string
860	967	val print_test_error : string -> string -> exn -> string -> string
861
862		val print_collect : (string,int) Hashtbl.t -> string
863		(** Print "collect" results.
864		@since 0.6 *)
865
866		val print_stat : ('a stat * (int,int) Hashtbl.t) -> string
867		(** Print statistics.
868		@since 0.6 *)
869
870		val check_result : 'a cell -> 'a TestResult.t -> unit
871		(** [check_result cell res] checks that [res] is [Ok _], and returns unit.
872		Otherwise, it raises some exception.
873		@raise Test_error if [res = Error _]
874		@raise Test_error if [res = Failed _] *)
875
876		type res =
877		\| Success
878		\| Failure
879		\| FalseAssumption
880		\| Error of exn * string
881
882		type 'a event =
883		\| Generating
884		\| Collecting of 'a
885		\| Testing of 'a
886		\| Shrunk of int * 'a
887		\| Shrinking of int * int * 'a
888
889		type 'a handler = string -> 'a cell -> 'a event -> unit
890		(** Handler executed after each event during testing of an instance. *)
891
892		type 'a step = string -> 'a cell -> 'a -> res -> unit
893		(** Callback executed after each instance of a test has been run.
894		The callback is given the instance tested, and the current results
895		of the test. *)
896
897		type 'a callback = string -> 'a cell -> 'a TestResult.t -> unit
898		(** Callback executed after each test has been run.
899		[f name cell res] means test [cell], named [name], gave [res]. *)
900	968
901	969	val check_cell :
902	970	?long:bool -> ?call:'a callback ->
903	971	?step:'a step -> ?handler:'a handler ->
904	972	?rand:Random.State.t -> 'a cell -> 'a TestResult.t
905		(** [check_cell ~long ~rand test] generates up to [count] random
906		values of type ['a] using [arbitrary] and the random state [st]. The
907		predicate [law] is called on them and if it returns [false] or raises an
908		exception then we have a counter-example for the [law].
909
910		@param long if [true] then multiply the number of instances to generate
911		by the cell's long_factor.
912		@param call function called on each test case, with the result.
913		@param step function called on each instance of the test case, with the result.
914		@return the result of the test.
915		*)
916	973
917	974	val check_cell_exn :
918	975	?long:bool -> ?call:'a callback -> ?step:'a step ->
919	976	?rand:Random.State.t -> 'a cell -> unit
920		(** Same as {!check_cell} but calls {!check_result} on the result.
921		@raise Test_error if [res = Error _]
922		@raise Test_error if [res = Failed _] *)
923	977
924	978	val check_exn : ?long:bool -> ?rand:Random.State.t -> t -> unit
925		(** Checks the property against some test cases, and calls {!check_result},
926		which might raise an exception in case of failure.
927		@raise Test_error if [res = Error _]
928		@raise Test_error if [res = Failed _] *)
929	979	end
930	980
931	981	(** {2 Sub-tests} *)

974	1024
975	1025	val choose : 'a arbitrary list -> 'a arbitrary
976	1026	(** Choose among the given list of generators. The list must not
977		be empty; if it is Invalid_argument is raised. *)
	1027	be empty; if it is Invalid_argument is raised. *)
978	1028
979	1029	val unit : unit arbitrary
980	1030	(** Always generates [()], obviously. *)

1045	1095
1046	1096	val small_int_corners : unit -> int arbitrary
1047	1097	(** As [small_int], but each newly created generator starts with
1048		a list of corner cases before falling back on random generation. *)
	1098	a list of corner cases before falling back on random generation. *)
1049	1099
1050	1100	val neg_int : int arbitrary
1051	1101	(** Negative int generator (0 included, see {!Gen.neg_int}).

1123	1173	(** Combines four generators into a generator of 4-tuples.
1124	1174	Order matters for shrinking, see {!Shrink.pair} and the likes *)
1125	1175
1126		val option : 'a arbitrary -> 'a option arbitrary
1127		(** Choose between returning Some random value, or None. *)
	1176	val option : ?ratio:float -> 'a arbitrary -> 'a option arbitrary
	1177	(** Choose between returning Some random value with optional ratio, or None. *)
1128	1178
1129	1179	val fun1_unsafe : 'a arbitrary -> 'b arbitrary -> ('a -> 'b) arbitrary
1130	1180	(** Generator of functions of arity 1.
1131	1181	The functions are always pure and total functions:
1132	1182	- when given the same argument (as decided by Pervasives.(=)), it returns the same value
1133	1183	- it never does side effects, like printing or never raise exceptions etc.
1134		The functions generated are really printable.
	1184	The functions generated are really printable.
1135	1185
1136	1186	renamed from {!fun1} since 0.6
1137	1187

1249	1299	(** @since 0.6 *)
1250	1300
1251	1301	val oneofl : ?print:'a Print.t -> ?collect:('a -> string) ->
1252		'a list -> 'a arbitrary
	1302	'a list -> 'a arbitrary
1253	1303	(** Pick an element randomly in the list. *)
1254	1304
1255	1305	val oneofa : ?print:'a Print.t -> ?collect:('a -> string) ->
1256		'a array -> 'a arbitrary
	1306	'a array -> 'a arbitrary
1257	1307	(** Pick an element randomly in the array. *)
1258	1308
1259	1309	val oneof : 'a arbitrary list -> 'a arbitrary
1260		(** Pick a generator among the list, randomly. *)
	1310	(** Pick a generator among the list, randomly.
	1311	@deprecated this function is badly specified and will not use shrinkers
	1312	appropriately. Consider using {!Gen.oneof} and then {!make} to build
	1313	a well behaved arbitrary instance.
	1314	*)
1261	1315
1262	1316	val always : ?print:'a Print.t -> 'a -> 'a arbitrary
1263	1317	(** Always return the same element. *)
1264	1318
1265	1319	val frequency : ?print:'a Print.t -> ?small:('a -> int) ->
1266		?shrink:'a Shrink.t -> ?collect:('a -> string) ->
1267		(int * 'a arbitrary) list -> 'a arbitrary
	1320	?shrink:'a Shrink.t -> ?collect:('a -> string) ->
	1321	(int * 'a arbitrary) list -> 'a arbitrary
1268	1322	(** Similar to {!oneof} but with frequencies. *)
1269	1323
1270	1324	val frequencyl : ?print:'a Print.t -> ?small:('a -> int) ->
1271		(int * 'a) list -> 'a arbitrary
	1325	(int * 'a) list -> 'a arbitrary
1272	1326	(** Same as {!oneofl}, but each element is paired with its frequency in
1273	1327	the probability distribution (the higher, the more likely). *)
1274	1328
1275	1329	val frequencya : ?print:'a Print.t -> ?small:('a -> int) ->
1276		(int * 'a) array -> 'a arbitrary
	1330	(int * 'a) array -> 'a arbitrary
1277	1331	(** Same as {!frequencyl}, but with an array. *)
1278	1332
1279	1333	val map : ?rev:('b -> 'a) -> ('a -> 'b) -> 'a arbitrary -> 'b arbitrary

1286	1340
1287	1341	val map_same_type : ('a -> 'a) -> 'a arbitrary -> 'a arbitrary
1288	1342	(** Specialization of [map] when the transformation preserves the type, which
1289		makes shrinker, printer, etc. still relevant. *)
	1343	makes shrinker, printer, etc. still relevant. *)
1290	1344
1291	1345	val map_keep_input :
1292	1346	?print:'b Print.t -> ?small:('b -> int) ->

+1800

-0

src/core/QCheck2.ml less more

	0	(*
	1	QCheck: Random testing for OCaml
	2	copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot,
	3	Jan Midtgaard, Julien Debon, Valentin Chaboche
	4	all rights reserved.
	5	*)
	6
	7	(** {1 Quickcheck inspired property-based testing} *)
	8
	9	let poly_compare=compare
	10
	11	module RS = Random.State
	12
	13	let rec foldn ~f ~init:acc i =
	14	if i = 0 then acc else foldn ~f ~init:(f acc i) (i-1)
	15
	16	let _opt_map_2 ~f a b = match a, b with
	17	\| Some x, Some y -> Some (f x y)
	18	\| _ -> None
	19
	20	let _opt_map_3 ~f a b c = match a, b, c with
	21	\| Some x, Some y, Some z -> Some (f x y z)
	22	\| _ -> None
	23
	24	let _opt_map_4 ~f a b c d = match a, b, c, d with
	25	\| Some x, Some y, Some z, Some w -> Some (f x y z w)
	26	\| _ -> None
	27
	28	let _opt_sum a b = match a, b with
	29	\| Some _, _ -> a
	30	\| None, _ -> b
	31
	32	let sum_int = List.fold_left (+) 0
	33
	34	exception Failed_precondition
	35	(* raised if precondition is false *)
	36
	37	exception No_example_found of string
	38	(* raised if an example failed to be found *)
	39
	40	let assume b = if not b then raise Failed_precondition
	41
	42	let assume_fail () = raise Failed_precondition
	43
	44	let (==>) b1 b2 = if b1 then b2 else raise Failed_precondition
	45
	46	(** Enhancement of Stdlib [Seq] to backport some recent functions, and add a few useful others. *)
	47	module Seq = struct
	48
	49	include Seq
	50
	51	(* The following functions are copied from https://github.com/ocaml/ocaml/blob/trunk/stdlib/seq.ml to support older OCaml versions. *)
	52
	53	let rec unfold f u () =
	54	match f u with
	55	\| None -> Nil
	56	\| Some (x, u') -> Cons (x, unfold f u')
	57
	58	let rec append seq1 seq2 () =
	59	match seq1() with
	60	\| Nil -> seq2()
	61	\| Cons (x, next) -> Cons (x, append next seq2)
	62
	63	let cons x next () = Cons (x, next)
	64
	65	(* End of copy of old functions. *)
	66
	67	let is_empty (seq : _ t) : bool = match seq () with
	68	\| Nil -> true
	69	\| _ -> false
	70
	71	(** Take at most [n] values. *)
	72	let rec take (n : int) (seq : _ t) : _ t = fun () -> match (n, seq ()) with
	73	\| (0, _) \| (_, Nil) -> Nil
	74	\| (n, Cons (a, rest)) -> Cons (a, take (n - 1) rest)
	75
	76
	77	let hd (l : 'a t) : 'a option =
	78	match l () with
	79	\| Nil -> None
	80	\| Cons (hd, _) -> Some hd
	81
	82	(** Useful to improve [Seq] code perf when chaining functions *)
	83	let apply (l : 'a t) : 'a node = l ()
	84	end
	85
	86	module Shrink = struct
	87
	88	module type Number = sig
	89	type t
	90	val equal : t -> t -> bool
	91	val div : t -> t -> t
	92	val add : t -> t -> t
	93	val sub : t -> t -> t
	94	val of_int : int -> t
	95	end
	96
	97	let number_towards (type a) (module Number : Number with type t = a) ~(destination : a) (x : a) : a Seq.t = fun () ->
	98	Seq.unfold (fun current_shrink ->
	99	if Number.equal current_shrink x
	100	then None
	101	else (
	102	(* Halve the operands before subtracting them so they don't overflow.
	103	Consider [number_towards min_int max_int] *)
	104	let half_diff = Number.sub (Number.div x (Number.of_int 2)) (Number.div current_shrink (Number.of_int 2)) in
	105	if half_diff = Number.of_int 0
	106	(* [current_shrink] is the last valid shrink candidate, put [x] as next step to make sure we stop *)
	107	then Some (current_shrink, x)
	108	else Some (current_shrink, Number.add current_shrink half_diff)
	109	)) destination ()
	110
	111	let int_towards destination x = fun () ->
	112	let module Int : Number with type t = int = struct
	113	include Int
	114	let of_int = Fun.id
	115	end in
	116	number_towards (module Int) ~destination x ()
	117
	118	let int32_towards destination x = fun () ->
	119	number_towards (module Int32) ~destination x ()
	120
	121	let int64_towards destination x = fun () ->
	122	number_towards (module Int64) ~destination x ()
	123
	124	(** Arbitrarily limit to 15 elements as dividing a [float] by 2 doesn't converge quickly
	125	towards the destination. *)
	126	let float_towards destination x = fun () ->
	127	number_towards (module Float) ~destination x \|> Seq.take 15 \|> Seq.apply
	128
	129	let int_aggressive_towards (destination : int) (n : int) : int Seq.t = fun () ->
	130	Seq.unfold (fun current ->
	131	if current = n then None
	132	else if current < n then let next = succ current in Some (next, next)
	133	else let next = pred current in Some (next, next)
	134	) destination ()
	135
	136	let int_aggressive n = fun () -> int_aggressive_towards 0 n ()
	137
	138	end
	139
	140	module Tree = struct
	141	type 'a t = Tree of 'a * ('a t) Seq.t
	142
	143	let root (Tree (root, _) : 'a t) : 'a = root
	144
	145	let children (Tree (_, children) : 'a t) : ('a t) Seq.t = children
	146
	147	let rec pp ?(depth : int option) (inner_pp : Format.formatter -> 'a -> unit) (ppf : Format.formatter) (t : 'a t) : unit =
	148	let Tree (x, xs) = t in
	149	let wrapper_box ppf inner =
	150	Format.fprintf ppf "@[<hv2>Tree(@,%a@]@,)" inner ()
	151	in
	152	let inner ppf () =
	153	Format.fprintf ppf "@[<hv2>Node(@,%a@]@,),@ @[<hv>Shrinks(" inner_pp x;
	154	if Option.fold depth ~none:false ~some:(fun depth -> depth <= 0) then (
	155	Format.fprintf ppf "<max depth reached>@])")
	156	else if Seq.is_empty xs then Format.fprintf ppf "@])"
	157	else (
	158	Format.fprintf ppf "@,%a@]@,)"
	159	(Format.pp_print_list
	160	~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
	161	(pp ?depth:(Option.map pred depth) inner_pp))
	162	(List.of_seq xs);
	163	)
	164	in
	165	wrapper_box ppf inner
	166
	167	let rec map (f : 'a -> 'b) (a : 'a t) : 'b t =
	168	let Tree (x, xs) = a in
	169	let y = f x in
	170	let ys = fun () -> Seq.map (fun smaller_x -> map f smaller_x) xs () in
	171	Tree (y, ys)
	172
	173	(** Note that parameter order is reversed. *)
	174	let (>\|=) a f = map f a
	175
	176	let rec ap (f : ('a -> 'b) t) (a : 'a t) : 'b t =
	177	let Tree (x0, xs) = a in
	178	let Tree (f0, fs) = f in
	179	let y = f0 x0 in
	180	let ys = fun () -> Seq.append (Seq.map (fun f' -> ap f' a) fs) (Seq.map (fun x' -> ap f x') xs) () in
	181	Tree (y, ys)
	182
	183	let (<*>) = ap
	184
	185	let liftA2 (f : 'a -> 'b -> 'c) (a : 'a t) (b : 'b t) : 'c t =
	186	(a >\|= f) <*> b
	187
	188	let rec bind (a : 'a t) (f : 'a -> 'b t) : 'b t =
	189	let Tree (x, xs) = a in
	190	let Tree (y, ys_of_x) = f x in
	191	let ys_of_xs = fun () -> Seq.map (fun smaller_x -> bind smaller_x f) xs () in
	192	let ys = fun () -> Seq.append ys_of_xs ys_of_x () in
	193	Tree (y, ys)
	194
	195	let (>>=) = bind
	196
	197	let pure x = Tree (x, Seq.empty)
	198
	199	let rec make_primitive (shrink : 'a -> 'a Seq.t) (x : 'a) : 'a t =
	200	let shrink_trees = fun () -> shrink x \|> Seq.map (make_primitive shrink) \|> Seq.apply in
	201	Tree (x, shrink_trees)
	202
	203	let rec opt (a : 'a t) : 'a option t =
	204	let Tree (x, xs) = a in
	205	let shrinks = fun () -> Seq.cons (pure None) (Seq.map opt xs) () in
	206	Tree (Some x, shrinks)
	207
	208	let rec sequence_list (l : 'a t list) : 'a list t = match l with
	209	\| [] -> pure []
	210	\| hd :: tl -> liftA2 List.cons hd (sequence_list tl)
	211
	212	let rec add_shrink_invariant (p : 'a -> bool) (a : 'a t) : 'a t =
	213	let Tree (x, xs) = a in
	214	let xs' = fun () -> Seq.filter_map (fun (Tree (x', _) as t) -> if p x' then Some (add_shrink_invariant p t) else None) xs () in
	215	Tree (x, xs')
	216
	217	(** [applicative_take n trees] returns a tree of lists with at most the [n] first elements of the input list. *)
	218	let rec applicative_take (n : int) (l : 'a t list) : 'a list t = match (n, l) with
	219	\| (0, _) \| (_, []) -> pure []
	220	\| (n, (tree :: trees)) -> liftA2 List.cons tree (applicative_take (pred n) trees)
	221	end
	222
	223	module Gen = struct
	224
	225	type 'a t = RS.t -> 'a Tree.t
	226
	227	type 'a sized = int -> RS.t -> 'a Tree.t
	228
	229	let map f x = fun st -> Tree.map f (x st)
	230
	231	(** Note that parameter order is reversed. *)
	232	let (>\|=) x f = map f x
	233
	234	let (<$>) = map
	235
	236	let pure (a : 'a) : 'a t = fun _ -> Tree.pure a
	237
	238	let ap (f : ('a -> 'b) t) (x : 'a t) : 'b t = fun st -> Tree.ap (f st) (x st)
	239
	240	let (<*>) = ap
	241
	242	let liftA2 (f : 'a -> 'b -> 'c) (a : 'a t) (b : 'b t) : 'c t =
	243	(a >\|= f) <*> b
	244
	245	let liftA3 (f : 'a -> 'b -> 'c -> 'd) (a : 'a t) (b : 'b t) (c : 'c t) : 'd t =
	246	(a >\|= f) <> b <> c
	247
	248	let map2 = liftA2
	249
	250	let map3 = liftA3
	251
	252	let return = pure
	253
	254	let bind (gen : 'a t) (f : 'a -> ('b t)) : 'b t = fun st -> Tree.bind (gen st) (fun a -> f a st)
	255
	256	let (>>=) = bind
	257
	258	let sequence_list (l : 'a t list) : 'a list t = fun st -> List.map (fun gen -> gen st) l \|> Tree.sequence_list
	259
	260	let make_primitive ~(gen : RS.t -> 'a) ~(shrink : 'a -> 'a Seq.t) : 'a t = fun st ->
	261	Tree.make_primitive shrink (gen st)
	262
	263	let parse_origin (loc : string) (pp : Format.formatter -> 'a -> unit) ~(origin : 'a) ~(low : 'a) ~(high : 'a) : 'a =
	264	if origin < low then invalid_arg Format.(asprintf "%s: origin value %a is lower than low value %a" loc pp origin pp low)
	265	else if origin > high then invalid_arg Format.(asprintf "%s: origin value %a is greater than high value %a" loc pp origin pp high)
	266	else origin
	267
	268	let small_nat : int t = fun st ->
	269	let p = RS.float st 1. in
	270	let x = if p < 0.75 then RS.int st 10 else RS.int st 100 in
	271	let shrink a = fun () -> Shrink.int_towards 0 a () in
	272	Tree.make_primitive shrink x
	273
	274	(** Natural number generator *)
	275	let nat : int t = fun st ->
	276	let p = RS.float st 1. in
	277	let x =
	278	if p < 0.5 then RS.int st 10
	279	else if p < 0.75 then RS.int st 100
	280	else if p < 0.95 then RS.int st 1_000
	281	else RS.int st 10_000
	282	in
	283	let shrink a = fun () -> Shrink.int_towards 0 a () in
	284	Tree.make_primitive shrink x
	285
	286	let big_nat : int t = fun st ->
	287	let p = RS.float st 1. in
	288	if p < 0.75
	289	then nat st
	290	else
	291	let shrink a = fun () -> Shrink.int_towards 0 a () in
	292	Tree.make_primitive shrink (RS.int st 1_000_000)
	293
	294	let unit : unit t = fun _st -> Tree.pure ()
	295
	296	let bool : bool t = fun st ->
	297	let false_gen = Tree.pure false in
	298	if RS.bool st
	299	then Tree.Tree (true, Seq.return false_gen)
	300	else false_gen
	301
	302	let float : float t = fun st ->
	303	let x = exp (RS.float st 15. *. (if RS.bool st then 1. else -1.))
	304	*. (if RS.bool st then 1. else -1.)
	305	in
	306	let shrink a = fun () -> Shrink.float_towards 0. a () in
	307	Tree.make_primitive shrink x
	308
	309	let pfloat : float t = float >\|= abs_float
	310
	311	let nfloat : float t = pfloat >\|= Float.neg
	312
	313	let float_bound_inclusive ?(origin : float = 0.) (bound : float) : float t = fun st ->
	314	let (low, high) = Float.min_max_num 0. bound in
	315	let shrink a = fun () ->
	316	let origin = parse_origin "Gen.float_bound_inclusive" Format.pp_print_float ~origin ~low ~high in
	317	Shrink.float_towards origin a ()
	318	in
	319	let x = RS.float st bound in
	320	Tree.make_primitive shrink x
	321
	322	let float_bound_exclusive ?(origin : float = 0.) (bound : float) : float t =
	323	if bound = 0. then invalid_arg "Gen.float_bound_exclusive";
	324	fun st ->
	325	let (low, high) = Float.min_max_num 0. bound in
	326	let shrink a = fun () ->
	327	let origin = parse_origin "Gen.float_bound_exclusive" Format.pp_print_float ~origin ~low ~high in
	328	Shrink.float_towards origin a ()
	329	in
	330	let bound =
	331	if bound > 0.
	332	then bound -. epsilon_float
	333	else bound +. epsilon_float
	334	in
	335	let x = RS.float st bound in
	336	Tree.make_primitive shrink x
	337
	338	let pick_origin_within_range ~low ~high ~goal =
	339	if low > goal then low
	340	else if high < goal then high
	341	else goal
	342
	343	let float_range ?(origin : float option) (low : float) (high : float) : float t =
	344	if high < low then invalid_arg "Gen.float_range: high < low"
	345	else if high -. low > max_float then invalid_arg "Gen.float_range: high -. low > max_float";
	346	let origin = parse_origin "Gen.float_range" Format.pp_print_float
	347	~origin:(Option.value ~default:(pick_origin_within_range ~low ~high ~goal:0.) origin)
	348	~low
	349	~high in
	350	(float_bound_inclusive ~origin (high -. low))
	351	>\|= (fun x -> low +. x)
	352
	353	let (--.) low high = float_range ?origin:None low high
	354
	355	let neg_int : int t = nat >\|= Int.neg
	356
	357	(** [opt gen] shrinks towards [None] then towards shrinks of [gen]. *)
	358	let opt ?(ratio : float = 0.85) (gen : 'a t) : 'a option t = fun st ->
	359	let p = RS.float st 1. in
	360	if p < (1. -. ratio)
	361	then Tree.pure None
	362	else Tree.opt (gen st)
	363
	364	(* Uniform positive random int generator.
	365
	366	We can't use {!RS.int} because the upper bound must be positive and is excluded,
	367	so {!Int.max_int} would never be reached. We have to manipulate bits directly.
	368
	369	Note that the leftmost bit is used for negative numbers, so it must be [0].
	370
	371	{!RS.bits} only generates 30 bits, which is exactly enough on
	372	32-bits architectures (i.e. {!Sys.int_size} = 31, i.e. 30 bits for positive numbers)
	373	but not on 64-bits ones.
	374
	375	That's why for 64-bits, 3 30-bits segments are generated and shifted to craft a
	376	62-bits number (i.e. {!Sys.int_size} = 63). The leftmost segment is masked to keep
	377	only the last 2 bits.
	378
	379	The current implementation hard-codes 30/32/62/64 values, but technically we should
	380	rely on {!Sys.int_size} to find the number of bits.
	381
	382	Note that we could also further generalize this function to merge it with [random_binary_string].
	383	Technically this function is a special case of [random_binary_string] where the size is
	384	{!Sys.int_size}.
	385	*)
	386	let pint_raw : RS.t -> int =
	387	if Sys.word_size = 32
	388	then fun st -> RS.bits st
	389	else (* word size = 64 *)
	390	fun st ->
	391	(* Technically we could write [3] but this is clearer *)
	392	let two_bits_mask = 0b11 in
	393	(* Top 2 bits *)
	394	let left = ((RS.bits st land two_bits_mask) lsl 60) in
	395	(* Middle 30 bits *)
	396	let middle = (RS.bits st lsl 30) in
	397	(* Bottom 30 bits *)
	398	let right = RS.bits st in
	399	left lor middle lor right
	400
	401	let pint ?(origin : int = 0) : int t = fun st ->
	402	let x = pint_raw st in
	403	let shrink a = fun () ->
	404	let origin = parse_origin "Gen.pint" Format.pp_print_int ~origin ~low:0 ~high:max_int in
	405	Shrink.int_towards origin a ()
	406	in
	407	Tree.make_primitive shrink x
	408
	409	let number_towards = Shrink.number_towards
	410
	411	let int_towards = Shrink.int_towards
	412
	413	let int64_towards = Shrink.int64_towards
	414
	415	let int32_towards = Shrink.int32_towards
	416
	417	let float_towards = Shrink.float_towards
	418
	419	let int : int t =
	420	bool >>= fun b ->
	421	if b
	422	then pint ~origin:0 >\|= (fun n -> - n - 1)
	423	else pint ~origin:0
	424
	425	let int_bound (n : int) : int t =
	426	if n < 0 then invalid_arg "Gen.int_bound";
	427	fun st ->
	428	if n <= (1 lsl 30) - 2
	429	then Tree.make_primitive (fun a () -> Shrink.int_towards 0 a ()) (RS.int st (n + 1))
	430	else Tree.map (fun r -> r mod (n + 1)) (pint st)
	431
	432	(** To support ranges wider than [Int.max_int], the general idea is to find the center,
	433	and generate a random half-difference number as well as whether we add or
	434	subtract that number from the center. *)
	435	let int_range ?(origin : int option) (low : int) (high : int) : int t =
	436	if high < low then invalid_arg "Gen.int_range: high < low";
	437	fun st ->
	438	let Tree.Tree(n, _shrinks) = if low >= 0 \|\| high < 0 then (
	439	(* range smaller than max_int *)
	440	Tree.map (fun n -> low + n) (int_bound (high - low) st)
	441	) else (
	442	(* range potentially bigger than max_int: we split on 0 and
	443	choose the interval with regard to their size ratio *)
	444	let f_low = float_of_int low in
	445	let f_high = float_of_int high in
	446	let ratio = (-.f_low) /. (1. +. f_high -. f_low) in
	447	if RS.float st 1. <= ratio
	448	then Tree.map (fun n -> -n - 1) (int_bound (- (low + 1)) st)
	449	else int_bound high st
	450	) in
	451	let shrink a = fun () ->
	452	let origin = match origin with
	453	\| None -> pick_origin_within_range ~low ~high ~goal:0
	454	\| Some origin ->
	455	if origin < low
	456	then invalid_arg "Gen.int_range: origin < low"
	457	else if origin > high then invalid_arg "Gen.int_range: origin > high"
	458	else origin
	459	in
	460	Shrink.int_towards origin a ()
	461	in
	462	Tree.make_primitive shrink n
	463
	464	let (--) low high = int_range ?origin:None low high
	465
	466	let oneof (l : 'a t list) : 'a t =
	467	int_range 0 (List.length l - 1) >>= List.nth l
	468
	469	let oneofl (l : 'a list) : 'a t =
	470	int_range 0 (List.length l - 1) >\|= List.nth l
	471
	472	let oneofa (a : 'a array) : 'a t =
	473	int_range 0 (Array.length a - 1) >\|= Array.get a
	474
	475	(* NOTE: we keep this alias to not break code that uses [small_int]
	476	for sizes of strings, arrays, etc. *)
	477	let small_int = small_nat
	478
	479	let small_signed_int : int t = fun st ->
	480	if RS.bool st
	481	then small_nat st
	482	else (small_nat >\|= Int.neg) st
	483
	484	(** Shrink towards the first element of the list *)
	485	let frequency (l : (int * 'a t) list) : 'a t =
	486	if l = [] then failwith "QCheck2.frequency called with an empty list";
	487	let sums = sum_int (List.map fst l) in
	488	if sums < 1 then failwith "QCheck2.frequency called with weight sum < 1";
	489	int_bound (sums - 1)
	490	>>= fun i ->
	491	let rec aux acc = function
	492	\| ((x, g) :: xs) -> if i < acc + x then g else aux (acc + x) xs
	493	\| _ -> assert false
	494	in
	495	aux 0 l
	496
	497	let frequencyl (l : (int * 'a) list) : 'a t =
	498	List.map (fun (weight, value) -> (weight, pure value)) l
	499	\|> frequency
	500
	501	let frequencya a = frequencyl (Array.to_list a)
	502
	503	let char_range ?(origin : char option) (a : char) (b : char) : char t =
	504	(int_range ~origin:(Char.code (Option.value ~default:a origin)) (Char.code a) (Char.code b)) >\|= Char.chr
	505
	506	let random_binary_string (length : int) (st : RS.t) : string =
	507	(* 0b011101... *)
	508	let s = Bytes.create (length + 2) in
	509	Bytes.set s 0 '0';
	510	Bytes.set s 1 'b';
	511	for i = 0 to length - 1 do
	512	Bytes.set s (i+2) (if RS.bool st then '0' else '1')
	513	done;
	514	Bytes.unsafe_to_string s
	515
	516	let int32 : int32 t = fun st ->
	517	let x = random_binary_string 32 st \|> Int32.of_string in
	518	let shrink a = fun () -> Shrink.int32_towards 0l a () in
	519	Tree.make_primitive shrink x
	520
	521	let ui32 : int32 t = map Int32.abs int32
	522
	523	let int64 : int64 t = fun st ->
	524	let x = random_binary_string 64 st \|> Int64.of_string in
	525	let shrink a = fun () -> Shrink.int64_towards 0L a () in
	526	Tree.make_primitive shrink x
	527
	528	let ui64 : int64 t = map Int64.abs int64
	529
	530	let list_size (size : int t) (gen : 'a t) : 'a list t =
	531	size >>= fun size ->
	532	let rec loop n =
	533	if n <= 0
	534	then pure []
	535	else liftA2 List.cons gen (loop (n - 1))
	536	in
	537	loop size
	538
	539	let list (gen : 'a t) : 'a list t = list_size nat gen
	540
	541	let list_repeat (n : int) (gen : 'a t) : 'a list t = list_size (pure n) gen
	542
	543	let array_size (size : int t) (gen : 'a t) : 'a array t =
	544	(list_size size gen) >\|= Array.of_list
	545
	546	let array (gen : 'a t) : 'a array t = list gen >\|= Array.of_list
	547
	548	let array_repeat (n : int) (gen : 'a t) : 'a array t = list_repeat n gen >\|= Array.of_list
	549
	550	let rec flatten_l (l : 'a t list) : 'a list t =
	551	match l with
	552	\| [] -> pure []
	553	\| gen :: gens -> liftA2 List.cons gen (flatten_l gens)
	554
	555	let flatten_a (a : 'a t array) : 'a array t =
	556	Array.to_list a \|> flatten_l >\|= Array.of_list
	557
	558	let flatten_opt (o : 'a t option) : 'a option t =
	559	match o with
	560	\| None -> pure None
	561	\| Some gen -> opt gen
	562
	563	let flatten_res (res : ('a t, 'e) result) : ('a, 'e) result t =
	564	match res with
	565	\| Ok gen -> gen >\|= Result.ok
	566	\| Error e -> pure (Error e)
	567
	568	let shuffle_a (a : 'a array) : 'a array t = fun st ->
	569	let a = Array.copy a in
	570	for i = Array.length a - 1 downto 1 do
	571	let j = RS.int st (i + 1) in
	572	let tmp = a.(i) in
	573	a.(i) <- a.(j);
	574	a.(j) <- tmp;
	575	done;
	576	Tree.pure a
	577
	578	let shuffle_l (l : 'a list) : 'a list t =
	579	Array.of_list l \|> shuffle_a >\|= Array.to_list
	580
	581	let shuffle_w_l (l : ((int * 'a) list)) : 'a list t = fun st ->
	582	let sample (w, v) =
	583	let Tree.Tree (p, _) = float_bound_inclusive 1. st in
	584	let fl_w = float_of_int w in
	585	(p ** (1. /. fl_w), v)
	586	in
	587	let samples = List.rev_map sample l in
	588	samples
	589	\|> List.sort (fun (w1, _) (w2, _) -> poly_compare w1 w2)
	590	\|> List.rev_map snd
	591	\|> Tree.pure
	592
	593	let pair (g1 : 'a t) (g2 : 'b t) : ('a * 'b) t = liftA2 (fun a b -> (a, b)) g1 g2
	594
	595	let triple (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) : ('a * 'b * 'c) t = (fun a b c -> (a, b, c)) <$> g1 <> g2 <> g3
	596
	597	let quad (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) : ('a * 'b * 'c * 'd) t =
	598	(fun a b c d -> (a, b, c, d)) <$> g1 <> g2 <> g3 <*> g4
	599
	600	(** Don't reuse {!int_range} which is much less performant (many more checks because of the possible range and origins). As a [string] generator may call this hundreds or even thousands of times for a single value, it's worth optimizing. *)
	601	let char : char t = fun st ->
	602	let c = RS.int st 256 in
	603	let shrink a = fun () -> Shrink.int_towards (int_of_char 'a') a \|> Seq.apply in
	604	Tree.map char_of_int (Tree.make_primitive shrink c)
	605
	606	(** The first characters are the usual lower case alphabetical letters to help shrinking. *)
	607	let printable_chars : char list =
	608	(* Left and right inclusive *)
	609	let range min max = List.init (max - min) (fun i -> char_of_int (i + min)) in
	610	let a = 97 in
	611	let z = 122 in
	612	let lower_alphabet = range a z in
	613	(* ' ' *)
	614	let first_printable_char = 32 in
	615	let before_lower_alphabet = range first_printable_char (a - 1) in
	616	(* '~' *)
	617	let last_printable_char = 126 in
	618	let after_lower_alphabet = range (z + 1) last_printable_char in
	619	let newline = ['\n'] in
	620	(* Put alphabet first for shrinking *)
	621	List.flatten [lower_alphabet; before_lower_alphabet; after_lower_alphabet; newline]
	622
	623	let printable : char t =
	624	int_range ~origin:0 0 (List.length printable_chars - 1)
	625	>\|= List.nth printable_chars
	626
	627	let numeral : char t =
	628	let zero = 48 in
	629	let nine = 57 in
	630	int_range ~origin:zero zero nine >\|= char_of_int
	631
	632	let bytes_size ?(gen = char) (size : int t) : bytes t = fun st ->
	633	let open Tree in
	634	size st >>= fun size ->
	635	(* Adding char shrinks to a mutable list is expensive: ~20-30% cost increase *)
	636	(* Adding char shrinks to a mutable lazy list is less expensive: ~15% cost increase *)
	637	let char_trees_rev = ref [] in
	638	let bytes = Bytes.init size (fun _ ->
	639	let char_tree = gen st in
	640	char_trees_rev := char_tree :: !char_trees_rev ;
	641	(* Performance: return the root right now, the heavy processing of shrinks can wait until/if there is a need to shrink *)
	642	root char_tree) in
	643	let shrink = fun () ->
	644	let char_trees = List.rev !char_trees_rev in
	645	let char_list_tree = sequence_list char_trees in
	646	let bytes_tree = char_list_tree >\|= (fun char_list ->
	647	let bytes = Bytes.create size in
	648	List.iteri (Bytes.set bytes) char_list ;
	649	bytes) in
	650	(* Technically [bytes_tree] is the whole tree, but for perf reasons we eagerly created the root above *)
	651	children bytes_tree ()
	652	in
	653	Tree (bytes, shrink)
	654
	655	let string_size ?(gen = char) (size : int t) : string t =
	656	bytes_size ~gen size >\|= Bytes.unsafe_to_string
	657
	658	let string : string t = string_size nat
	659
	660	let string_of gen = string_size ~gen nat
	661
	662	let string_printable = string_size ~gen:printable nat
	663
	664	let small_string ?gen st = string_size ?gen small_nat st
	665
	666	let small_list gen = list_size small_nat gen
	667
	668	let small_array gen = array_size small_nat gen
	669
	670	let join (gen : 'a t t) : 'a t = gen >>= Fun.id
	671
	672	(* corner cases *)
	673
	674	let graft_corners (gen : 'a t) (corners : 'a list) () : 'a t =
	675	let cors = ref corners in fun st ->
	676	match !cors with [] -> gen st
	677	\| e::l -> cors := l; Tree.pure e
	678
	679	let int_pos_corners = [0; 1; 2; max_int]
	680
	681	let int_corners = int_pos_corners @ [min_int]
	682
	683	let small_int_corners () : int t = graft_corners nat int_pos_corners ()
	684
	685	(* sized, fix *)
	686
	687	let sized_size (size : int t) (gen : 'a sized) : 'a t =
	688	size >>= gen
	689
	690	let sized (gen : 'a sized) : 'a t = sized_size nat gen
	691
	692	let fix f =
	693	let rec f' n st = f f' n st in
	694	f'
	695
	696	let generate ?(rand=RS.make_self_init()) ~(n : int) (gen : 'a t) : 'a list =
	697	list_repeat n gen rand \|> Tree.root
	698
	699	let generate1 ?(rand=RS.make_self_init()) (gen : 'a t) : 'a =
	700	gen rand \|> Tree.root
	701
	702	let generate_tree ?(rand=RS.make_self_init()) (gen : 'a t) : 'a Tree.t =
	703	gen rand
	704
	705	let delay (f : unit -> 'a t) : 'a t = fun st -> f () st
	706
	707	let add_shrink_invariant (p : 'a -> bool) (gen : 'a t) : 'a t =
	708	fun st -> gen st \|> Tree.add_shrink_invariant p
	709
	710	let (let+) = (>\|=)
	711
	712	let (and+) = pair
	713
	714	let (let*) = (>>=)
	715
	716	let (and*) = pair
	717	end
	718
	719	module Print = struct
	720	type 'a t = 'a -> string
	721
	722	let unit _ = "()"
	723
	724	let int = string_of_int
	725
	726	let bool = string_of_bool
	727
	728	let float = string_of_float
	729
	730	let string s = Printf.sprintf "%S" s
	731
	732	let char c = Printf.sprintf "%C" c
	733
	734	let option f = function
	735	\| None -> "None"
	736	\| Some x -> "Some (" ^ f x ^ ")"
	737
	738	let pair a b (x,y) = Printf.sprintf "(%s, %s)" (a x) (b y)
	739
	740	let triple a b c (x,y,z) = Printf.sprintf "(%s, %s, %s)" (a x) (b y) (c z)
	741
	742	let quad a b c d (x,y,z,w) =
	743	Printf.sprintf "(%s, %s, %s, %s)" (a x) (b y) (c z) (d w)
	744
	745	let list pp l =
	746	let b = Buffer.create 25 in
	747	Buffer.add_char b '[';
	748	List.iteri (fun i x ->
	749	if i > 0 then Buffer.add_string b "; ";
	750	Buffer.add_string b (pp x))
	751	l;
	752	Buffer.add_char b ']';
	753	Buffer.contents b
	754
	755	let array pp a =
	756	let b = Buffer.create 25 in
	757	Buffer.add_string b "[\|";
	758	Array.iteri (fun i x ->
	759	if i > 0 then Buffer.add_string b "; ";
	760	Buffer.add_string b (pp x))
	761	a;
	762	Buffer.add_string b "\|]";
	763	Buffer.contents b
	764
	765	let contramap f p x = p (f x)
	766
	767	let comap = contramap
	768	end
	769
	770	(** {2 Observe Values} *)
	771
	772	module Observable = struct
	773	(** An observable is a (random) predicate on ['a] *)
	774	type -'a t = {
	775	print: 'a Print.t;
	776	eq: ('a -> 'a -> bool);
	777	hash: ('a -> int);
	778	}
	779
	780	let hash o x = o.hash x
	781
	782	let equal o x y = o.eq x y
	783
	784	let print o x = o.print x
	785
	786	let make ?(eq=(=)) ?(hash=Hashtbl.hash) print =
	787	{print; eq; hash; }
	788
	789	module H = struct
	790	let combine a b = Hashtbl.seeded_hash a b
	791
	792	let combine_f f s x = Hashtbl.seeded_hash s (f x)
	793
	794	let int i = i land max_int
	795
	796	let bool b = if b then 1 else 2
	797
	798	let char x = Char.code x
	799
	800	let string (x:string) = Hashtbl.hash x
	801
	802	let opt f = function
	803	\| None -> 42
	804	\| Some x -> combine 43 (f x)
	805	let list f l = List.fold_left (combine_f f) 0x42 l
	806
	807	let array f l = Array.fold_left (combine_f f) 0x42 l
	808
	809	let pair f g (x,y) = combine (f x) (g y)
	810	end
	811
	812	module Eq = struct
	813	type 'a t = 'a -> 'a -> bool
	814
	815	let int : int t = (=)
	816
	817	let string : string t = (=)
	818
	819	let bool : bool t = (=)
	820
	821	let float : float t = (=)
	822
	823	let unit () () = true
	824
	825	let char : char t = (=)
	826
	827	let rec list f l1 l2 = match l1, l2 with
	828	\| [], [] -> true
	829	\| [], _ \| _, [] -> false
	830	\| x1::l1', x2::l2' -> f x1 x2 && list f l1' l2'
	831
	832	let array eq a b =
	833	let rec aux i =
	834	if i = Array.length a then true
	835	else eq a.(i) b.(i) && aux (i+1)
	836	in
	837	Array.length a = Array.length b
	838	&&
	839	aux 0
	840
	841	let option f o1 o2 = match o1, o2 with
	842	\| None, None -> true
	843	\| Some _, None
	844	\| None, Some _ -> false
	845	\| Some x, Some y -> f x y
	846
	847	let pair f g (x1,y1)(x2,y2) = f x1 x2 && g y1 y2
	848	end
	849
	850	let unit : unit t = make ~hash:(fun _ -> 1) ~eq:Eq.unit Print.unit
	851
	852	let bool : bool t = make ~hash:H.bool ~eq:Eq.bool Print.bool
	853
	854	let int : int t = make ~hash:H.int ~eq:Eq.int Print.int
	855
	856	let float : float t = make ~eq:Eq.float Print.float
	857
	858	let string = make ~hash:H.string ~eq:Eq.string Print.string
	859
	860	let char = make ~hash:H.char ~eq:Eq.char Print.char
	861
	862	let option p =
	863	make ~hash:(H.opt p.hash) ~eq:(Eq.option p.eq)
	864	(Print.option p.print)
	865
	866	let array p =
	867	make ~hash:(H.array p.hash) ~eq:(Eq.array p.eq) (Print.array p.print)
	868
	869	let list p =
	870	make ~hash:(H.list p.hash) ~eq:(Eq.list p.eq) (Print.list p.print)
	871
	872	let contramap f p =
	873	make ~hash:(fun x -> p.hash (f x)) ~eq:(fun x y -> p.eq (f x)(f y))
	874	(fun x -> p.print (f x))
	875
	876	let map = contramap
	877
	878	let pair a b =
	879	make ~hash:(H.pair a.hash b.hash) ~eq:(Eq.pair a.eq b.eq) (Print.pair a.print b.print)
	880
	881	let triple a b c =
	882	contramap (fun (x,y,z) -> x,(y,z)) (pair a (pair b c))
	883
	884	let quad a b c d =
	885	contramap (fun (x,y,z,u) -> x,(y,z,u)) (pair a (triple b c d))
	886	end
	887
	888	type 'a stat = string * ('a -> int)
	889	(** A statistic on a distribution of values of type ['a] *)
	890
	891	(** Internal module taking care of storing generated function bindings.
	892
	893	In essence, a generated function of type ['a -> 'b] is a map (table) where
	894	keys are input values of type ['a] and values are output values of
	895	type ['b], plus a default value of type ['b].
	896
	897	This module provides the "map of input/output" part.
	898	*)
	899	module Poly_tbl : sig
	900	type ('key, 'value) t
	901
	902	val create: 'key Observable.t -> ?v_print:'value Print.t -> 'value Gen.t -> int -> ('key, 'value) t Gen.t
	903
	904	val get : ('key, 'value) t -> 'key -> 'value option
	905
	906	val size : ('value -> int) -> ('key, 'value) t -> int
	907
	908	val print : ('key, 'value) t Print.t
	909	end = struct
	910	type ('key, 'value) t = {
	911	get : 'key -> 'value option; (** Don't be fooled by its name and signature: this function mutates the table during test execution by adding entries (key is the value on which the function is applied in the test, and the value is generated on the fly). *)
	912	p_size: ('value -> int) -> int;
	913	p_print: unit -> string;
	914	p_tree_bindings_rev : ('key * 'value Tree.t) list ref;
	915	}
	916
	917	let create (type k) (type v) (k_obs : k Observable.t) ?(v_print: v Print.t option) (v_gen : v Gen.t) (size : int) : (k, v) t Gen.t =
	918	fun st ->
	919	let module T = Hashtbl.Make(struct
	920	type t = k
	921	let equal = k_obs.Observable.eq
	922	let hash = k_obs.Observable.hash
	923	end) in
	924	(* make a table
	925	@param extend if [true], extend table [tbl] on the fly (during test execution, to "record" input values and generate an associated output value). [false] during shrinking (use the default value if the input value is not in the table). *)
	926	let make ~extend tbl =
	927	let initial_tree_bindings_rev = T.to_seq tbl \|> List.of_seq \|> List.rev_map (fun (k, v) -> k, Tree.pure v) in
	928	let p_tree_bindings_rev = ref initial_tree_bindings_rev in
	929	let get = (fun key ->
	930	try Some (T.find tbl key)
	931	with Not_found ->
	932	if extend then (
	933	(* Generate a new value and "record" the binding for potential future display/shrinking *)
	934	let value_tree = v_gen st in
	935	p_tree_bindings_rev := (key, value_tree) :: !p_tree_bindings_rev;
	936	let v = Tree.root value_tree in
	937	T.add tbl key v;
	938	Some v
	939	) else None)
	940	in
	941	let p_print = (fun () ->
	942	let pp_v = Option.value ~default:(fun _ -> "<opaque>") v_print in
	943	let b = Buffer.create 64 in
	944	let to_b = Format.formatter_of_buffer b in
	945	T.iter
	946	(fun key value ->
	947	Format.fprintf to_b "%s -> %s; "
	948	(k_obs.Observable.print key) (pp_v value))
	949	tbl;
	950	Format.pp_print_flush to_b ();
	951	Buffer.contents b)
	952	in
	953	let p_size=(fun size_v -> T.fold (fun _ v n -> n + size_v v) tbl 0) in
	954	{get; p_print; p_size; p_tree_bindings_rev}
	955	in
	956	let root_tbl = T.create size in
	957	(* During initial running of the test, record bindings, hence [~extend:true]. *)
	958	let root = make ~extend:true root_tbl in
	959	(* Build the (lazy!) shrink tree of tables here *)
	960	let shrinks : (k, v) t Tree.t Seq.t = fun () ->
	961	(* This only gets evaluated after the test was run for [tbl], meaning it is correctly
	962	populated with bindings recorded during the test already *)
	963	let current_bindings : (k * v Tree.t) list = List.rev !(root.p_tree_bindings_rev) in
	964	let take_at_most_tree : int Tree.t = Tree.make_primitive (Shrink.int_towards 0) (List.length current_bindings) in
	965	let current_tree_bindings : (k * v) Tree.t list = List.map (fun (k, tree) -> Tree.map (fun v -> (k, v)) tree) current_bindings in
	966	let shrunk_bindings_tree : (k * v) list Tree.t = Tree.bind take_at_most_tree (fun take_at_most -> Tree.applicative_take take_at_most current_tree_bindings) in
	967	(* During shrinking, we don't want to record/add bindings, so [~extend:false]. *)
	968	let shrunk_poly_tbl_tree : (k, v) t Tree.t = Tree.map (fun bindings -> List.to_seq bindings \|> T.of_seq \|> make ~extend:false) shrunk_bindings_tree in
	969	(* [shrunk_poly_tbl_tree] is a bit misleading: its root should be the same as [root] but because of the required laziness
	970	induced by the mutation of bindings, we don't use it, only graft its children to the original [root]. *)
	971	Tree.children shrunk_poly_tbl_tree ()
	972	in
	973	Tree.Tree (root, shrinks)
	974
	975	let get t x = t.get x
	976	let print t = t.p_print ()
	977	let size p t = t.p_size p
	978	end
	979
	980	(** Internal representation of functions, used for shrinking and printing (in case of error). *)
	981	type ('a, 'b) fun_repr_tbl = {
	982	fun_tbl: ('a, 'b) Poly_tbl.t; (** Input-output bindings *)
	983	fun_gen: 'b Gen.t; (** How to generate output values *)
	984	fun_print: 'b Print.t option; (** How to print output values *)
	985	fun_default: 'b; (** Default value for all inputs not explicitly mapped in {!fun_tbl} *)
	986	}
	987
	988	type 'f fun_repr =
	989	\| Fun_tbl : ('a, 'ret) fun_repr_tbl -> ('a -> 'ret) fun_repr (** Input-output list of bindings *)
	990	\| Fun_map : ('f1 -> 'f2) * 'f1 fun_repr -> 'f2 fun_repr (** Mapped from another function (typically used for currying) *)
	991
	992	(** A QCheck function, as in Koen Claessen's paper "Shrinking and showing functions".
	993	Such a function is a pair of the function representation (used for shrinking and
	994	printing the function) and a "real" function, which can be seen as an input-output
	995	map + a default value for all other inputs.
	996
	997	- Test developers will only use the "real" function inside their tests (and ignore the function representation).
	998	- During shrinking/printing, QCheck will ignore the "real" function and only use its representation.
	999	*)
	1000	type 'f fun_ = Fun of 'f fun_repr * 'f
	1001
	1002	(** Reifying functions *)
	1003	module Fn = struct
	1004	let apply (Fun (_repr, real_function)) = real_function
	1005
	1006	(** [function_of_repr repr] creates the "real" function (that will be used in tests)
	1007	from its representation. *)
	1008	let rec function_of_repr : type f. f fun_repr -> f = function
	1009	\| Fun_tbl {fun_tbl; fun_default; _} ->
	1010	(fun x -> match Poly_tbl.get fun_tbl x with
	1011	\| None -> fun_default
	1012	\| Some y -> y)
	1013	\| Fun_map (g, sub_repr) -> g (function_of_repr sub_repr)
	1014
	1015	let make_ (r : 'a fun_repr) : 'a fun_ = Fun (r, function_of_repr r)
	1016
	1017	let mk_repr tbl gen ?print def =
	1018	Fun_tbl { fun_tbl=tbl; fun_gen=gen; fun_print=print; fun_default=def; }
	1019
	1020	let map_repr f repr = Fun_map (f, repr)
	1021
	1022	let map_fun f (Fun (repr, _real_function)) = make_ (map_repr f repr)
	1023
	1024	(** [print_rep repr] returns a string representation of [repr]. *)
	1025	let print_repr r =
	1026	let buf = Buffer.create 32 in
	1027	let rec aux
	1028	: type f. Buffer.t -> f fun_repr -> unit
	1029	= fun buf r -> match r with
	1030	\| Fun_map (_, sub_repr) -> aux buf sub_repr
	1031	\| Fun_tbl r ->
	1032	Buffer.add_string buf (Poly_tbl.print r.fun_tbl);
	1033	Printf.bprintf buf "_ -> %s" (match r.fun_print with
	1034	\| None -> "<opaque>"
	1035	\| Some print -> print r.fun_default);
	1036	in
	1037	Printf.bprintf buf "{";
	1038	aux buf r;
	1039	Printf.bprintf buf "}";
	1040	Buffer.contents buf
	1041
	1042	let print (Fun (repr, _real_function)) = print_repr repr
	1043
	1044	(** [gen_rep obs gen] creates a function generator. Input values are observed with [obs] and
	1045	output values are generated with [gen]. *)
	1046	let gen_rep (obs : 'a Observable.t) ?(print : 'b Print.t option) (gen : 'b Gen.t) : ('a -> 'b) fun_repr Gen.t =
	1047	Gen.liftA2 (fun default_value poly_tbl -> mk_repr poly_tbl gen ?print default_value) gen (Poly_tbl.create ?v_print:print obs gen 8)
	1048
	1049	let gen (obs : 'a Observable.t) ?(print : 'b Print.t option) (gen : 'b Gen.t) : ('a -> 'b) fun_ Gen.t =
	1050	Gen.map make_ (gen_rep obs gen ?print)
	1051	end
	1052
	1053	let fun1 obs ?print gen = Fn.gen obs ?print gen
	1054
	1055	module Tuple = struct
	1056	(** heterogeneous list (generic tuple) used to uncurry functions *)
	1057	type 'a t =
	1058	\| Nil : unit t
	1059	\| Cons : 'a * 'b t -> ('a * 'b) t
	1060
	1061	let nil = Nil
	1062
	1063	let cons x tail = Cons (x,tail)
	1064
	1065	type 'a obs =
	1066	\| O_nil : unit obs
	1067	\| O_cons : 'a Observable.t * 'b obs -> ('a * 'b) obs
	1068
	1069	let o_nil = O_nil
	1070
	1071	let o_cons x tail = O_cons (x,tail)
	1072
	1073	let rec hash
	1074	: type a. a obs -> a t -> int
	1075	= fun o t -> match o, t with
	1076	\| O_nil, Nil -> 42
	1077	\| O_cons (o,tail_o), Cons (x, tail) ->
	1078	Observable.H.combine (Observable.hash o x) (hash tail_o tail)
	1079
	1080	let rec equal
	1081	: type a. a obs -> a t -> a t -> bool
	1082	= fun o a b -> match o, a, b with
	1083	\| O_nil, Nil, Nil -> true
	1084	\| O_cons (o, tail_o), Cons (x1, tail1), Cons (x2,tail2) ->
	1085	Observable.equal o x1 x2 &&
	1086	equal tail_o tail1 tail2
	1087
	1088	let print o tup =
	1089	let rec aux
	1090	: type a. a obs -> Buffer.t -> a t -> unit
	1091	= fun o buf t -> match o, t with
	1092	\| O_nil, Nil -> Printf.bprintf buf "()"
	1093	\| O_cons (o, O_nil), Cons (x,Nil) ->
	1094	Printf.bprintf buf "%s" (Observable.print o x)
	1095	\| O_cons (o, tail_o), Cons (x,tail) ->
	1096	Printf.bprintf buf "%s, %a"
	1097	(Observable.print o x) (aux tail_o) tail
	1098	in
	1099	let buf = Buffer.create 64 in
	1100	Buffer.add_string buf "(";
	1101	aux o buf tup;
	1102	Buffer.add_string buf ")";
	1103	Buffer.contents buf
	1104
	1105	let observable (o:'a obs) : 'a t Observable.t =
	1106	Observable.make
	1107	~eq:(equal o)
	1108	~hash:(hash o)
	1109	(print o)
	1110
	1111	let gen (o:'a obs) ?(print:'b Print.t option) (ret:'b Gen.t) : ('a t -> 'b) fun_ Gen.t =
	1112	Fn.gen (observable o) ?print ret
	1113
	1114	module Infix = struct
	1115	let (@::) x tail = cons x tail
	1116	let (@->) o tail = o_cons o tail
	1117	end
	1118	include Infix
	1119	end
	1120
	1121	let fun_nary (o:_ Tuple.obs) ?print ret : _ Gen.t = Tuple.gen o ?print ret
	1122
	1123	let fun2 o1 o2 ?print ret =
	1124	Gen.map
	1125	(Fn.map_fun (fun g x y -> g Tuple.(x @:: y @:: nil)))
	1126	(fun_nary Tuple.(o1 @-> o2 @-> o_nil) ?print ret)
	1127
	1128	let fun3 o1 o2 o3 ?print ret =
	1129	Gen.map
	1130	(Fn.map_fun (fun g x y z -> g Tuple.(x @:: y @:: z @:: nil)))
	1131	(fun_nary Tuple.(o1 @-> o2 @-> o3 @-> o_nil) ?print ret)
	1132
	1133	let fun4 o1 o2 o3 o4 ?print ret =
	1134	Gen.map
	1135	(Fn.map_fun (fun g x y z w -> g Tuple.(x @:: y @:: z @:: w @:: nil)))
	1136	(fun_nary Tuple.(o1 @-> o2 @-> o3 @-> o4 @-> o_nil) ?print ret)
	1137
	1138	module TestResult = struct
	1139	type 'a counter_ex = {
	1140	instance: 'a; (** The counter-example(s) *)
	1141	shrink_steps: int; (** How many shrinking steps for this counterex *)
	1142	msg_l: string list; (** messages. @since 0.7 *)
	1143	}
	1144
	1145	(** Result state.
	1146	changed in 0.10 (move to inline records) *)
	1147	type 'a state =
	1148	\| Success
	1149	\| Failed of {
	1150	instances: 'a counter_ex list; (** Failed instance(s) *)
	1151	}
	1152	\| Failed_other of {msg: string}
	1153	\| Error of {
	1154	instance: 'a counter_ex;
	1155	exn: exn;
	1156	backtrace: string;
	1157	} (** Error, backtrace, and instance that triggered it *)
	1158
	1159
	1160	(* result returned by running a test *)
	1161	type 'a t = {
	1162	mutable state : 'a state;
	1163	mutable count: int; (* number of tests *)
	1164	mutable count_gen: int; (* number of generated cases *)
	1165	collect_tbl: (string, int) Hashtbl.t lazy_t;
	1166	stats_tbl: ('a stat * (int, int) Hashtbl.t) list;
	1167	mutable warnings: string list;
	1168	mutable instances: 'a list;
	1169	(** List of instances used for this test, in no particular order.
	1170	@since 0.9 *)
	1171	}
	1172
	1173	let get_state {state; _} = state
	1174
	1175	let get_count {count; _} = count
	1176
	1177	let get_count_gen {count_gen; _} = count_gen
	1178
	1179	(* indicate failure on the given [instance] *)
	1180	let fail ~msg_l ~steps:shrink_steps res instance =
	1181	let c_ex = {instance; shrink_steps; msg_l; } in
	1182	match res.state with
	1183	\| Success -> res.state <- Failed {instances=[ c_ex ]}
	1184	\| Error _
	1185	\| Failed_other _ -> ()
	1186	\| Failed {instances=[]} -> assert false
	1187	\| Failed {instances=l} -> res.state <- Failed {instances=c_ex :: l}
	1188
	1189	let error ~msg_l ~steps res instance exn backtrace =
	1190	res.state <- Error {instance={instance; shrink_steps=steps; msg_l; }; exn; backtrace}
	1191
	1192	let get_collect r =
	1193	if Lazy.is_val r.collect_tbl then Some (Lazy.force r.collect_tbl) else None
	1194
	1195	let collect = get_collect
	1196
	1197	let get_stats r = r.stats_tbl
	1198
	1199	let stats = get_stats
	1200
	1201	let get_warnings r = r.warnings
	1202
	1203	let warnings = get_warnings
	1204
	1205	let get_instances r = r.instances
	1206
	1207	let is_success r = match r.state with
	1208	\| Success -> true
	1209	\| Failed _ \| Error _ \| Failed_other _ -> false
	1210	end
	1211
	1212	module Test_exceptions = struct
	1213
	1214	exception Test_fail of string * string list
	1215	exception Test_error of string * string * exn * string
	1216	end
	1217
	1218	module Test = struct
	1219
	1220	type 'a cell = {
	1221	count : int; (* number of tests to do *)
	1222	long_factor : int; (* multiplicative factor for long test count *)
	1223	max_gen : int; (* max number of instances to generate (>= count) *)
	1224	max_fail : int; (* max number of failures *)
	1225	law : 'a -> bool; (* the law to check *)
	1226	gen : 'a Gen.t; (* how to generate/shrink instances *)
	1227	print : 'a Print.t option; (* how to print values *)
	1228	collect : ('a -> string) option; (* collect values by tag, useful to display distribution of generated *)
	1229	stats : 'a stat list; (* distribution of values of type 'a *)
	1230	qcheck1_shrink : ('a -> ('a -> unit) -> unit) option; (* QCheck1-backward-compatible shrinking *)
	1231	if_assumptions_fail: [`Fatal \| `Warning] * float;
	1232	mutable name : string; (* name of the law *)
	1233	}
	1234
	1235	type t = \| Test : 'a cell -> t
	1236
	1237	let get_name {name; _} = name
	1238
	1239	let set_name c name = c.name <- name
	1240
	1241	let get_law {law; _} = law
	1242
	1243	let get_gen {gen; _} = gen
	1244
	1245	let get_print_opt {print; _} = print
	1246
	1247	let get_collect_opt {collect; _} = collect
	1248
	1249	let get_stats {stats; _} = stats
	1250
	1251	let get_count {count; _ } = count
	1252
	1253	let get_long_factor {long_factor; _} = long_factor
	1254
	1255	let default_count = 100
	1256
	1257	let global_count count =
	1258	let count = match (count, Sys.getenv_opt "QCHECK_COUNT") with
	1259	\| (Some x, _) -> x
	1260	\| (_, Some x) -> int_of_string x
	1261	\| (None, None) -> default_count
	1262	in
	1263	if count < 0 then invalid_arg ("count must be > 0 but value is " ^ string_of_int count) else count
	1264
	1265	let fresh_name =
	1266	let r = ref 0 in
	1267	(fun () -> incr r; Printf.sprintf "anon_test_%d" !r)
	1268
	1269	let default_if_assumptions_fail = `Warning, 0.05
	1270
	1271	let make_cell ?(if_assumptions_fail=default_if_assumptions_fail)
	1272	?(count) ?(long_factor=1) ?max_gen
	1273	?(max_fail=1) ?(name=fresh_name()) ?print ?collect ?(stats=[]) gen law
	1274	=
	1275	let count = global_count count in
	1276	let max_gen = match max_gen with None -> count + 200 \| Some x->x in
	1277	{
	1278	law;
	1279	gen;
	1280	collect;
	1281	print;
	1282	stats;
	1283	max_gen;
	1284	max_fail;
	1285	name;
	1286	count;
	1287	long_factor;
	1288	if_assumptions_fail;
	1289	qcheck1_shrink = None;
	1290	}
	1291
	1292	let make_cell_from_QCheck1 ?(if_assumptions_fail=default_if_assumptions_fail)
	1293	?(count) ?(long_factor=1) ?max_gen
	1294	?(max_fail=1) ?(name=fresh_name()) ~gen ?shrink ?print ?collect ~stats law
	1295	=
	1296	let count = global_count count in
	1297	(* Make a "fake" QCheck2 arbitrary with no shrinking *)
	1298	let fake_gen = Gen.make_primitive ~gen ~shrink:(fun _ -> Seq.empty) in
	1299	let max_gen = match max_gen with None -> count + 200 \| Some x->x in
	1300	{
	1301	law;
	1302	gen = fake_gen;
	1303	print;
	1304	collect;
	1305	stats;
	1306	max_gen;
	1307	max_fail;
	1308	name;
	1309	count;
	1310	long_factor;
	1311	if_assumptions_fail;
	1312	qcheck1_shrink = shrink;
	1313	}
	1314
	1315	let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ?print ?collect ?stats gen law =
	1316	Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ?print ?collect ?stats gen law)
	1317
	1318	let test_get_count (Test cell) = get_count cell
	1319
	1320	(** {6 Running the test} *)
	1321
	1322	module R = TestResult
	1323
	1324	(* Result of an instance run *)
	1325	type res =
	1326	\| Success
	1327	\| Failure
	1328	\| FalseAssumption
	1329	\| Error of exn * string
	1330
	1331	(* Step function, called after each instance test *)
	1332	type 'a step = string -> 'a cell -> 'a -> res -> unit
	1333
	1334	let step_nil_ _ _ _ _ = ()
	1335
	1336	(* Events of a test *)
	1337	type 'a event =
	1338	\| Generating
	1339	\| Collecting of 'a
	1340	\| Testing of 'a
	1341	\| Shrunk of int * 'a
	1342	\| Shrinking of int * int * 'a
	1343
	1344	type 'a handler = string -> 'a cell -> 'a event -> unit
	1345
	1346	let handler_nil_ _ _ _ = ()
	1347
	1348	(* state required by {!check} to execute *)
	1349	type 'a state = {
	1350	test: 'a cell;
	1351	step: 'a step;
	1352	handler : 'a handler;
	1353	rand: RS.t;
	1354	mutable res: 'a TestResult.t;
	1355	mutable cur_count: int; (** number of iterations remaining to do *)
	1356	mutable cur_max_gen: int; (** maximum number of generations allowed *)
	1357	mutable cur_max_fail: int; (** maximum number of counter-examples allowed *)
	1358	}
	1359
	1360	let is_done state = state.cur_count <= 0 \|\| state.cur_max_gen <= 0
	1361
	1362	let decr_count state =
	1363	state.res.R.count <- state.res.R.count + 1;
	1364	state.cur_count <- state.cur_count - 1
	1365
	1366	let new_input_tree state =
	1367	state.res.R.count_gen <- state.res.R.count_gen + 1;
	1368	state.cur_max_gen <- state.cur_max_gen - 1;
	1369	state.test.gen state.rand
	1370
	1371	(* statistics on inputs *)
	1372	let collect st i = match st.test.collect with
	1373	\| None -> ()
	1374	\| Some f ->
	1375	let key = f i in
	1376	let (lazy tbl) = st.res.R.collect_tbl in
	1377	let n = try Hashtbl.find tbl key with Not_found -> 0 in
	1378	Hashtbl.replace tbl key (n+1)
	1379
	1380	let update_stats st i =
	1381	List.iter
	1382	(fun ((_,f), tbl) ->
	1383	let key = f i in
	1384	let n = try Hashtbl.find tbl key with Not_found -> 0 in
	1385	Hashtbl.replace tbl key (n+1))
	1386	st.res.R.stats_tbl
	1387
	1388	type res_or_exn =
	1389	\| Shrink_fail
	1390	\| Shrink_exn of exn
	1391
	1392	(* triggered by user to fail with a message *)
	1393	exception User_fail of string
	1394
	1395	let fail_report m = raise (User_fail m)
	1396
	1397	let fail_reportf m =
	1398	let buf = Buffer.create 64 in
	1399	Format.kfprintf
	1400	(fun out -> Format.fprintf out "@?"; fail_report (Buffer.contents buf))
	1401	(Format.formatter_of_buffer buf) m
	1402
	1403	type 'a run_res =
	1404	\| Run_ok
	1405	\| Run_fail of string list
	1406
	1407	let run_law law x =
	1408	try
	1409	if law x then Run_ok else Run_fail []
	1410	with User_fail msg -> Run_fail [msg]
	1411
	1412	(* QCheck1-compatibility code *)
	1413	exception Iter_exit
	1414	let iter_find_map p iter =
	1415	let r = ref None in
	1416	(try iter (fun x -> match p x with Some _ as y -> r := y; raise Iter_exit \| None -> ())
	1417	with Iter_exit -> ()
	1418	);
	1419	!r
	1420
	1421	(* try to shrink counter-ex [i] into a smaller one. Returns
	1422	shrinked value and number of steps *)
	1423	let shrink st (i_tree : 'a Tree.t) (r : res_or_exn) m : 'a * res_or_exn * string list * int =
	1424	let is_err = match r with
	1425	\| Shrink_exn _ -> true \| _ -> false
	1426	in
	1427	let rec shrink_ st i_tree r m ~steps =
	1428	let Tree.Tree (i, shrinks) = i_tree in
	1429	st.handler st.test.name st.test (Shrunk (steps, i));
	1430	let count = ref 0 in
	1431	let i' = match st.test.qcheck1_shrink with
	1432	\| Some f -> (* QCheck1-compatibility, copied almost verbatim from QCheck.ml old code *)
	1433	iter_find_map
	1434	(fun x ->
	1435	(* let Tree.Tree (x, _) = x_tree in *)
	1436	try
	1437	incr count;
	1438	st.handler st.test.name st.test (Shrinking (steps, !count, x));
	1439	begin match run_law st.test.law x with
	1440	\| Run_fail m when not is_err -> Some (Tree.pure x, Shrink_fail, m)
	1441	\| _ -> None
	1442	end
	1443	with
	1444	\| Failed_precondition \| No_example_found _ -> None
	1445	\| e when is_err -> Some (Tree.pure x, Shrink_exn e, []) (* fail test (by error) *)
	1446	) (f i)
	1447	\| None -> (* QCheck2 (or QCheck1 with a shrinkless tree): use the shrink tree *)
	1448	Seq.filter_map
	1449	(fun x_tree ->
	1450	let Tree.Tree (x, _) = x_tree in
	1451	try
	1452	incr count;
	1453	st.handler st.test.name st.test (Shrinking (steps, !count, x));
	1454	begin match run_law st.test.law x with
	1455	\| Run_fail m when not is_err -> Some (x_tree, Shrink_fail, m)
	1456	\| _ -> None
	1457	end
	1458	with
	1459	\| Failed_precondition \| No_example_found _ -> None
	1460	\| e when is_err -> Some (x_tree, Shrink_exn e, []) (* fail test (by error) *)
	1461	) shrinks
	1462	\|> Seq.hd
	1463	in
	1464	match i' with
	1465	\| None -> i, r, m, steps
	1466	\| Some (i_tree',r',m') -> shrink_ st i_tree' r' m' ~steps:(steps + 1) (* shrink further *)
	1467	in
	1468	shrink_ ~steps:0 st i_tree r m
	1469
	1470	type 'a check_result =
	1471	\| CR_continue
	1472	\| CR_yield of 'a TestResult.t
	1473
	1474	(* test raised [e] on [input]; try to shrink then fail *)
	1475	let handle_exn state input e bt : _ check_result =
	1476	(* first, shrink
	1477	TODO: shall we shrink differently (i.e. expected only an error)? *)
	1478	let input, r, msg_l, steps = shrink state input (Shrink_exn e) [] in
	1479	(* recover exception of shrunk input *)
	1480	let e = match r with
	1481	\| Shrink_fail -> e
	1482	\| Shrink_exn e' -> e'
	1483	in
	1484	state.step state.test.name state.test input (Error (e, bt));
	1485	R.error state.res ~steps ~msg_l input e bt;
	1486	CR_yield state.res
	1487
	1488	(* test failed on [input], which means the law is wrong. Continue if
	1489	we should. *)
	1490	let handle_fail state input msg_l : _ check_result =
	1491	(* first, shrink *)
	1492	let input, _, msg_l, steps = shrink state input Shrink_fail msg_l in
	1493	(* fail *)
	1494	decr_count state;
	1495	state.step state.test.name state.test input Failure;
	1496	state.cur_max_fail <- state.cur_max_fail - 1;
	1497	R.fail state.res ~steps ~msg_l input;
	1498	CR_yield state.res
	1499
	1500	(* [check_state state] applies [state.test] repeatedly ([iter] times)
	1501	on output of [test.rand], and if [state.test] ever returns false,
	1502	then the input that caused the failure is returned in [Failed].
	1503	If [func input] raises [Failed_precondition] then the input is discarded, unless
	1504	max_gen is 0. *)
	1505	let rec check_state state : _ R.t =
	1506	if is_done state then state.res
	1507	else (
	1508	state.handler state.test.name state.test Generating;
	1509	match new_input_tree state with
	1510	\| i_tree ->
	1511	check_state_input state i_tree
	1512	\| exception e ->
	1513	(* turn it into an error *)
	1514	let bt = Printexc.get_backtrace() in
	1515	let msg =
	1516	Printf.sprintf
	1517	"ERROR: uncaught exception in generator for test %s after %d steps:\nException: %s\nBacktrace: %s"
	1518	state.test.name state.test.count (Printexc.to_string e) bt
	1519	in
	1520	state.res.R.state <- R.Failed_other {msg};
	1521	state.res
	1522	)
	1523	and check_state_input state input_tree =
	1524	let Tree.Tree (input, _) = input_tree in
	1525	state.handler state.test.name state.test (Collecting input);
	1526	state.res.R.instances <- input :: state.res.R.instances;
	1527	collect state input;
	1528	update_stats state input;
	1529	let res =
	1530	try
	1531	state.handler state.test.name state.test (Testing input);
	1532	begin match run_law state.test.law input with
	1533	\| Run_ok ->
	1534	(* one test ok *)
	1535	decr_count state;
	1536	state.step state.test.name state.test input Success;
	1537	CR_continue
	1538	\| Run_fail msg_l ->
	1539	handle_fail state input_tree msg_l
	1540	end
	1541	with
	1542	\| Failed_precondition \| No_example_found _ ->
	1543	state.step state.test.name state.test input FalseAssumption;
	1544	CR_continue
	1545	\| e ->
	1546	let bt = Printexc.get_backtrace () in
	1547	handle_exn state input_tree e bt
	1548	in
	1549	match res with
	1550	\| CR_continue -> check_state state
	1551	\| CR_yield x -> x
	1552
	1553	type 'a callback = string -> 'a cell -> 'a TestResult.t -> unit
	1554
	1555	let callback_nil_ : _ callback = fun _ _ _ -> ()
	1556
	1557	(* check that there are sufficiently many tests which passed, to avoid
	1558	the case where they all passed by failed precondition *)
	1559	let check_if_assumptions target_count cell res : unit =
	1560	let percentage_of_count = float_of_int res.R.count /. float_of_int target_count in
	1561	let assm_flag, assm_frac = cell.if_assumptions_fail in
	1562	if R.is_success res && percentage_of_count < assm_frac then (
	1563	let msg =
	1564	format_of_string "%s: \
	1565	only %.1f%% tests (of %d) passed precondition for %S\n\n\
	1566	NOTE: it is likely that the precondition is too strong, or that \
	1567	the generator is buggy.\n%!"
	1568	in
	1569	match assm_flag with
	1570	\| `Warning ->
	1571	let msg = Printf.sprintf
	1572	msg "WARNING"
	1573	(percentage_of_count *. 100.) cell.count cell.name in
	1574	res.R.warnings <- msg :: res.R.warnings
	1575	\| `Fatal ->
	1576	(* turn it into an error *)
	1577	let msg = Printf.sprintf
	1578	msg "ERROR"
	1579	(percentage_of_count *. 100.) cell.count cell.name in
	1580	res.R.state <- R.Failed_other {msg}
	1581	)
	1582
	1583	(* main checking function *)
	1584	let check_cell ?(long=false) ?(call=callback_nil_)
	1585	?(step=step_nil_) ?(handler=handler_nil_)
	1586	?(rand=RS.make [\| 0 \|]) cell =
	1587	let factor = if long then cell.long_factor else 1 in
	1588	let target_count = factor*cell.count in
	1589	let state = {
	1590	test=cell; rand;
	1591	step; handler;
	1592	cur_count=target_count;
	1593	cur_max_gen=factor*cell.max_gen;
	1594	cur_max_fail=factor*cell.max_fail;
	1595	res = {R.
	1596	state=R.Success; count=0; count_gen=0;
	1597	collect_tbl=lazy (Hashtbl.create 10);
	1598	instances=[]; warnings=[];
	1599	stats_tbl= List.map (fun stat -> stat, Hashtbl.create 10) cell.stats;
	1600	};
	1601	} in
	1602	let res = check_state state in
	1603	check_if_assumptions target_count cell res;
	1604	call cell.name cell res;
	1605	res
	1606
	1607	include Test_exceptions
	1608
	1609	(* print instance using [arb] *)
	1610	let print_instance arb i = match arb.print with
	1611	\| None -> "<instance>"
	1612	\| Some pp -> pp i
	1613
	1614	let print_c_ex arb c : string =
	1615	let buf = Buffer.create 64 in
	1616	begin
	1617	if c.R.shrink_steps > 0
	1618	then Printf.bprintf buf "%s (after %d shrink steps)"
	1619	(print_instance arb c.R.instance) c.R.shrink_steps
	1620	else Buffer.add_string buf (print_instance arb c.R.instance)
	1621	end;
	1622	List.iter
	1623	(fun msg ->
	1624	Buffer.add_char buf '\n';
	1625	Buffer.add_string buf msg;
	1626	Buffer.add_char buf '\n')
	1627	c.R.msg_l;
	1628	Buffer.contents buf
	1629
	1630	let pp_print_test_fail name out l =
	1631	let rec pp_list out = function
	1632	\| [] -> ()
	1633	\| [x] -> Format.fprintf out "%s@," x
	1634	\| x :: y -> Format.fprintf out "%s@,%a" x pp_list y
	1635	in
	1636	Format.fprintf out "@[test `%s`@ failed on ≥ %d cases:@ @[<v>%a@]@]"
	1637	name (List.length l) pp_list l
	1638
	1639	let asprintf fmt =
	1640	let buf = Buffer.create 128 in
	1641	let out = Format.formatter_of_buffer buf in
	1642	Format.kfprintf (fun _ -> Buffer.contents buf) out fmt
	1643
	1644	let print_test_fail name l = asprintf "@[%a@]@?" (pp_print_test_fail name) l
	1645
	1646	let print_test_error name i e stack =
	1647	Format.sprintf "@[test `%s`@ raised exception `%s`@ on `%s`@,%s@]"
	1648	name (Printexc.to_string e) i stack
	1649
	1650	let print_collect c =
	1651	let out = Buffer.create 64 in
	1652	Hashtbl.iter
	1653	(fun case num -> Printf.bprintf out "%s: %d cases\n" case num) c;
	1654	Buffer.contents out
	1655
	1656	let stat_max_lines = 20 (* maximum number of lines for a histogram *)
	1657
	1658	let print_stat ((name,_), tbl) =
	1659	let avg = ref 0. in
	1660	let num = ref 0 in
	1661	let min_idx, max_idx =
	1662	Hashtbl.fold
	1663	(fun i res (m1,m2) ->
	1664	avg := !avg +. float_of_int (i * res);
	1665	num := !num + res;
	1666	min i m1, max i m2)
	1667	tbl (max_int,min_int)
	1668	in
	1669	(* compute average *)
	1670	if !num > 0 then (
	1671	avg := !avg /. float_of_int !num
	1672	);
	1673	(* compute std-dev: sqroot of sum of squared distance-to-average
	1674	https://en.wikipedia.org/wiki/Standard_deviation *)
	1675	let stddev =
	1676	Hashtbl.fold
	1677	(fun i res m -> m +. (float_of_int i -. !avg) ** 2. *. float_of_int res)
	1678	tbl 0.
	1679	\|> (fun s -> if !num>0 then s /. float_of_int !num else s)
	1680	\|> sqrt
	1681	in
	1682	(* compute median *)
	1683	let median = ref 0 in
	1684	let median_num = ref 0 in (* how many values have we seen yet? once >= !n/2 we set median *)
	1685	(Hashtbl.fold (fun i cnt acc -> (i,cnt)::acc) tbl [])
	1686	\|> List.sort (fun (i,_) (j,_) -> poly_compare i j)
	1687	\|> List.iter
	1688	(fun (i,cnt) ->
	1689	if !median_num < !num/2 then (
	1690	median_num := !median_num + cnt;
	1691	(* just went above median! *)
	1692	if !median_num >= !num/2 then
	1693	median := i));
	1694	(* group by buckets, if there are too many entries: *)
	1695	(* first compute histogram and bucket size *)
	1696	let min_idx64, max_idx64 = Int64.(of_int min_idx, of_int max_idx) in
	1697	let hist_size, bucket_size =
	1698	let sample_width = Int64.sub max_idx64 min_idx64 in
	1699	if sample_width > Int64.of_int stat_max_lines
	1700	then stat_max_lines,
	1701	int_of_float (ceil (Int64.to_float sample_width /. float_of_int stat_max_lines))
	1702	else max_idx-min_idx, 1
	1703	in
	1704	let hist_size =
	1705	if Int64.(add min_idx64 (mul (of_int bucket_size) (of_int hist_size))) <= max_idx64
	1706	then 1+hist_size
	1707	else hist_size in
	1708	(* accumulate bucket counts *)
	1709	let max_val = ref 0 in (* max value after grouping by buckets *)
	1710	let bucket_count = Array.init hist_size (fun _ -> 0) in
	1711	Hashtbl.iter
	1712	(fun j count ->
	1713	let bucket = Int64.(to_int (div (sub (of_int j) min_idx64) (of_int bucket_size))) in
	1714	let new_count = bucket_count.(bucket) + count in
	1715	bucket_count.(bucket) <- new_count;
	1716	max_val := max !max_val new_count) tbl;
	1717	(* print entries of the table, sorted by increasing index *)
	1718	let out = Buffer.create 128 in
	1719	Printf.bprintf out "stats %s:\n" name;
	1720	Printf.bprintf out
	1721	" num: %d, avg: %.2f, stddev: %.2f, median %d, min %d, max %d\n"
	1722	!num !avg stddev !median min_idx max_idx;
	1723	let indwidth =
	1724	let str_width i = String.length (Printf.sprintf "%d" i) in
	1725	List.map str_width [min_idx; max_idx; min_idx + bucket_size * hist_size] \|> List.fold_left max min_int in
	1726	let labwidth = if bucket_size=1 then indwidth else 2+2*indwidth in
	1727	for i = 0 to hist_size - 1 do
	1728	let i' = min_idx + i * bucket_size in
	1729	let blabel =
	1730	if bucket_size=1
	1731	then Printf.sprintf "%*d" indwidth i'
	1732	else
	1733	let bucket_bound = i'+bucket_size-1 in
	1734	Printf.sprintf "%d..%d" indwidth i' indwidth (if bucket_bound < i' then max_int else bucket_bound) in
	1735	let bcount = bucket_count.(i) in
	1736	(* NOTE: keep in sync *)
	1737	let bar_len = bcount * 55 / !max_val in
	1738	Printf.bprintf out " %*s: %-56s %10d\n" labwidth blabel (String.make bar_len '#') bcount
	1739	done;
	1740	Buffer.contents out
	1741
	1742	let () = Printexc.register_printer
	1743	(function
	1744	\| Test_fail (name,l) -> Some (print_test_fail name l)
	1745	\| Test_error (name,i,e,st) -> Some (print_test_error name i e st)
	1746	\| User_fail s -> Some ("qcheck: user fail:\n" ^ s)
	1747	\| _ -> None)
	1748
	1749	let print_fail arb name l =
	1750	print_test_fail name (List.map (print_c_ex arb) l)
	1751
	1752	let print_fail_other name ~msg =
	1753	print_test_fail name [msg]
	1754
	1755	let print_error ?(st="") arb name (i,e) =
	1756	print_test_error name (print_c_ex arb i) e st
	1757
	1758	let check_result cell res = match res.R.state with
	1759	\| R.Success -> ()
	1760	\| R.Error {instance; exn; backtrace} ->
	1761	raise (Test_error (cell.name, print_c_ex cell instance, exn, backtrace))
	1762	\| R.Failed {instances=l} ->
	1763	let l = List.map (print_c_ex cell) l in
	1764	raise (Test_fail (cell.name, l))
	1765	\| R.Failed_other {msg} ->
	1766	raise (Test_fail (cell.name, [msg]))
	1767
	1768	let check_cell_exn ?long ?call ?step ?rand cell =
	1769	let res = check_cell ?long ?call ?step ?rand cell in
	1770	check_result cell res
	1771
	1772	let check_exn ?long ?rand (Test cell) = check_cell_exn ?long ?rand cell
	1773	end
	1774
	1775	let find_example ?(name : string = "<example>") ?(count : int option) ~(f : 'a -> bool) (gen : 'a Gen.t) : 'a Gen.t =
	1776	(* the random generator of examples satisfying [f]. To do that we
	1777	test the property [fun x -> not (f x)]; any counter-example *)
	1778	let gen st =
	1779	let cell =
	1780	Test.make_cell ~max_fail:1 ?count gen (fun x -> not (f x))
	1781	in
	1782	let res = Test.check_cell ~rand:st cell in
	1783	begin match res.TestResult.state with
	1784	\| TestResult.Success -> raise (No_example_found name)
	1785	\| TestResult.Error _ -> raise (No_example_found name)
	1786	\| TestResult.Failed {instances=[]} -> assert false
	1787	\| TestResult.Failed {instances=failed::_} ->
	1788	(* found counter-example! *)
	1789	Tree.pure failed.TestResult.instance
	1790	\| TestResult.Failed_other {msg=_} ->
	1791	raise (No_example_found name)
	1792
	1793	end
	1794	in
	1795	gen
	1796
	1797	let find_example_gen ?(rand : RS.t option) ?(name : string option) ?(count : int option) ~(f : 'a -> bool) (gen : 'a Gen.t) : 'a =
	1798	let g = find_example ?name ?count ~f gen in
	1799	Gen.generate1 ?rand g

+1778

-0

src/core/QCheck2.mli less more

	0	(*
	1	QCheck: Random testing for OCaml
	2	copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot,
	3	Jan Midtgaard, Julien Debon, Valentin Chaboche
	4	all rights reserved.
	5	*)
	6
	7	(* Keep the following title alone in its documentation block as it is specially treated by Odoc: it doesn't appear
	8	in the Contents menu on the left. The next documentation block with all the actual
	9	content will appear. *)
	10	(** {1 QuickCheck-inspired property-based testing} *)
	11
	12	(** {1 Introduction}
	13
	14	This library takes inspiration from Haskell's QuickCheck library. The
	15	rough idea is that the programmer describes invariants that values of
	16	a certain type need to satisfy ("properties"), as functions from this type
	17	to bool. They also need to describe how to generate random values of the type,
	18	so that the property is tried and checked on a number of random instances.
	19
	20	This explains the organization of this module:
	21
	22	- {!Gen} is used to describe how to generate random values.
	23	Auxiliary module {!Print} can be used along with {!Test.make}
	24	to build one's own generator instances.
	25
	26	- {!Test} is used to describe a single test, that is, a property of
	27	type ['a -> bool] combined with an ['a Gen.t] that is used to generate
	28	the test cases for this property. Optional parameters
	29	allow to specify the random generator state, number of instances to generate
	30	and test, etc.
	31
	32	💡 If you are migrating from QCheck, check the {{!section:migration_qcheck2} migration guide} below.
	33
	34	{1 Examples}
	35
	36	- "{!List.rev} is involutive" (the test passes so [check_exn] returns [()]):
	37
	38	{[
	39	let test =
	40	QCheck2.(Test.make ~count:1000
	41	~pp:Print.(list int)
	42	Gen.(list int)
	43	(fun l -> List.rev (List.rev l) = l));;
	44
	45	QCheck2.Test.check_exn test;;
	46	]}
	47
	48	- "All lists are sorted" (false property that will fail):
	49	{ul
	50	{- QCheck tests this property on random lists and finds a counter-example}
	51	{- QCheck then looks for the smallest counter-example possible (here [[1; 0]])
	52	to help you find the problem (called "shrinking")}
	53	}
	54
	55	{[
	56	let test = QCheck2.(
	57	Test.make
	58	~name:"All lists are sorted"
	59	~count:10_000
	60	~pp:Print.(list small_nat)
	61	Gen.(list small_nat)
	62	(fun l -> l = List.sort compare l));;
	63
	64	QCheck2.Test.check_exn test;;
	65
	66	Exception:
	67	test `All lists are sorted` failed on ≥ 1 cases:
	68	[1; 0] (after 5 shrink steps)
	69	]}
	70
	71
	72	- Generate 20 random trees using {! Gen.fix} :
	73
	74	{[
	75	type tree = Leaf of int \| Node of tree * tree
	76
	77	let leaf x = Leaf x
	78	let node x y = Node (x,y)
	79
	80	let tree_gen = QCheck2.Gen.(sized @@ fix
	81	(fun self n -> match n with
	82	\| 0 -> map leaf nat
	83	\| n ->
	84	frequency
	85	[1, map leaf nat;
	86	2, map2 node (self (n/2)) (self (n/2))]
	87	));;
	88
	89	QCheck2.Gen.generate ~n:20 tree_gen;;
	90	]}
	91
	92	@since 0.18
	93	*)
	94
	95	(** A tree represents a generated value and its successive shrunk values. *)
	96	module Tree : sig
	97	(** Conceptually a pseudo-randomly generated value is packaged with its shrunk values.
	98	This coupling - called "integrated shrinking" - in a single type has a major benefit:
	99	most generators get shrinking "for free" by composing from smaller generators, and shrinking
	100	does not break invariants (e.g. shrinks of a positive number are always positive).
	101	*)
	102
	103	type 'a t
	104	(** A tree of random generated values, where the root contains the value used for the test,
	105	and the sub-trees contain shrunk values (as trees, to be able to shrink several times a value)
	106	used if the test fails. *)
	107
	108	val root : 'a t -> 'a
	109	(** [root tree] returns the root value of the tree of generated values [t]. *)
	110
	111	val children : 'a t -> 'a t Seq.t
	112	(** [children tree] returns the direct sub-trees of the tree of generated values [t]. *)
	113
	114	val pp : ?depth : int -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
	115	(** [pp ?depth pp_a ppf tree] pretty-prints the tree of generated values [tree] using the
	116	pretty-print formatter [ppf]. Values of type ['a] will be printed using the given
	117	pretty-printer [pp_a].
	118
	119	As a tree [t] can be potentially huge when fully evaluated, you can control the maximum
	120	depth the printer goes with [depth].
	121	- [None] means "everything"
	122	- [0] means "only the root"
	123	- [1] means "the root and its direct shrinks"
	124	- [2] means "the root, its direct shrinks, and the shrinks of its shrinks"
	125	- etc.
	126	*)
	127	end
	128
	129	(** A generator is responsible for generating pseudo-random values and provide shrinks (smaller
	130	values) when a test fails. *)
	131	module Gen : sig
	132	(** This module provides some of the most important features of QCheck:
	133	- {{!section:primitive_generators} primitive generators}
	134	- {{!section:composing_generators} generator compositions}
	135	*)
	136
	137	type 'a t
	138	(** A random generator for values of type ['a]. *)
	139
	140	type 'a sized = int -> 'a t
	141	(** Random generator with a size bound. *)
	142
	143	(** {3:primitive_generators Primitive generators} *)
	144
	145	val unit : unit t
	146	(** The unit generator.
	147
	148	Does not shrink.
	149	*)
	150
	151	val bool : bool t
	152	(** The boolean generator.
	153
	154	Shrinks towards [false].
	155	*)
	156
	157	val int : int t
	158	(** Generates integers uniformly.
	159
	160	Shrinks towards [0].
	161	*)
	162
	163	val pint : ?origin : int -> int t
	164	(** Generates non-strictly positive integers uniformly ([0] included).
	165
	166	Shrinks towards [origin] if specified, otherwise towards [0]. *)
	167
	168	val small_nat : int t
	169	(** Small positive integers (< [100], [0] included).
	170
	171	Non-uniform: smaller numbers are more likely than bigger numbers.
	172
	173	Shrinks towards [0].
	174
	175	@since 0.5.1 *)
	176
	177	val nat : int t
	178	(** Generates natural numbers (< [10_000]).
	179
	180	Non-uniform: smaller numbers are more likely than bigger numbers.
	181
	182	Shrinks towards [0].
	183	*)
	184
	185	val big_nat : int t
	186	(** Generates natural numbers, possibly large (< [1_000_000]).
	187
	188	Non-uniform: smaller numbers are more likely than bigger numbers.
	189
	190	Shrinks towards [0].
	191
	192	@since 0.10 *)
	193
	194	val neg_int : int t
	195	(** Generates non-strictly negative integers ([0] included).
	196
	197	Non-uniform: smaller numbers (in absolute value) are more likely than bigger numbers.
	198
	199	Shrinks towards [0].
	200	*)
	201
	202	val small_int : int t
	203	(** Small UNSIGNED integers, for retrocompatibility.
	204
	205	Shrinks towards [0].
	206
	207	@deprecated use {!small_nat}. *)
	208
	209	val small_signed_int : int t
	210	(** Small SIGNED integers, based on {!small_nat}.
	211
	212	Non-uniform: smaller numbers (in absolute value) are more likely than bigger numbers.
	213
	214	Shrinks towards [0].
	215
	216	@since 0.5.2 *)
	217
	218	val small_int_corners : unit -> int t
	219	(** As {!small_int}, but each newly created generator starts with
	220	a list of corner cases before falling back on random generation. *)
	221
	222
	223	val int32 : int32 t
	224	(** Generates uniform {!int32} values.
	225
	226	Shrinks towards [0l].
	227	*)
	228
	229	val ui32 : int32 t
	230	(** Generates {!int32} values.
	231
	232	Shrinks towards [0l].
	233
	234	@deprecated use {!val:int32} instead, the name is wrong, values {i are} signed.
	235	*)
	236
	237	val int64 : int64 t
	238	(** Generates uniform {!int64} values.
	239
	240	Shrinks towards [0L].
	241	*)
	242
	243	val ui64 : int64 t
	244	(** Generates {!int64} values.
	245
	246	Shrinks towards [0L].
	247
	248	@deprecated use {!val:int64} instead, the name is wrong, values {i are} signed.
	249	*)
	250
	251	val float : float t
	252	(** Generates floating point numbers.
	253
	254	Shrinks towards [0.].
	255	*)
	256
	257	val pfloat : float t
	258	(** Generates positive floating point numbers ([0.] included).
	259
	260	Shrinks towards [0.].
	261	*)
	262
	263	val nfloat : float t
	264	(** Generates negative floating point numbers. ([-0.] included).
	265
	266	Shrinks towards [-0.].
	267	*)
	268
	269	val char : char t
	270	(** Generates characters in the [0..255] range.
	271
	272	Shrinks towards ['a'].
	273	*)
	274
	275	val printable : char t
	276	(** Generates printable characters.
	277
	278	The exhaustive list of character codes is:
	279	- [32] to [126], inclusive
	280	- ['\n']
	281
	282	Shrinks towards ['a'].
	283	*)
	284
	285	val numeral : char t
	286	(** Generates numeral characters ['0'..'9'].
	287
	288	Shrinks towards ['0'].
	289	*)
	290
	291	val string_size : ?gen:char t -> int t -> string t
	292	(** Builds a string generator from a (non-negative) size generator.
	293	Accepts an optional character generator (the default is {!char}).
	294
	295	Shrinks on the number of characters first, then on the characters.
	296	*)
	297
	298	val string : string t
	299	(** Builds a string generator. String size is generated by {!nat}.
	300	The default character generator is {!char}.
	301	See also {!string_of} and {!string_printable} for versions with
	302	custom char generator.
	303
	304	Shrinks on the number of characters first, then on the characters.
	305	*)
	306
	307	val string_of : char t -> string t
	308	(** Builds a string generator using the given character generator.
	309
	310	Shrinks on the number of characters first, then on the characters.
	311
	312	@since 0.11 *)
	313
	314	val string_printable : string t
	315	(** Builds a string generator using the {!printable} character generator.
	316
	317	Shrinks on the number of characters first, then on the characters.
	318
	319	@since 0.11 *)
	320
	321	val small_string : ?gen:char t -> string t
	322	(** Builds a string generator, length is {!small_nat}.
	323	Accepts an optional character generator (the default is {!char}).
	324
	325	Shrinks on the number of characters first, then on the characters.
	326	*)
	327
	328	val pure : 'a -> 'a t
	329	(** [pure a] creates a generator that always returns [a].
	330
	331	Does not shrink.
	332
	333	@since 0.8
	334	*)
	335
	336	val return : 'a -> 'a t
	337	(** Synonym for {!pure} *)
	338
	339	val make_primitive : gen : (Random.State.t -> 'a) -> shrink : ('a -> 'a Seq.t) -> 'a t
	340	(** [make_primitive ~gen ~shrink] creates a generator from a function [gen] that creates
	341	a random value (this function must only use the given {!Random.State.t} for randomness)
	342	and a function [shrink] that, given a value [a], returns a lazy list of
	343	"smaller" values (used when a test fails).
	344
	345	This lower-level function is meant to build generators for "primitive" types that can neither be
	346	built with other primitive generators nor through composition, or to have more control on the
	347	shrinking steps.
	348
	349	[shrink] must obey the following rules (for your own definition of "small"):
	350	- [shrink a = Seq.empty] when [a] is the smallest possible value
	351	- [shrink a] must return values strictly smaller than [a], ideally from smallest to largest (for
	352	faster shrinking)
	353	- [let rec loop a = match shrink a () with \| Nil -> () \| Cons (smaller_a, _) -> loop smaller_a]
	354	must end for all values [a] of type ['a] (i.e. there must not be an infinite number of shrinking
	355	steps).
	356
	357	⚠️ This is an unstable API as it partially exposes the implementation. In particular, the type of
	358	[Random.State.t] may very well change in a future version, e.g. if QCheck switches to another
	359	randomness library.
	360	*)
	361
	362	val add_shrink_invariant : ('a -> bool) -> 'a t -> 'a t
	363	(** [add_shrink_invariant f gen] returns a generator similar to [gen] except all shrinks satisfy [f].
	364	This way it's easy to preserve invariants that are enforced by
	365	generators, when shrinking values
	366
	367	@since 0.8
	368
	369	@deprecated is this function still useful? I feel like it is either useless (invariants
	370	should already be part of the shrinking logic, not be added later) or a special,
	371	incomplete case of {!Gen.t} being an Alternative (not implemented yet). For now we
	372	keep it and wait for users feedback (hence deprecation to raise attention).
	373	*)
	374
	375	(** {3 Ranges} *)
	376
	377	val int_bound : int -> int t
	378	(** Uniform integer generator producing integers within [0..bound].
	379
	380	Shrinks towards [0].
	381
	382	@raise Invalid_argument if the argument is negative. *)
	383
	384	val int_range : ?origin:int -> int -> int -> int t
	385	(** [int_range ?origin low high] is an uniform integer generator producing integers within [low..high] (inclusive).
	386
	387	Shrinks towards [origin] if specified, otherwise towards [0] (but always stays within the range).
	388
	389	Examples:
	390	- [int_range ~origin:6 (-5) 15] will shrink towards [6]
	391	- [int_range (-5) 15] will shrink towards [0]
	392	- [int_range 8 20] will shrink towards [8] (closest to [0] within range)
	393	- [int_range (-20) (-8)] will shrink towards [-8] (closest to [0] within range)
	394
	395	@raise Invalid_argument if any of the following holds:
	396	- [low > high]
	397	- [origin < low]
	398	- [origin > high]
	399	*)
	400
	401	val (--) : int -> int -> int t
	402	(** [a -- b] is an alias for [int_range a b]. See {!int_range} for more information.
	403	*)
	404
	405	val float_bound_inclusive : ?origin : float -> float -> float t
	406	(** [float_bound_inclusive ?origin bound] returns a random floating-point number between [0.] and
	407	[bound] (inclusive). If [bound] is negative, the result is negative or zero. If
	408	[bound] is [0.], the result is [0.].
	409
	410	Shrinks towards [origin] if given, otherwise towards [0.].
	411
	412	@since 0.11 *)
	413
	414	val float_bound_exclusive : ?origin : float -> float -> float t
	415	(** [float_bound_exclusive origin bound] returns a random floating-point number between [0.] and
	416	[bound] (exclusive). If [bound] is negative, the result is negative or zero.
	417
	418	Shrinks towards [origin] if given, otherwise towards [0.].
	419
	420	@raise Invalid_argument if [bound] is [0.].
	421
	422	@since 0.11 *)
	423
	424	val float_range : ?origin : float -> float -> float -> float t
	425	(** [float_range ?origin low high] generates floating-point numbers within [low] and [high] (inclusive).
	426
	427	Shrinks towards [origin] if specified, otherwise towards [0.] (but always stays within the range).
	428
	429	Examples:
	430	- [float_range ~origin:6.2 (-5.8) 15.1] will shrink towards [6.2]
	431	- [float_range (-5.8) 15.1] will shrink towards [0.]
	432	- [float_range 8.5 20.1] will shrink towards [8.5] (closest to [0.] within range)
	433	- [float_range (-20.1) (-8.5)] will shrink towards [-8.5] (closest to [0.] within range)
	434
	435	@raise Invalid_argument if any of the following holds:
	436	- [low > high]
	437	- [high -. low > max_float]
	438	- [origin < low]
	439	- [origin > high]
	440
	441	@since 0.11 *)
	442
	443	val (--.) : float -> float -> float t
	444	(** [a --. b] is an alias for [float_range ~origin:a a b]. See {!float_range} for more information.
	445
	446	@since 0.11 *)
	447
	448	val char_range : ?origin:char -> char -> char -> char t
	449	(** [char_range ?origin low high] generates chars between [low] and [high], inclusive.
	450	Example: [char_range 'a' 'z'] for all lower case ASCII letters.
	451
	452	Shrinks towards [origin] if specified, otherwise towards [low].
	453
	454	@raise Invalid_argument if [low > high].
	455
	456	@since 0.13 *)
	457
	458	(** {3 Choosing elements} *)
	459
	460	val oneof : 'a t list -> 'a t
	461	(** [oneof l] constructs a generator that selects among the given list of generators [l].
	462
	463	Shrinks towards the first generator of the list.
	464	@raise Invalid_argument or Failure if [l] is empty
	465	*)
	466
	467	val oneofl : 'a list -> 'a t
	468	(** [oneofl l] constructs a generator that selects among the given list of values [l].
	469
	470	Shrinks towards the first element of the list.
	471	@raise Invalid_argument or Failure if [l] is empty
	472	*)
	473
	474	val oneofa : 'a array -> 'a t
	475	(** [oneofa a] constructs a generator that selects among the given array of values [a].
	476
	477	Shrinks towards the first element of the array.
	478	@raise Invalid_argument or Failure if [l] is empty
	479	*)
	480
	481	val frequency : (int * 'a t) list -> 'a t
	482	(** Constructs a generator that selects among a given list of generators.
	483	Each of the given generators are chosen based on a positive integer weight.
	484
	485	Shrinks towards the first element of the list.
	486	*)
	487
	488	val frequencyl : (int * 'a) list -> 'a t
	489	(** Constructs a generator that selects among a given list of values.
	490	Each of the given values are chosen based on a positive integer weight.
	491
	492	Shrinks towards the first element of the list.
	493	*)
	494
	495	val frequencya : (int * 'a) array -> 'a t
	496	(** Constructs a generator that selects among a given array of values.
	497	Each of the array entries are chosen based on a positive integer weight.
	498
	499	Shrinks towards the first element of the array.
	500	*)
	501
	502	(** {3 Shuffling elements} *)
	503
	504	val shuffle_a : 'a array -> 'a array t
	505	(** Returns a copy of the array with its elements shuffled. *)
	506
	507	val shuffle_l : 'a list -> 'a list t
	508	(** Creates a generator of shuffled lists. *)
	509
	510	val shuffle_w_l : (int * 'a) list -> 'a list t
	511	(** Creates a generator of weighted shuffled lists. A given list is shuffled on each
	512	generation according to the weights of its elements. An element with a larger weight
	513	is more likely to be at the front of the list than an element with a smaller weight.
	514	If we want to pick random elements from the (head of) list but need to prioritize
	515	some elements over others, this generator can be useful.
	516
	517	Example: given a weighted list [[1, "one"; 5, "five"; 10, "ten"]], the generator is
	518	more likely to generate [["ten"; "five"; "one"]] or [["five"; "ten"; "one"]] than
	519	[["one"; "ten"; "five"]] because "ten" and "five" have larger weights than "one".
	520
	521	@since 0.11
	522	*)
	523
	524	(** {3 Corner cases} *)
	525
	526	val graft_corners : 'a t -> 'a list -> unit -> 'a t
	527	(** [graft_corners gen l ()] makes a new generator that enumerates
	528	the corner cases in [l] and then behaves like [g].
	529
	530	Does not shrink if the test fails on a grafted value.
	531	Shrinks towards [gen] otherwise.
	532
	533	@since 0.6 *)
	534
	535	val int_pos_corners : int list
	536	(** Non-negative corner cases for int.
	537
	538	@since 0.6 *)
	539
	540	val int_corners : int list
	541	(** All corner cases for int.
	542
	543	@since 0.6 *)
	544
	545	(** {3 Lists, arrays and options} *)
	546
	547	val list : 'a t -> 'a list t
	548	(** Builds a list generator from an element generator. List size is generated by {!nat}.
	549
	550	Shrinks on the number of elements first, then on elements.
	551	*)
	552
	553	val small_list : 'a t -> 'a list t
	554	(** Generates lists of small size (see {!small_nat}).
	555
	556	Shrinks on the number of elements first, then on elements.
	557
	558	@since 0.5.3 *)
	559
	560	val list_size : int t -> 'a t -> 'a list t
	561	(** Builds a list generator from a (non-negative) size generator and an element generator.
	562
	563	Shrinks on the number of elements first, then on elements.
	564	*)
	565
	566	val list_repeat : int -> 'a t -> 'a list t
	567	(** [list_repeat i g] builds a list generator from exactly [i] elements generated by [g].
	568
	569	Shrinks on elements only.
	570	*)
	571
	572	val array : 'a t -> 'a array t
	573	(** Builds an array generator from an element generator. Array size is generated by {!nat}.
	574
	575	Shrinks on the number of elements first, then on elements.
	576	*)
	577
	578	val array_size : int t -> 'a t -> 'a array t
	579	(** Builds an array generator from a (non-negative) size generator and an element generator.
	580
	581	Shrinks on the number of elements first, then on elements.
	582	*)
	583
	584	val small_array : 'a t -> 'a array t
	585	(** Generates arrays of small size (see {!small_nat}).
	586
	587	Shrinks on the number of elements first, then on elements.
	588
	589	@since 0.10 *)
	590
	591	val array_repeat : int -> 'a t -> 'a array t
	592	(** [array_repeat i g] builds an array generator from exactly [i] elements generated by [g].
	593
	594	Shrinks on elements only.
	595	*)
	596
	597	val opt : ?ratio:float -> 'a t -> 'a option t
	598	(** [opt gen] is an [option] generator that uses [gen] when generating [Some] values.
	599
	600	Shrinks towards {!None} then towards shrinks of [gen].
	601
	602	@param ratio a float between [0.] and [1.] indicating the probability of a sample to be [Some _]
	603	rather than [None] (value is [0.85]).
	604	*)
	605
	606	(** {3 Combining generators} *)
	607
	608	val pair : 'a t -> 'b t -> ('a * 'b) t
	609	(** [pair gen1 gen2] generates pairs.
	610
	611	Shrinks on [gen1] and then [gen2].
	612	*)
	613
	614	val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
	615	(** [triple gen1 gen2 gen3] generates triples.
	616
	617	Shrinks on [gen1], then [gen2] and then [gen3].
	618	*)
	619
	620	val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
	621	(** [quad gen1 gen2 gen3 gen4] generates quadruples.
	622
	623	Shrinks on [gen1], then [gen2], then [gen3] and then [gen4].
	624
	625	@since 0.5.1
	626	*)
	627
	628	(** {3 Convert a structure of generator to a generator of structure} *)
	629
	630	val flatten_l : 'a t list -> 'a list t
	631	(** Generate a list of elements from individual generators.
	632
	633	Shrinks on the elements of the list, in the list order.
	634
	635	@since 0.13 *)
	636
	637	val flatten_a : 'a t array -> 'a array t
	638	(** Generate an array of elements from individual generators.
	639
	640	Shrinks on the elements of the array, in the array order.
	641
	642	@since 0.13 *)
	643
	644	val flatten_opt : 'a t option -> 'a option t
	645	(** Generate an option from an optional generator.
	646
	647	Shrinks towards {!None} then shrinks on the value.
	648
	649	@since 0.13 *)
	650
	651	val flatten_res : ('a t, 'e) result -> ('a,'e) result t
	652	(** Generate a result from [Ok gen], an error from [Error e].
	653
	654	Shrinks on [gen] if [Ok gen].
	655	Does not shrink if [Error e].
	656
	657	@since 0.13 *)
	658
	659	val join : 'a t t -> 'a t
	660	(** Collapses a generator of generators to a generator.
	661
	662	Shrinks on the generated generators.
	663
	664	@since 0.5 *)
	665
	666	(** {3 Influencing the size of generated values} *)
	667
	668	val sized : 'a sized -> 'a t
	669	(** Creates a generator from a size-bounded generator by first
	670	generating a size using {!nat} and passing the result to the size-bounded generator.
	671
	672	Shrinks on the size first, then on the generator.
	673	*)
	674
	675	val sized_size : int t -> 'a sized -> 'a t
	676	(** Creates a generator from a size-bounded generator by first
	677	generating a size using the integer generator and passing the result
	678	to the size-bounded generator.
	679
	680	Shrinks on the size first, then on the generator.
	681
	682	@since 0.5 *)
	683
	684	(** {3 Recursive data structures} *)
	685
	686	val fix : (('a -> 'b t) -> 'a -> 'b t) -> 'a -> 'b t
	687	(** Parametrized fixpoint combinator for generating recursive values.
	688
	689	The fixpoint is parametrized over an generator state ['a], and the
	690	fixpoint computation may change the value of this state in the recursive
	691	calls.
	692
	693	In particular, this can be used for size-bounded generators (with ['a] as [int]).
	694	The passed size-parameter should decrease to ensure termination. *)
	695
	696	(** Example:
	697	{[
	698	type tree = Leaf of int \| Node of tree * tree
	699
	700	let leaf x = Leaf x
	701	let node x y = Node (x,y)
	702
	703	let g = QCheck.Gen.(sized @@ fix
	704	(fun self n -> match n with
	705	\| 0 -> map leaf nat
	706	\| n ->
	707	frequency
	708	[1, map leaf nat;
	709	2, map2 node (self (n/2)) (self (n/2))]
	710	))
	711
	712	]}
	713
	714	[fix f] shrinks on the generators returned by [f].
	715	*)
	716
	717	val delay : (unit -> 'a t) -> 'a t
	718	(** Delay execution of some code until the generator is actually called.
	719	This can be used to manually implement recursion or control flow
	720	in a generator.
	721	@since 0.17 *)
	722
	723	(** {2:composing_generators Composing generators}
	724
	725	QCheck generators compose well: it means one can easily craft generators for new values
	726	or types from existing generators.
	727
	728	Part of the following documentation is greatly inspired by Gabriel Scherer's excellent
	729	{{:http://gasche.github.io/random-generator/doc/Generator.html } Generator} module documentation.
	730
	731	{3 Functor}
	732
	733	[Gen.t] is a functor (in the Haskell sense of "mappable"): it has a [map] function to transform a generator of ['a] into a generator of ['b],
	734	given a simple function ['a -> 'b].
	735
	736	{[
	737	let even_gen : int Gen.t = Gen.map (fun n -> n * 2) Gen.int
	738
	739	let odd_gen : int Gen.t = Gen.map (fun n -> n * 2 + 1) Gen.int
	740
	741	let lower_case_string_gen : string Gen.t = Gen.map String.lowercase Gen.string_printable
	742
	743	type foo = Foo of string * int
	744	let foo_gen : foo Gen.t =
	745	Gen.map (fun (s, n) -> Foo (s, n)) Gen.(pair string_printable int)
	746	]}
	747
	748	{3 Applicative}
	749
	750	[Gen.t] is applicative: it has a [map2] function to apply a function of 2 (or more) arguments to 2 (or more) generators.
	751
	752	Another equivalent way to look at it is that it has an [ap] function to apply a generator of
	753	functions to a generator of values. While at first sight this may look almost useless, it actually
	754	permits a nice syntax (using the operator alias [<*>]) for functions of any number of arguments.
	755
	756	{[
	757	(* Notice that this looks suspiciously like the [foo] example above:
	758	this is no coincidence! [pair] is a special case of [map2] where
	759	the function wraps arguments in a tuple. *)
	760	type foo = Foo of string * int
	761	let foo_gen : foo Gen.t =
	762	Gen.map2 (fun s n -> Foo (s, n)) Gen.string_printable Gen.int
	763
	764	let string_prefixed_with_keyword_gen : string Gen.t =
	765	Gen.map2 (fun prefix s -> prefix ^ s)
	766	(Gen.oneofl ["foo"; "bar"; "baz"])
	767	Gen.string_printable
	768	]}
	769
	770	Applicatives are useful when you need several random values to build a new generator,
	771	{b and the values are unrelated}. A good rule of thumb is: if the values could be generated
	772	in parallel, then you can use an applicative function to combine those generators.
	773
	774	Note that while [map2] and [map3] are provided, you can use functions with more than 3
	775	arguments (and that is where the [<*>] operator alias really shines):
	776
	777	{[
	778	val complex_function : bool -> string -> int -> string -> int64 -> some_big_type
	779
	780	(* Verbose version, using map3 and ap *)
	781	let big_type_gen : some_big_type Gen.t = Gen.(
	782	ap (
	783	ap (
	784	map3 complex_function
	785	bool
	786	string_printable
	787	int)
	788	string_printable)
	789	int64)
	790
	791	(* Sleeker syntax, using operators aliases for map and ap *)
	792	let big_type_gen : some_big_type Gen.t = Gen.(
	793	complex_function
	794	<$> bool
	795	<*> string_printable
	796	<*> int
	797	<*> string_printable
	798	<*> int64)
	799	]}
	800
	801	{3 Monad}
	802
	803	[Gen.t] is a monad: it has a [bind] function to return a {b generator} (not a value)
	804	based on {b another generated value}.
	805
	806	As an example, imagine you want to create a generator of [(int, string) result] that is
	807	an [Ok] 90% of the time and an [Error] 10% of the time. You can generate a number between
	808	0 and 9 and return a generator of [int] (wrapped in an [Ok] using [map]) if the generated number is
	809	lower than 9, otherwise return a generator of [string] (wrapped in an [Error] using [map]):
	810	{[
	811	let int_string_result : (int, string) result Gen.t = Gen.(
	812	bind (int_range 0 9) (fun n ->
	813	if n < 9
	814	then map Result.ok int
	815	else map Result.error string_printable))
	816
	817	(* Alternative syntax with operators *)
	818	let int_string_result : (int, string) result Gen.t = Gen.(
	819	int_range 0 9 >>= fun n ->
	820	if n < 9
	821	then int >\|= Result.ok
	822	else string_printable >\|= Result.error)
	823
	824	(* Another allternative syntax with OCaml 4.08+ binding operators *)
	825	let int_string_result : (int, string) result Gen.t = Gen.(
	826	let* n = int_range 0 9 in
	827	if n < 9
	828	then int >\|= Result.ok
	829	else string_printable >\|= Result.error)
	830	]}
	831
	832	Note that this particular use case can be simplified by using [frequency]:
	833	{[
	834	let int_string_result : (int, string) result Gen.t = Gen.(
	835	frequency [
	836	(9, int >\|= Result.ok);
	837	(1, string_printable >\|= Result.error)
	838	])
	839	]}
	840
	841	*)
	842
	843	val map : ('a -> 'b) -> 'a t -> 'b t
	844	(** [map f gen] transforms a generator [gen] by applying [f] to each generated element.
	845
	846	Shrinks towards the shrinks of [gen] with [f] applied to them.
	847	*)
	848
	849	val (>\|=) : 'a t -> ('a -> 'b) -> 'b t
	850	(** An infix synonym for {!map}. Note the order of arguments is reversed (usually more
	851	convenient for composing). *)
	852
	853	val (<$>) : ('a -> 'b) -> 'a t -> 'b t
	854	(** An infix synonym for {!map}
	855
	856	@since 0.13 *)
	857
	858	val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
	859	(** [map2 f gen1 gen2] transforms two generators [gen1] and [gen2] by applying [f] to each
	860	pair of generated elements.
	861
	862	Shrinks on [gen1] and then [gen2].
	863	*)
	864
	865	val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t
	866	(** [map3 f gen1 gen2 gen3] transforms three generators [gen1], [gen2], and [gen3] by applying [f]
	867	to each triple of generated elements.
	868
	869	Shrinks on [gen1], then [gen2], and then [gen3].
	870	*)
	871
	872	val ap : ('a -> 'b) t -> 'a t -> 'b t
	873	(** [ap fgen gen] composes a function generator and an argument generator
	874	into a result generator.
	875
	876	Shrinks on [fgen] and then [gen].
	877	*)
	878
	879	val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
	880	(** Synonym for {!ap} *)
	881
	882	val bind : 'a t -> ('a -> 'b t) -> 'b t
	883	(** [bind gen f] first generates a value of type ['a] with [gen] and then
	884	passes it to [f] to generate a value of type ['b]. This is typically
	885	useful when a generator depends on the value generated by another
	886	generator.
	887
	888	Shrinks on [gen] and then on the resulting generator.
	889	*)
	890
	891	val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
	892	(** Synonym for {!bind} *)
	893
	894	val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
	895	(** {{: https://ocaml.org/manual/bindingops.html} Binding operator} alias for {!map}.
	896
	897	Example:
	898	{[
	899	let+ n = int_range 0 10 in
	900	string_of_int n
	901
	902	(* is equivalent to *)
	903
	904	map (fun n -> string_of_int n) (int_range 0 10)
	905	]}
	906	*)
	907
	908	val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
	909	(** {{: https://ocaml.org/manual/bindingops.html} Binding operator} alias for {!pair}.
	910
	911	Example:
	912	{[
	913	let+ n = int_range 0 10
	914	and+ b = bool in
	915	if b then string_of_int n else "Not a number"
	916
	917	(* is equivalent to *)
	918
	919	map
	920	(fun (n, b) -> if b then string_of_int n else "Not a number")
	921	(pair (int_range 0 10) bool)
	922	]}
	923	*)
	924
	925	val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
	926	(** {{: https://ocaml.org/manual/bindingops.html} Binding operator} alias for {!bind}.
	927
	928	Example:
	929	{[
	930	let* n = int_range 0 9 in
	931	if n < 9
	932	then int >\|= Result.ok
	933	else string_printable >\|= Result.error
	934
	935	(* is equivalent to *)
	936
	937	bind (int_range 0 9) (fun n ->
	938	if n < 9
	939	then map Result.ok int
	940	else map Result.error string_printable)
	941	]}
	942	*)
	943
	944	val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
	945	(** {{: https://ocaml.org/manual/bindingops.html} Binding operator} alias for {!pair}.
	946
	947	Example:
	948	{[
	949	let* n = int_range 0 9
	950	and* b = bool in
	951	if n < 9 then int >\|= Result.ok
	952	else if b then pure (Error "Some specific error")
	953	else string_printable >\|= Result.error
	954
	955	(* is equivalent to *)
	956
	957	bind (pair (int_range 0 9) bool) (fun (n, b) ->
	958	if n < 9 then map Result.ok int
	959	else if b then pure (Error "Some specific error")
	960	else map Result.error string_printable)
	961	]}
	962	*)
	963
	964	(** {2 Debug generators}
	965
	966	These functions should not be used in tests: they are provided
	967	for convenience to debug/investigate what values and shrinks a
	968	generator produces.
	969	*)
	970
	971	val generate : ?rand:Random.State.t -> n:int -> 'a t -> 'a list
	972	(** [generate ~n gen] generates [n] values using [gen] (shrinks are discarded). *)
	973
	974	val generate1 : ?rand:Random.State.t -> 'a t -> 'a
	975	(** [generate1 gen] generates one instance of [gen] (shrinks are discarded). *)
	976
	977	val generate_tree : ?rand:Random.State.t -> 'a t -> 'a Tree.t
	978	(** [generate_tree ?rand gen] generates a random value and its shrinks using [gen]. *)
	979	end
	980
	981	(** Printing functions and helpers, used to print generated values on
	982	test failures. *)
	983	module Print : sig
	984
	985	type 'a t = 'a -> string
	986	(** Printer for values of type ['a]. *)
	987
	988	val unit : unit t
	989	(** [unit] is a printer of unit.
	990
	991	@since 0.6
	992	*)
	993
	994	val int : int t
	995	(** [int] is a printer of integer. *)
	996
	997	val bool : bool t
	998	(** [bool] is a printer of boolean. *)
	999
	1000	val float : float t
	1001	(** [float] is a printer of float. *)
	1002
	1003	val char : char t
	1004	(** [char] is a printer of character. *)
	1005
	1006	val string : string t
	1007	(** [string] is a printer of string. *)
	1008
	1009	val option : 'a t -> 'a option t
	1010	(** [option p] is a printer of ['a option], using [p] if it is a [Some]. *)
	1011
	1012	val pair : 'a t -> 'b t -> ('a*'b) t
	1013	(** [pair p1 p2] is a printer of pair. *)
	1014
	1015	val triple : 'a t -> 'b t -> 'c t -> ('a'b'c) t
	1016	(** [triple p1 p2 p3] is a printer of triple. *)
	1017
	1018	val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a'b'c*'d) t
	1019	(** [quad p1 p2 p3 p4] is a printer of quadruple. *)
	1020
	1021	val list : 'a t -> 'a list t
	1022	(** [list p] is a printer of list, using [p] for each element. *)
	1023
	1024	val array : 'a t -> 'a array t
	1025	(** [array p] is a printer of array, using [p] for each element. *)
	1026
	1027	val contramap : ('b -> 'a) -> 'a t -> 'b t
	1028	(** [contramap f p] transforms printer [p] into another using [f].
	1029
	1030	Note the reverse order of types in [f] which may be
	1031	conter-intuitive: indeed a function that {i prints} values of type
	1032	['b] can be obtained by transforming a value of type ['b] to
	1033	['a] using [f], and then by {i printing} this value of type ['a] using [p].
	1034	*)
	1035
	1036	val comap : ('b -> 'a) -> 'a t -> 'b t
	1037	(** @deprecated use {!contramap} instead. *)
	1038	end
	1039
	1040	(** Shrinking helper functions. *)
	1041	module Shrink : sig
	1042	(** Shrinking is used to reduce the size of a counter-example. It tries
	1043	to make the counter-example smaller by decreasing it, or removing
	1044	elements, until the property to test holds again; then it returns the
	1045	smallest value that still made the test fail.
	1046
	1047	This is meant to help developers find a simpler counter-example to
	1048	ease investigation and find more easily the root cause (be it in the
	1049	tested code or in the test).
	1050
	1051	This module exposes helper functions that one can reuse in combination
	1052	with {!Gen.make_primitive} to craft custom primitive generators (not
	1053	by composing other generators). The vast majority of use cases will
	1054	probably not need this module.
	1055	*)
	1056
	1057	(** Util module representing a number type, used for ad hoc polymorphism of
	1058	some functions like {!number_towards}. *)
	1059	module type Number = sig
	1060	type t
	1061	val equal : t -> t -> bool
	1062	val div : t -> t -> t
	1063	val add : t -> t -> t
	1064	val sub : t -> t -> t
	1065	val of_int : int -> t
	1066	end
	1067
	1068	val number_towards : (module Number with type t = 'a) -> destination : 'a -> 'a -> 'a Seq.t
	1069	(** Shrink a number by edging towards a destination.
	1070
	1071	The destination is always the first value for optimal shrinking.
	1072
	1073	{[
	1074	let int64_towards_list destination x = List.of_seq @@
	1075	Gen.number_towards (module Int64) ~destination x
	1076	in
	1077	assert (int64_towards_list 0L 100L =
	1078	[0L; 50L; 75L; 88L; 94L; 97L; 99L]);
	1079	assert (int64_towards_list 500L 1000L =
	1080	[500L; 750L; 875L; 938L; 969L; 985L; 993L; 997L; 999L]);
	1081	assert (int64_towards_list (-50L) (-26L) =
	1082	[-50L; -38L; -32L; -29L; -28L; -27L])
	1083	]}
	1084
	1085	This generic function is exposed to let users reuse this shrinking
	1086	technique for their custom number types. More specialized, convenient
	1087	functions are provided below, e.g. {!int_towards}.
	1088	*)
	1089
	1090	val int_towards : int -> int -> int Seq.t
	1091	(** {!number_towards} specialized to {!int}. *)
	1092
	1093	val int32_towards : int32 -> int32 -> int32 Seq.t
	1094	(** {!number_towards} specialized to {!int32}. *)
	1095
	1096	val int64_towards : int64 -> int64 -> int64 Seq.t
	1097	(** {!number_towards} specialized to {!int64}. *)
	1098
	1099	val float_towards : float -> float -> float Seq.t
	1100	(** {!number_towards} specialized to {!float}.
	1101
	1102	There are various ways to shrink a float:
	1103	- try removing floating digits, i.e. towards integer values
	1104	- try to get as close as possible to the destination, no matter the number of digits
	1105	- a mix of both
	1106
	1107	This implementation, as it relies on the generic {!number_towards} function,
	1108	tries to get as close as possible to the destination, e.g. the last value of
	1109	[Gen.float_towards 50 100] may be [99.9969482421875] (or a similar value).
	1110	*)
	1111
	1112	val int_aggressive_towards : int -> int -> int Seq.t
	1113	(** [int_agressive_towards destination n] gives all integers from [destination] to [n] (excluded).
	1114
	1115	{b Be careful about time and memory} as the resulting list can be huge *)
	1116
	1117	val int_aggressive : int -> int Seq.t
	1118	(** @deprecated Use [int_aggressive_towards 0] instead.
	1119	@since 0.7 *)
	1120
	1121	end
	1122
	1123	(** An observable is a random function {i argument}. *)
	1124	module Observable : sig
	1125	(**
	1126	While random functions don't need to generate {i values} of their arguments,
	1127	they need the abilities to:
	1128	- compare, using [equal] and [hash], so that the same argument always returns
	1129	the same generated value
	1130	- [print], in order to print the function implementation (bindings)
	1131	in case of test failure
	1132
	1133	Inspired by:
	1134	- Jane Street {{: https://blogs.janestreet.com/quickcheck-for-core/} Quickcheck for Core} blog post
	1135	- Koen Claessen's {{: https://www.youtube.com/watch?v=CH8UQJiv9Q4} Shrinking and Showing functions} paper
	1136
	1137	@since 0.6
	1138	*)
	1139
	1140	type -'a t
	1141	(** An observable of ['a], packing a printer and other things. *)
	1142
	1143	val make :
	1144	?eq:('a -> 'a -> bool) ->
	1145	?hash:('a -> int) ->
	1146	'a Print.t ->
	1147	'a t
	1148	(** [make ?eq ?hash print] creates an observable of ['a].
	1149
	1150	If [eq] is [None], uses the standard polymorphic [(=)] function.
	1151
	1152	If [hash] is [None], uses a default hashing function.
	1153	*)
	1154
	1155	val equal : 'a t -> 'a -> 'a -> bool
	1156	(** [equal o] returns the equality function of [o]. *)
	1157
	1158	val hash : 'a t -> 'a -> int
	1159	(** [hash o] returns the hashing function of [o]. *)
	1160
	1161	val print : 'a t -> 'a Print.t
	1162	(** [print o] returns the printing function of [o]. *)
	1163
	1164	val unit : unit t
	1165	(** [unit] is an observable of [unit]. *)
	1166
	1167	val bool : bool t
	1168	(** [bool] is an observable of [bool]. *)
	1169
	1170	val int : int t
	1171	(** [int] is an observable of [int]. *)
	1172
	1173	val float : float t
	1174	(** [float] is an observable of [float]. *)
	1175
	1176	val string : string t
	1177	(** [string] is an observable of [string]. *)
	1178
	1179	val char : char t
	1180	(** [char] is an observable of [char]. *)
	1181
	1182	val contramap : ('b -> 'a) -> 'a t -> 'b t
	1183	(** [contramap f o] maps the function [f] on observable [o].
	1184
	1185	Note the reverse order of types in [f] which may be
	1186	conter-intuitive: indeed a function that {i consumes} values of type
	1187	['b] can be obtained by transforming a value of type ['b] to
	1188	['a] using [f], and then by {i consuming} this value of type ['a] using [o].
	1189	*)
	1190
	1191	val map : ('b -> 'a) -> 'a t -> 'b t
	1192	(** @deprecated use {!contramap} instead. *)
	1193
	1194	val option : 'a t -> 'a option t
	1195	(** [option o] wraps the observable [o] of ['a] into an observable of
	1196	['a option]. *)
	1197
	1198	val list : 'a t -> 'a list t
	1199	(** [list o] wraps the observable [o] of ['a] into an observable of
	1200	['a list]. *)
	1201
	1202	val array : 'a t -> 'a array t
	1203	(** [array o] wraps the observable [o] of ['a] into an observable of
	1204	['a array]. *)
	1205
	1206	val pair : 'a t -> 'b t -> ('a * 'b) t
	1207	(** [pair o1 o2] is an observable of pairs of [('a * 'b)]. *)
	1208
	1209	val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
	1210	(** [triple o1 o2 o3] is an observable of triples of [('a * 'b * 'c)]. *)
	1211
	1212	val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
	1213	(** [quad o1 o2 o3 o4] is an observable of quadruples of [('a * 'b * 'c * 'd)]. *)
	1214	end
	1215
	1216
	1217	(** Utils on combining function arguments. *)
	1218	module Tuple : sig
	1219	(** Heterogeneous tuple, used to pass any number of arguments to
	1220	a function. *)
	1221	type 'a t =
	1222	\| Nil : unit t
	1223	\| Cons : 'a * 'b t -> ('a * 'b) t
	1224
	1225	val nil : unit t
	1226	(** [nil] is {!Nil}. *)
	1227
	1228	val cons : 'a -> 'b t -> ('a * 'b) t
	1229	(** [cons] is {!Cons}. *)
	1230
	1231	type 'a obs
	1232	(** How to observe a {!t}.
	1233
	1234	See {!module:Observable} for more information on what
	1235	"observe" means in the QCheck. *)
	1236
	1237	val o_nil : unit obs
	1238	(** [o_nil] is the {!obs} equivalent of {!nil}. *)
	1239
	1240	val o_cons : 'a Observable.t -> 'b obs -> ('a * 'b) obs
	1241	(** [o_cons] is the {!obs} equivalent of {!cons}. *)
	1242
	1243	val observable : 'a obs -> 'a t Observable.t
	1244	(** [observable obs] returns the underlying observable of [obs]. *)
	1245
	1246	(** Infix {!module:Tuple} operators for convenience. *)
	1247	module Infix : sig
	1248	val (@::) : 'a -> 'b t -> ('a * 'b) t
	1249	(** Alias for {!cons}. *)
	1250
	1251	val (@->) : 'a Observable.t -> 'b obs -> ('a * 'b) obs
	1252	(** Alias for {!o_cons}. *)
	1253	end
	1254
	1255	include module type of Infix
	1256	end
	1257
	1258	type 'f fun_repr
	1259	(** Used by QCheck to shrink and print generated functions of type ['f] in case
	1260	of test failure. You cannot and should not use it yourself. See {!fun_} for more information. *)
	1261
	1262	(** A function packed with the data required to print/shrink it.
	1263
	1264	The idiomatic way to use any [fun_] Gen.t is to directly pattern match
	1265	on it to obtain the executable function.
	1266
	1267	For example (note the [Fun (_, f)] part):
	1268	{[
	1269	QCheck2.(Test.make
	1270	Gen.(pair (fun1 Observable.int bool) (small_list int))
	1271	(fun (Fun (_, f), l) -> l = (List.rev_map f l \|> List.rev l))
	1272	]}
	1273
	1274	In this example [f] is a generated function of type [int -> bool].
	1275
	1276	The ignored part [_] of [Fun (_, f)] is useless to you, but is used by
	1277	QCheck during shrinking/printing in case of test failure.
	1278
	1279	See also {!Fn} for utils to print and apply such a function.
	1280	*)
	1281	type 'f fun_ = Fun of 'f fun_repr * 'f
	1282
	1283	val fun1 : 'a Observable.t -> ?print:('b Print.t) -> 'b Gen.t -> ('a -> 'b) fun_ Gen.t
	1284	(** [fun1 obs gen] generates random functions that take an argument observable
	1285	via [obs] and map to random values generated with [gen].
	1286	To write functions with multiple arguments, it's better to use {!Tuple}
	1287	or {!Observable.pair} rather than applying {!fun_} several times
	1288	(shrinking will be faster).
	1289	@since 0.6 *)
	1290
	1291	val fun2 :
	1292	'a Observable.t ->
	1293	'b Observable.t ->
	1294	?print:'c Print.t ->
	1295	'c Gen.t ->
	1296	('a -> 'b -> 'c) fun_ Gen.t
	1297	(** Specialized version of {!fun_nary} for functions of 2 arguments, for convenience.
	1298	@since 0.6 *)
	1299
	1300	val fun3 :
	1301	'a Observable.t ->
	1302	'b Observable.t ->
	1303	'c Observable.t ->
	1304	?print:'d Print.t ->
	1305	'd Gen.t ->
	1306	('a -> 'b -> 'c -> 'd) fun_ Gen.t
	1307	(** Specialized version of {!fun_nary} for functions of 3 arguments, for convenience.
	1308	@since 0.6 *)
	1309
	1310	val fun4 :
	1311	'a Observable.t ->
	1312	'b Observable.t ->
	1313	'c Observable.t ->
	1314	'd Observable.t ->
	1315	?print:'e Print.t ->
	1316	'e Gen.t ->
	1317	('a -> 'b -> 'c -> 'd -> 'e) fun_ Gen.t
	1318	(** Specialized version of {!fun_nary} for functions of 4 arguments, for convenience.
	1319	@since 0.6 *)
	1320
	1321	val fun_nary : 'a Tuple.obs -> ?print:('b Print.t) -> 'b Gen.t -> ('a Tuple.t -> 'b) fun_ Gen.t
	1322	(** [fun_nary tuple_obs gen] generates random n-ary functions. Arguments are observed
	1323	using [tuple_obs] and return values are generated using [gen].
	1324
	1325	Example (the property is wrong as a random function may return [false], this is for
	1326	the sake of demonstrating the syntax):
	1327	{[
	1328	let module O = Observable in
	1329	Test.make
	1330	(fun_nary Tuple.(O.int @-> O.float @-> O.string @-> o_nil) bool)
	1331	(fun (Fun (_, f)) -> f Tuple.(42 @:: 17.98 @:: "foobar" @:: nil))
	1332	]}
	1333
	1334	Note that this particular example can be simplified using {!fun3} directly:
	1335	{[
	1336	let module O = Observable in
	1337	Test.make
	1338	(fun3 O.int O.float O.string bool)
	1339	(fun (Fun (_, f)) -> f 42 17.98 "foobar")
	1340	]}
	1341
	1342	@since 0.6 *)
	1343
	1344	(** Utils on generated functions.
	1345	@since 0.6 *)
	1346	module Fn : sig
	1347	val print : 'f fun_ Print.t
	1348	(** [print f] prints the implementation of generated function [f].
	1349
	1350	The implementation always contains a default case, represented as [_].
	1351
	1352	Note that printing a function {i before} it was called in the test may not print the full implementation.
	1353	*)
	1354
	1355	val apply : 'f fun_ -> 'f
	1356	(** [apply f] returns the underlying function to be used in tests. This is an alias for
	1357	deconstructing as documented in {!fun_}. *)
	1358	end
	1359
	1360
	1361	(** {2 Assumptions} *)
	1362
	1363	val assume : bool -> unit
	1364	(** [assume cond] checks the precondition [cond], and does nothing
	1365	if [cond=true]. If [cond=false], it interrupts the current test (but the test will not be failed).
	1366
	1367	⚠️ This function must only be used in a test, not outside.
	1368	Example:
	1369	{[
	1370	Test.make (list int) (fun l ->
	1371	assume (l <> []);
	1372	List.hd l :: List.tl l = l)
	1373	]}
	1374
	1375	@since 0.5.1
	1376	*)
	1377
	1378	val (==>) : bool -> bool -> bool
	1379	(** [b1 ==> b2] is the logical implication [b1 => b2]
	1380	ie [not b1 \|\| b2] (except that it is strict and will interact
	1381	better with {!Test.check_exn} and the likes, because they will know
	1382	the precondition was not satisfied.).
	1383
	1384	⚠️ This function should only be used in a property
	1385	(see {!Test.make}), because it raises a special exception in case of
	1386	failure of the first argument, to distinguish between failed test
	1387	and failed precondition. Because of OCaml's evaluation order,
	1388	both [b1] and [b2] are always evaluated; if [b2] should only be
	1389	evaluated when [b1] holds, see {!assume}.
	1390	*)
	1391
	1392	val assume_fail : unit -> 'a
	1393	(** [assume_fail ()] is like [assume false], but can take any type
	1394	since we know it always fails (like [assert false]).
	1395	This is useful to ignore some branches in [if] or [match].
	1396
	1397	Example:
	1398	{[
	1399	Test.make (list int) (function
	1400	\| [] -> assume_fail ()
	1401	\| _::_ as l -> List.hd l :: List.tl l = l)
	1402	]}
	1403
	1404	@since 0.5.1
	1405	*)
	1406
	1407	(** {1 Tests}
	1408
	1409	A test is a universal property of type [foo -> bool] for some type [foo],
	1410	with an object of type [foo Gen.t] used to generate values
	1411	of type [foo].
	1412
	1413	See {!Test.make} to build a test, and {!Test.check_exn} to
	1414	run one test simply.
	1415	For more serious testing, it is better to create a testsuite
	1416	and use {!QCheck_runner}.
	1417	*)
	1418
	1419	type 'a stat = string * ('a -> int)
	1420	(** A statistic on a distribution of values of type ['a].
	1421	The function {b MUST} return a positive integer. *)
	1422
	1423	(** Result of running a test *)
	1424	module TestResult : sig
	1425	type 'a counter_ex = {
	1426	instance: 'a; (** The counter-example *)
	1427
	1428	shrink_steps: int; (** How many shrinking steps for this counter-example *)
	1429
	1430	msg_l: string list;
	1431	(** Messages of the test. Currently only populated by {!Test.fail_report} and {!Test.fail_reportf}.
	1432	@since 0.7 *)
	1433	}
	1434	(** A counter-example when a test fails. *)
	1435
	1436	(** Result state.
	1437
	1438	changed in 0.10 (move to inline records, add Fail_other) *)
	1439	type 'a state =
	1440	\| Success (** If the test passed. *)
	1441	\| Failed of {
	1442	instances: 'a counter_ex list; (** Failed instance(s) *)
	1443	}
	1444	(** If the test failed "normally", i.e. a test returned [false]. *)
	1445	\| Failed_other of {msg: string}
	1446	(** If the test failed for an unusual reason:
	1447	- an exception was raised by a generator
	1448	- too many assumptions failed and [Test.if_assumptions_fail] was set to [`Fatal]
	1449	*)
	1450	\| Error of {
	1451	instance: 'a counter_ex; (** Instance that triggered the exception in the test *)
	1452	exn: exn; (** The raised exception *)
	1453	backtrace: string; (** A best-effort backtrace of the exception *)
	1454	}
	1455	(** If the test failed "exceptionally" (an exception was raised by the test). *)
	1456
	1457	(* Result returned by running a test. *)
	1458	type 'a t
	1459
	1460	val get_state : 'a t -> 'a state
	1461	(** [get_state t] returns the final state after a test execution. *)
	1462
	1463	val get_count : _ t -> int
	1464	(** [get_count t] returns the number of tests executed. *)
	1465
	1466	val get_count_gen : _ t -> int
	1467	(** [get_count_gen t] returns the number of generated cases. *)
	1468
	1469	val get_collect : _ t -> (string,int) Hashtbl.t option
	1470	(** [get_collect t] returns the repartition of generated values.
	1471	@since 0.18 *)
	1472
	1473	val get_stats : 'a t -> ('a stat * (int,int) Hashtbl.t) list
	1474	(** [get_stats t] returns the statistics captured by the test.
	1475	@since 0.18 *)
	1476
	1477	val get_warnings : _ t -> string list
	1478	(** [get_warnings t] returns the list of warnings emitted during the test.
	1479	@since 0.18 *)
	1480
	1481	val get_instances : 'a t -> 'a list
	1482	(** [get_instances t] returns the generated instances, with no guarantee on the order.
	1483	@since 0.18 *)
	1484
	1485	val is_success : _ t -> bool
	1486	(** Returns true iff the state if [Success]
	1487	@since 0.9 *)
	1488
	1489	val stats : 'a t -> ('a stat * (int,int) Hashtbl.t) list
	1490	(** Obtain statistics
	1491	@since 0.6
	1492	@deprecated use {!get_stats} instead *)
	1493
	1494	val warnings : _ t -> string list
	1495	(** Obtain list of warnings
	1496	@since 0.10
	1497	@deprecated use {!get_warnings} instead *)
	1498
	1499	val collect : _ t -> (string,int) Hashtbl.t option
	1500	(** Obtain statistics
	1501	@since 0.6
	1502	@deprecated use {!get_collect} instead *)
	1503	end
	1504
	1505	module Test_exceptions : sig
	1506
	1507	exception Test_fail of string * string list
	1508	(** Exception raised when a test failed, with the list of counter-examples.
	1509	[Test_fail (name, l)] means test [name] failed on elements of [l]. *)
	1510
	1511	exception Test_error of string * string * exn * string
	1512	(** Exception raised when a test raised an exception [e], with
	1513	the sample that triggered the exception.
	1514	[Test_error (name, i, e, st)]
	1515	means [name] failed on [i] with exception [e], and [st] is the
	1516	stacktrace (if enabled) or an empty string. *)
	1517	end
	1518
	1519	(** A test is a pair of an generator and a property thar all generated values must satisfy. *)
	1520	module Test : sig
	1521	(** The main features of this module are:
	1522	- {!make} a test
	1523	- fail the test if a property does not hold (using either the {{!fail_report} simple} form or the {{!fail_reportf} rich} form)
	1524	- {!check_exn} a single test
	1525
	1526	Note that while {!check_exn} is provided for convenience to discover QCheck or to run a single test in {{: https://opam.ocaml.org/blog/about-utop/} utop}, to run QCheck tests in your project you probably want to opt for a more advanced runner, or convert
	1527	QCheck tests to your favorite test framework:
	1528	- {!QCheck_base_runner} for a QCheck-only runner (useful if you don't have or don't need another test framework)
	1529	- {!QCheck_alcotest} to convert to Alcotest framework
	1530	- {!QCheck_ounit} to convert to OUnit framework
	1531	*)
	1532
	1533	type 'a cell
	1534	(** A single property test on a value of type ['a]. A {!Test.t} wraps a [cell]
	1535	and hides its type parameter. *)
	1536
	1537	val make_cell :
	1538	?if_assumptions_fail:([`Fatal \| `Warning] * float) ->
	1539	?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?name:string ->
	1540	?print:'a Print.t -> ?collect:('a -> string) -> ?stats:('a stat list) ->
	1541	'a Gen.t -> ('a -> bool) ->
	1542	'a cell
	1543	(** [make_cell gen prop] builds a test that checks property [prop] on instances
	1544	of the generator [gen].
	1545	@param name the name of the test.
	1546	@param count number of test cases to run, counting only
	1547	the test cases which satisfy preconditions.
	1548	@param long_factor the factor by which to multiply count, max_gen and
	1549	max_fail when running a long test (default: 1).
	1550	@param max_gen maximum number of times the generation function
	1551	is called in total to replace inputs that do not satisfy
	1552	preconditions (should be >= count).
	1553	@param max_fail maximum number of failures before we stop generating
	1554	inputs. This is useful if shrinking takes too much time.
	1555	@param if_assumptions_fail the minimum
	1556	fraction of tests that must satisfy the precondition for a success
	1557	to be considered valid.
	1558	The fraction should be between 0. and 1.
	1559	A warning will be emitted otherwise if
	1560	the flag is [`Warning], the test will be a failure if the flag is [`Fatal].
	1561	(since 0.10)
	1562	@param print used in {!Print} to display generated values failing the [prop]
	1563	@param collect (* collect values by tag, useful to display distribution of generated *)
	1564	@param stats on a distribution of values of type 'a
	1565	*)
	1566
	1567	val make_cell_from_QCheck1 :
	1568	?if_assumptions_fail:([`Fatal \| `Warning] * float) ->
	1569	?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int ->
	1570	?name:string -> gen:(Random.State.t -> 'a) -> ?shrink:('a -> ('a -> unit) -> unit) ->
	1571	?print:('a -> string) -> ?collect:('a -> string) -> stats:'a stat list -> ('a -> bool) ->
	1572	'a cell
	1573	(** ⚠️ Do not use, this is exposed for internal reasons only. ⚠️
	1574
	1575	@deprecated Migrate to QCheck2 and use {!make_cell} instead.
	1576	*)
	1577
	1578	val get_law : 'a cell -> ('a -> bool)
	1579	val get_name : _ cell -> string
	1580	val get_gen : 'a cell -> 'a Gen.t
	1581	val get_print_opt : 'a cell -> ('a Print.t) option
	1582	val get_collect_opt : 'a cell -> ('a -> string) option
	1583	val get_stats : 'a cell -> ('a stat list)
	1584	val set_name : _ cell -> string -> unit
	1585
	1586	val get_count : _ cell -> int
	1587	(** Get the count of a cell.
	1588	@since 0.5.3 *)
	1589
	1590	val get_long_factor : _ cell -> int
	1591	(** Get the long factor of a cell.
	1592	@since 0.5.3 *)
	1593
	1594	type t = Test : 'a cell -> t
	1595	(** Same as ['a cell], but masking the type parameter. This allows to
	1596	put tests on different types in the same list of tests. *)
	1597
	1598	val make :
	1599	?if_assumptions_fail:([`Fatal \| `Warning] * float) ->
	1600	?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?name:string ->
	1601	?print:('a Print.t) -> ?collect:('a -> string) -> ?stats:('a stat list) ->
	1602	'a Gen.t -> ('a -> bool) -> t
	1603	(** [make gen prop] builds a test that checks property [prop] on instances
	1604	of the generator [gen].
	1605	See {!make_cell} for a description of the parameters.
	1606	*)
	1607
	1608	val test_get_count : t -> int
	1609
	1610	val fail_report : string -> 'a
	1611	(** Fail the test with some additional message that will be reported.
	1612
	1613	@since 0.7 *)
	1614
	1615	val fail_reportf : ('a, Format.formatter, unit, 'b) format4 -> 'a
	1616	(** Format version of {!fail_report}.
	1617
	1618	Example:
	1619	{[
	1620	Test.fail_reportf
	1621	"Value N = %i should be greater than M = %i for Foo = %a" n m pp_foo foo
	1622	]}
	1623
	1624	@since 0.7 *)
	1625
	1626	(** {3 Running the test} *)
	1627
	1628	include module type of Test_exceptions
	1629
	1630	val print_instance : 'a cell -> 'a -> string
	1631	val print_c_ex : 'a cell -> 'a TestResult.counter_ex -> string
	1632	val print_fail : 'a cell -> string -> 'a TestResult.counter_ex list -> string
	1633	val print_fail_other : string -> msg:string -> string
	1634	val print_error : ?st:string -> 'a cell -> string -> 'a TestResult.counter_ex * exn -> string
	1635	val print_test_fail : string -> string list -> string
	1636	val print_test_error : string -> string -> exn -> string -> string
	1637
	1638	val print_collect : (string,int) Hashtbl.t -> string
	1639	(** Print "collect" results.
	1640	@since 0.6 *)
	1641
	1642	val print_stat : ('a stat * (int,int) Hashtbl.t) -> string
	1643	(** Print statistics.
	1644	@since 0.6 *)
	1645
	1646	val check_result : 'a cell -> 'a TestResult.t -> unit
	1647	(** [check_result cell res] checks that [res] is [Ok _], and returns unit.
	1648	Otherwise, it raises some exception.
	1649	@raise Test_error if [res = Error _]
	1650	@raise Test_error if [res = Failed _] *)
	1651
	1652	type res =
	1653	\| Success
	1654	\| Failure
	1655	\| FalseAssumption
	1656	\| Error of exn * string
	1657
	1658	type 'a event =
	1659	\| Generating
	1660	\| Collecting of 'a
	1661	\| Testing of 'a
	1662	\| Shrunk of int * 'a
	1663	\| Shrinking of int * int * 'a
	1664
	1665	type 'a handler = string -> 'a cell -> 'a event -> unit
	1666	(** Handler executed after each event during testing of an instance. *)
	1667
	1668	type 'a step = string -> 'a cell -> 'a -> res -> unit
	1669	(** Callback executed after each instance of a test has been run.
	1670	The callback is given the instance tested, and the current results
	1671	of the test. *)
	1672
	1673	type 'a callback = string -> 'a cell -> 'a TestResult.t -> unit
	1674	(** Callback executed after each test has been run.
	1675	[f name cell res] means test [cell], named [name], gave [res]. *)
	1676
	1677	val check_cell :
	1678	?long:bool -> ?call:'a callback ->
	1679	?step:'a step -> ?handler:'a handler ->
	1680	?rand:Random.State.t -> 'a cell -> 'a TestResult.t
	1681	(** [check_cell ~long ~rand test] generates up to [count] random
	1682	values of type ['a] using [Gen.t] and the random state [st]. The
	1683	predicate [law] is called on them and if it returns [false] or raises an
	1684	exception then we have a counter-example for the [law].
	1685
	1686	@param long if [true] then multiply the number of instances to generate
	1687	by the cell's long_factor.
	1688	@param call function called on each test case, with the result.
	1689	@param step function called on each instance of the test case, with the result.
	1690	@return the result of the test.
	1691	*)
	1692
	1693	val check_cell_exn :
	1694	?long:bool -> ?call:'a callback -> ?step:'a step ->
	1695	?rand:Random.State.t -> 'a cell -> unit
	1696	(** Same as {!check_cell} but calls {!check_result} on the result.
	1697	@raise Test_error if [res = Error _]
	1698	@raise Test_error if [res = Failed _] *)
	1699
	1700	val check_exn : ?long:bool -> ?rand:Random.State.t -> t -> unit
	1701	(** Checks the property against some test cases, and calls {!check_result},
	1702	which might raise an exception in case of failure.
	1703	@raise Test_error if [res = Error _]
	1704	@raise Test_error if [res = Failed _] *)
	1705	end
	1706
	1707	(** {2 Sub-tests} *)
	1708
	1709	(** The infrastructure used to find counter-examples to properties can
	1710	also be used to find data satisfying a predicate,
	1711	{i within a property being tested}.
	1712
	1713	See https://github.com/c-cube/qcheck/issues/31
	1714	*)
	1715
	1716	exception No_example_found of string
	1717	(** Raised by {!find_example} and {!find_example_gen} if no example was found. *)
	1718
	1719	val find_example :
	1720	?name:string ->
	1721	?count:int ->
	1722	f:('a -> bool) ->
	1723	'a Gen.t ->
	1724	'a Gen.t
	1725	(** [find_example ~f gen] uses [gen] to generate some values of type ['a],
	1726	and checks them against [f]. If such a value is found, it is returned.
	1727	Otherwise an exception is raised.
	1728
	1729	⚠️ This should only be used from within a property in {!Test.make}.
	1730
	1731	@param name Description of the example to find (used in test results/errors).
	1732	@param count Number of attempts.
	1733	@param f The property that the generated values must satisfy.
	1734	@raise No_example_found If no example is found within [count] tries.
	1735	@since 0.6
	1736	*)
	1737
	1738	val find_example_gen :
	1739	?rand:Random.State.t ->
	1740	?name:string ->
	1741	?count:int ->
	1742	f:('a -> bool) ->
	1743	'a Gen.t ->
	1744	'a
	1745	(** Toplevel version of {!find_example}.
	1746	[find_example_gen ~f gen] is roughly the same as
	1747	[Gen.generate1 @@ find_example ~f gen].
	1748	@param rand the random state to use to generate inputs.
	1749	@raise No_example_found if no example was found within [count] tries.
	1750	@since 0.6 *)
	1751
	1752	(** {1:migration_qcheck2 Migration to QCheck2}
	1753
	1754	QCheck2 is a major release and as such, there are (as few as possible)
	1755	breaking changes, as well as functional changes you should be aware of.
	1756
	1757	{2 Minimal changes}
	1758
	1759	Most of your QCheck (v1) code should be able to compile and run the first time you upgrade
	1760	your QCheck version to a QCheck2-compatible version. However you may need to do the
	1761	following minimal changes:
	1762	- {!QCheck.Test.make} return type was changed to {!QCheck2.Test.t} to be able to run
	1763	both QCheck and QCheck2 tests together. This is transparent if you used type inference,
	1764	but if you explicitly used {!QCheck.Test.t} you will need to change it to {!QCheck2.Test.t}.
	1765
	1766	{2 Recommended changes}
	1767	Now you want to actually start using the QCheck2 features (most importantly: free shrinking!).
	1768	To get started, change all your {!QCheck} references to {!QCheck2} and follow the compiler errors.
	1769	Below are the most common situations you may encounter:
	1770	- as shrinking is now integrated, several function arguments like [~shrink] or [~rev] have been removed: you
	1771	can remove such reverse functions, they will no longer be necessary.
	1772	- accessor functions like {!QCheck.gen} have been renamed to consistent names like {!get_gen}.
	1773	- {!QCheck.map_keep_input} has been removed: you can use {!map} directly.
	1774	- {!Gen.t} is no longer public, it is now abstract: it is recommended to use
	1775	{{!section:Gen.composing_generators} generator composition} to make generators. {!Gen.make_primitive}
	1776	was added to create generators with finer control (in particular of shrinking).
	1777	*)

-5

src/core/dune less more

5	5	(libraries unix bytes)
6	6	(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string)
7	7	)
8
9		(rule
10		(targets qcheck_ops.ml)
11		(deps)
12		(action (with-stdout-to %{targets} (run ./gen/gen_ops.exe))))

-3

~~src/core/gen/dune~~ less more

0
1		(executable
2		(name gen_ops))

-50

~~src/core/gen/gen_ops.ml~~ less more

0
1		let shims_let_op_pre_408 =
2		"
3		module type S = sig type 'a t_let end
4		module Make(X:sig type 'a t end) = struct type 'a t_let = 'a X.t end
5		"
6		let shims_let_op_post_408 =
7		"
8		module type S = sig
9		type 'a t_let
10		val (let+) : 'a t_let -> ('a -> 'b) -> 'b t_let
11		val (and+) : 'a t_let -> 'b t_let -> ('a * 'b) t_let
12		val (let*) : 'a t_let -> ('a -> 'b t_let) -> 'b t_let
13		val (and) : 'a t_let -> 'b t_let -> ('a 'b) t_let
14		end
15		module Make(X:sig
16		type 'a t
17		val (>\|=) : 'a t -> ('a -> 'b) -> 'b t
18		val monoid_product : 'a t -> 'b t -> ('a * 'b) t
19		val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
20		end) : S with type 'a t_let = 'a X.t = struct
21		type 'a t_let = 'a X.t
22		let (let+) = X.(>\|=)
23		let (and+) = X.monoid_product
24		let (let*) = X.(>>=)
25		let (and*) = X.monoid_product
26		end[@@inline]
27
28		"
29
30		let split_on c s =
31		let l = ref [] in
32		let i = ref 0 in
33		while !i < String.length s do
34		let j = try String.index_from s !i c with Not_found -> String.length s in
35		l := String.sub s !i (j- !i) :: !l;
36		i := j+1;
37		done;
38		List.rev !l
39
40		let () =
41		let maj, min = match split_on '.' Sys.ocaml_version with
42		\| m1 :: m2 :: _ -> int_of_string m1, int_of_string m2
43		\| _ -> failwith "cannot parse ocaml version"
44		in
45		if (maj,min) >= (4,8) then (
46		print_endline shims_let_op_post_408
47		) else (
48		print_endline shims_let_op_pre_408
49		)

-1

src/dune less more

2	2	(name qcheck)
3	3	(public_name qcheck)
4	4	(wrapped false)
5		(optional)
6	5	(modules QCheck_runner)
7	6	(synopsis "compatibility library for qcheck")
8	7	(libraries qcheck-core qcheck-core.runner qcheck-ounit))

-4

src/ounit/QCheck_ounit.ml less more

51	51	(* random seed, for repeatability of tests *)
52	52	Random.State.make [\| 89809344; 994326685; 290180182 \|]
53	53
54		let to_ounit2_test ?(rand =default_rand()) (QCheck.Test.Test cell) =
55		let module T = QCheck.Test in
	54	let to_ounit2_test ?(rand =default_rand()) (QCheck2.Test.Test cell) =
	55	let module T = QCheck2.Test in
56	56	let name = T.get_name cell in
57	57	let open OUnit2 in
58	58	name >: test_case ~length:OUnitTest.Long (fun ctxt ->

81	81	possibly print errors and counter-examples *)
82	82	let to_ounit_test_cell ?(verbose=verbose()) ?(long=long_tests())
83	83	?(rand=random_state()) cell =
84		let module T = QCheck.Test in
	84	let module T = QCheck2.Test in
85	85	let name = T.get_name cell in
86	86	let run () =
87	87	try

93	93	in
94	94	name >:: (fun () -> assert_bool name (run ()))
95	95
96		let to_ounit_test ?verbose ?long ?rand (QCheck.Test.Test c) =
	96	let to_ounit_test ?verbose ?long ?rand (QCheck2.Test.Test c) =
97	97	to_ounit_test_cell ?verbose ?long ?rand c
98	98
99	99	let (>:::) name l =

-6

src/ounit/QCheck_ounit.mli less more

5	5
6	6	val to_ounit_test :
7	7	?verbose:bool -> ?long:bool -> ?rand:Random.State.t ->
8		QCheck.Test.t -> OUnit.test
	8	QCheck2.Test.t -> OUnit.test
9	9	(** [to_ounit_test ~rand t] wraps [t] into a OUnit test
10	10	@param verbose used to print information on stdout (default: [verbose()])
11	11	@param rand the random generator to use (default: [random_state ()]) *)
12	12
13	13	val to_ounit_test_cell :
14	14	?verbose:bool -> ?long:bool -> ?rand:Random.State.t ->
15		_ QCheck.Test.cell -> OUnit.test
	15	_ QCheck2.Test.cell -> OUnit.test
16	16	(** Same as {!to_ounit_test} but with a polymorphic test cell *)
17	17
18		val (>:::) : string -> QCheck.Test.t list -> OUnit.test
19		(** Same as [OUnit.(>:::)] but with a list of QCheck tests *)
	18	val (>:::) : string -> QCheck2.Test.t list -> OUnit.test
	19	(** Same as [OUnit.(>:::)] but with a list of QCheck2 tests *)
20	20
21		val to_ounit2_test : ?rand:Random.State.t -> QCheck.Test.t -> OUnit2.test
	21	val to_ounit2_test : ?rand:Random.State.t -> QCheck2.Test.t -> OUnit2.test
22	22	(** [to_ounit2_test ?rand t] wraps [t] into a OUnit2 test
23	23	@param rand the random generator to use (default: a static seed for reproducibility),
24	24	can be overridden with "-seed" on the command-line
25	25	*)
26	26
27		val to_ounit2_test_list : ?rand:Random.State.t -> QCheck.Test.t list -> OUnit2.test list
	27	val to_ounit2_test_list : ?rand:Random.State.t -> QCheck2.Test.t list -> OUnit2.test list
28	28	(** [to_ounit2_test_list ?rand t] like [to_ounit2_test] but for a list of tests *)
29	29
30	30	(** {2 OUnit runners}

-1

src/ounit/dune less more

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

+50

-57

src/runner/QCheck_base_runner.ml less more

119	119	@param verbose if true, print statistics and details
120	120	@param print_res if true, print the result on [out] *)
121	121	let callback ~colors ~verbose ~print_res ~print name cell result =
122		let module R = QCheck.TestResult in
123		let module T = QCheck.Test in
124		let arb = T.get_arbitrary cell in
	122	let module R = QCheck2.TestResult in
	123	let module T = QCheck2.Test in
125	124	let reset_line = if colors then Color.reset_line else "\n" in
126	125	if verbose then (
127	126	print.info "%slaw %s: %d relevant cases (%d total)\n"
128		reset_line name result.R.count result.R.count_gen;
129		begin match QCheck.TestResult.collect result with
	127	reset_line name (R.get_count result) (R.get_count_gen result);
	128	begin match QCheck2.TestResult.collect result with
130	129	\| None -> ()
131	130	\| Some tbl ->
132		print_string (QCheck.Test.print_collect tbl)
	131	print_string (QCheck2.Test.print_collect tbl)
133	132	end;
134	133	);
135	134	if print_res then (
136	135	(* even if [not verbose], print errors *)
137		match result.R.state with
	136	match R.get_state result with
138	137	\| R.Success -> ()
139	138	\| R.Failed {instances=l} ->
140		print.fail "%s%s\n" reset_line (T.print_fail arb name l);
	139	print.fail "%s%s\n" reset_line (T.print_fail cell name l);
141	140	\| R.Failed_other {msg} ->
142	141	print.fail "%s%s\n" reset_line (T.print_fail_other name ~msg);
143	142	\| R.Error {instance; exn; backtrace} ->
144	143	print.err "%s%s\n" reset_line
145		(T.print_error ~st:backtrace arb name (instance,exn));
	144	(T.print_error ~st:backtrace cell name (instance,exn));
146	145	)
147	146
148	147	let print_std = { info = Printf.printf; fail = Printf.printf; err = Printf.printf }

196	195	}
197	196
198	197	type res =
199		\| Res : 'a QCheck.Test.cell * 'a QCheck.TestResult.t -> res
	198	\| Res : 'a QCheck2.Test.cell * 'a QCheck2.TestResult.t -> res
200	199
201	200	type handler = {
202		handler : 'a. 'a QCheck.Test.handler;
	201	handler : 'a. 'a QCheck2.Test.handler;
203	202	}
204	203
205	204	type handler_gen =

215	214	size c.passed size c.expected t
216	215
217	216	let debug_shrinking_counter_example cell out x =
218		match (QCheck.Test.get_arbitrary cell).QCheck.print with
	217	match QCheck2.Test.get_print_opt cell with
219	218	\| None -> Printf.fprintf out "<no printer provided>"
220	219	\| Some print -> Printf.fprintf out "%s" (print x)
221
222		let debug_shrinking_size cell out x =
223		match (QCheck.Test.get_arbitrary cell).QCheck.small with
224		\| None -> ()
225		\| Some f -> Printf.fprintf out ", size %d" (f x)
226	220
227	221	let debug_shrinking_choices_aux ~colors out name i cell x =
228	222	Printf.fprintf out "\n~~~ %a %s\n\n"
229	223	(Color.pp_str_c ~colors `Cyan) "Shrink" (String.make 69 '~');
230	224	Printf.fprintf out
231		"Test %s sucessfully shrunk counter example (step %d%a) to:\n\n%a\n%!"
	225	"Test %s sucessfully shrunk counter example (step %d) to:\n\n%a\n%!"
232	226	name i
233		(debug_shrinking_size cell) x
234	227	(debug_shrinking_counter_example cell) x
235	228
236	229	let debug_shrinking_choices

252	245	~size ~out ~verbose c =
253	246	let handler name cell r =
254	247	let st = function
255		\| QCheck.Test.Generating -> "generating"
256		\| QCheck.Test.Collecting _ -> "collecting"
257		\| QCheck.Test.Testing _ -> " testing"
258		\| QCheck.Test.Shrunk (i, _) ->
	248	\| QCheck2.Test.Generating -> "generating"
	249	\| QCheck2.Test.Collecting _ -> "collecting"
	250	\| QCheck2.Test.Testing _ -> " testing"
	251	\| QCheck2.Test.Shrunk (i, _) ->
259	252	Printf.sprintf "shrinking: %4d" i
260		\| QCheck.Test.Shrinking (i, j, _) ->
	253	\| QCheck2.Test.Shrinking (i, j, _) ->
261	254	Printf.sprintf "shrinking: %4d.%04d" i j
262	255	in
263	256	(* debug shrinking choices *)
264	257	begin match r with
265		\| QCheck.Test.Shrunk (i, x) ->
	258	\| QCheck2.Test.Shrunk (i, x) ->
266	259	debug_shrinking_choices
267	260	~colors ~debug_shrink ~debug_shrink_list name cell i x
268	261	\| _ ->

281	274
282	275	let step ~colors ~size ~out ~verbose c name _ _ r =
283	276	let aux = function
284		\| QCheck.Test.Success -> c.passed <- c.passed + 1
285		\| QCheck.Test.Failure -> c.failed <- c.failed + 1
286		\| QCheck.Test.FalseAssumption -> ()
287		\| QCheck.Test.Error _ -> c.errored <- c.errored + 1
	277	\| QCheck2.Test.Success -> c.passed <- c.passed + 1
	278	\| QCheck2.Test.Failure -> c.failed <- c.failed + 1
	279	\| QCheck2.Test.FalseAssumption -> ()
	280	\| QCheck2.Test.Error _ -> c.errored <- c.errored + 1
288	281	in
289	282	c.gen <- c.gen + 1;
290	283	aux r;

296	289	)
297	290
298	291	let callback ~size ~out ~verbose ~colors c name _ r =
299		let pass = QCheck.TestResult.is_success r in
	292	let pass = QCheck2.TestResult.is_success r in
300	293	let color = if pass then `Green else `Red in
301	294	if verbose then (
302	295	Printf.fprintf out "%s[%a] %a %s\n%!"

305	298	(pp_counter ~size) c name
306	299	)
307	300
308		let print_inst arb x =
309		match arb.QCheck.print with
	301	let print_inst cell x =
	302	match QCheck2.Test.get_print_opt cell with
310	303	\| Some f -> f x
311	304	\| None -> "<no printer>"
312	305
313	306	let expect long cell =
314		let count = QCheck.Test.get_count cell in
315		if long then QCheck.Test.get_long_factor cell * count else count
	307	let count = QCheck2.Test.get_count cell in
	308	if long then QCheck2.Test.get_long_factor cell * count else count
316	309
317	310	let expect_size long cell =
318	311	let rec aux n = if n < 10 then 1 else 1 + (aux (n / 10)) in

324	317	Printf.fprintf out
325	318	"\n+++ %a %s\n\nMessages for test %s:\n\n%!"
326	319	(Color.pp_str_c ~colors `Blue) "Messages"
327		(String.make 68 '+') (QCheck.Test.get_name cell);
	320	(String.make 68 '+') (QCheck2.Test.get_name cell);
328	321	List.iter (Printf.fprintf out "%s\n%!") l
329	322	)
330	323
331	324	let print_success ~colors out cell r =
332		begin match QCheck.TestResult.collect r with
	325	begin match QCheck2.TestResult.collect r with
333	326	\| None -> ()
334	327	\| Some tbl ->
335	328	Printf.fprintf out
336	329	"\n+++ %a %s\n\nCollect results for test %s:\n\n%s%!"
337	330	(Color.pp_str_c ~colors `Blue) "Collect"
338		(String.make 68 '+') (QCheck.Test.get_name cell) (QCheck.Test.print_collect tbl)
	331	(String.make 68 '+') (QCheck2.Test.get_name cell) (QCheck2.Test.print_collect tbl)
339	332	end;
340	333	List.iter (fun msg ->
341	334	Printf.fprintf out
342	335	"\n!!! %a %s\n\nWarning for test %s:\n\n%s%!"
343	336	(Color.pp_str_c ~colors `Yellow) "Warning" (String.make 68 '!')
344		(QCheck.Test.get_name cell) msg)
345		(QCheck.TestResult.warnings r);
346
347		if QCheck.TestResult.stats r <> [] then
	337	(QCheck2.Test.get_name cell) msg)
	338	(QCheck2.TestResult.warnings r);
	339
	340	if QCheck2.TestResult.stats r <> [] then
348	341	Printf.fprintf out
349	342	"\n+++ %a %s\n%!"
350		(Color.pp_str_c ~colors `Blue) ("Stats for " ^ QCheck.Test.get_name cell)
	343	(Color.pp_str_c ~colors `Blue) ("Stats for " ^ QCheck2.Test.get_name cell)
351	344	(String.make 56 '+');
352	345	List.iter
353		(fun st -> Printf.fprintf out "\n%s%!" (QCheck.Test.print_stat st))
354		(QCheck.TestResult.stats r);
	346	(fun st -> Printf.fprintf out "\n%s%!" (QCheck2.Test.print_stat st))
	347	(QCheck2.TestResult.stats r);
355	348	()
356	349
357	350	let print_fail ~colors out cell c_ex =
358	351	Printf.fprintf out "\n--- %a %s\n\n" (Color.pp_str_c ~colors `Red) "Failure" (String.make 68 '-');
359	352	Printf.fprintf out "Test %s failed (%d shrink steps):\n\n%s\n%!"
360		(QCheck.Test.get_name cell) c_ex.QCheck.TestResult.shrink_steps
361		(print_inst (QCheck.Test.get_arbitrary cell) c_ex.QCheck.TestResult.instance);
362		print_messages ~colors out cell c_ex.QCheck.TestResult.msg_l
	353	(QCheck2.Test.get_name cell) c_ex.QCheck2.TestResult.shrink_steps
	354	(print_inst cell c_ex.QCheck2.TestResult.instance);
	355	print_messages ~colors out cell c_ex.QCheck2.TestResult.msg_l
363	356
364	357	let print_fail_other ~colors out cell msg =
365	358	Printf.fprintf out "\n--- %a %s\n\n" (Color.pp_str_c ~colors `Red) "Failure" (String.make 68 '-');
366		Printf.fprintf out "Test %s failed:\n\n%s\n%!" (QCheck.Test.get_name cell) msg
	359	Printf.fprintf out "Test %s failed:\n\n%s\n%!" (QCheck2.Test.get_name cell) msg
367	360
368	361	let print_error ~colors out cell c_ex exn bt =
369	362	Printf.fprintf out "\n=== %a %s\n\n" (Color.pp_str_c ~colors `Red) "Error" (String.make 70 '=');
370	363	Printf.fprintf out "Test %s errored on (%d shrink steps):\n\n%s\n\nexception %s\n%s\n%!"
371		(QCheck.Test.get_name cell)
372		c_ex.QCheck.TestResult.shrink_steps
373		(print_inst (QCheck.Test.get_arbitrary cell) c_ex.QCheck.TestResult.instance)
	364	(QCheck2.Test.get_name cell)
	365	c_ex.QCheck2.TestResult.shrink_steps
	366	(print_inst cell c_ex.QCheck2.TestResult.instance)
374	367	(Printexc.to_string exn)
375	368	bt;
376		print_messages ~colors out cell c_ex.QCheck.TestResult.msg_l
	369	print_messages ~colors out cell c_ex.QCheck2.TestResult.msg_l
377	370
378	371	let run_tests
379	372	?(handler=default_handler)

381	374	?(debug_shrink=debug_shrink()) ?(debug_shrink_list=debug_shrink_list())
382	375	?(out=stdout) ?rand l =
383	376	let rand = match rand with Some x -> x \| None -> random_state_ ~colors () in
384		let module T = QCheck.Test in
385		let module R = QCheck.TestResult in
	377	let module T = QCheck2.Test in
	378	let module R = QCheck2.TestResult in
386	379	let pp_color = Color.pp_str_c ~bold:true ~colors in
387	380	let size = List.fold_left (fun acc (T.Test cell) ->
388	381	max acc (expect_size long cell)) 4 l in

403	396	Printf.fprintf out "%s[ ] %a %s%!"
404	397	(if colors then Color.reset_line else "")
405	398	(pp_counter ~size) c (T.get_name cell);
406		let r = QCheck.Test.check_cell ~long ~rand
	399	let r = QCheck2.Test.check_cell ~long ~rand
407	400	~handler:(handler ~colors ~debug_shrink ~debug_shrink_list
408	401	~size ~out ~verbose c).handler
409	402	~step:(step ~colors ~size ~out ~verbose c)

414	407	in
415	408	let res = List.map aux_map l in
416	409	let aux_fold (total, fail, error, warns) (Res (cell, r)) =
417		let warns = warns + List.length r.R.warnings in
418		let acc = match r.R.state with
	410	let warns = warns + List.length (R.get_warnings r) in
	411	let acc = match R.get_state r with
419	412	\| R.Success ->
420	413	print_success ~colors out cell r;
421	414	(total + 1, fail, error, warns)

-6

src/runner/QCheck_base_runner.mli less more

5	5
6	6	(** {1 Runners for Tests}
7	7
8		Once you built some tests using {!QCheck.Test.make}, you need to
	8	Once you built some tests using {!QCheck2.Test.make}, you need to
9	9	run the tests. This module contains several {b runners},
10	10	which are designed to run every test and report the result.
11	11

17	17	]
18	18
19	19	let () =
20		let errcode = QCheck_runners.run_tests ~verbose:true testsuite in
	20	let errcode = QCheck_base_runner.run_tests ~verbose:true testsuite in
21	21	exit errcode
22	22	]}
23	23	which will run the tests, and exit the program. The error code

72	72	test cell. *)
73	73
74	74	type handler = {
75		handler : 'a. 'a QCheck.Test.handler;
	75	handler : 'a. 'a QCheck2.Test.handler;
76	76	}
77	77	(** A type to represent polymorphic-enough handlers for test cells. *)
78	78

95	95	?debug_shrink:(out_channel option) ->
96	96	?debug_shrink_list:(string list) ->
97	97	?out:out_channel -> ?rand:Random.State.t ->
98		QCheck.Test.t list -> int
	98	QCheck2.Test.t list -> int
99	99	(** Run a suite of tests, and print its results. This is an heritage from
100	100	the "qcheck" library.
101	101	@return an error code, [0] if all tests passed, [1] otherwise.
102	102	@param colors if true, colorful output
103	103	@param verbose if true, prints more information about test cases *)
104	104
105		val run_tests_main : ?argv:string array -> QCheck.Test.t list -> 'a
	105	val run_tests_main : ?argv:string array -> QCheck2.Test.t list -> 'a
106	106	(** Can be used as the main function of a test file. Exits with a non-0 code
107	107	if the tests fail. It refers to {!run_tests} for actually running tests
108	108	after CLI options have been parsed.

189	189	verbose:bool ->
190	190	print_res:bool ->
191	191	print:('a, 'b) printer ->
192		string -> 'c QCheck.Test.cell -> 'c QCheck.TestResult.t -> unit
	192	string -> 'c QCheck2.Test.cell -> 'c QCheck2.TestResult.t -> unit
193	193
194	194	type cli_args = {
195	195	cli_verbose : bool;

+463

-0

test/core/QCheck2_expect_test.ml less more

	0	( QCheck2 tests )
	1
	2	(** Module representing a integer tree data structure, used in tests *)
	3	module IntTree = struct
	4	type tree = Leaf of int \| Node of tree * tree
	5
	6	let leaf x = Leaf x
	7	let node x y = Node (x,y)
	8
	9	let rec depth = function
	10	\| Leaf _ -> 1
	11	\| Node (x, y) -> 1 + max (depth x) (depth y)
	12
	13	let rec print_tree = function
	14	\| Leaf x -> Printf.sprintf "Leaf %d" x
	15	\| Node (x, y) -> Printf.sprintf "Node (%s, %s)" (print_tree x) (print_tree y)
	16
	17	let gen_tree = QCheck2.Gen.(sized @@ fix
	18	(fun self n -> match n with
	19	\| 0 -> map leaf nat
	20	\| n ->
	21	frequency
	22	[1, map leaf nat;
	23	2, map2 node (self (n/2)) (self (n/2))]
	24	))
	25
	26	let rec rev_tree = function
	27	\| Node (x, y) -> Node (rev_tree y, rev_tree x)
	28	\| Leaf x -> Leaf x
	29
	30	let rec contains_only_n tree n = match tree with
	31	\| Leaf n' -> n = n'
	32	\| Node (x, y) -> contains_only_n x n && contains_only_n y n
	33	end
	34
	35	(* tests of overall functionality *)
	36	module Overall = struct
	37	open QCheck2
	38
	39	let passing =
	40	Test.make ~name:"list_rev_is_involutive" ~count:100 ~long_factor:100
	41	~print:Print.(list int)
	42	Gen.(list small_int) (fun l -> List.rev (List.rev l) = l)
	43
	44	let failing =
	45	Test.make ~name:"should_fail_sort_id" ~count:10 ~print:Print.(list int)
	46	Gen.(small_list small_int) (fun l -> l = List.sort compare l)
	47
	48	exception Error
	49
	50	let error =
	51	Test.make ~name:"should_error_raise_exn" ~count:10 ~print:Print.int
	52	Gen.int (fun _ -> raise Error)
	53
	54	let collect =
	55	Test.make ~name:"collect_results" ~count:100 ~long_factor:100
	56	~print:Print.int ~collect:string_of_int
	57	(Gen.int_bound 4) (fun _ -> true)
	58
	59	let stats =
	60	Test.make ~name:"with_stats" ~count:100 ~long_factor:100 ~print:Print.int
	61	~stats:[
	62	"mod4", (fun i->i mod 4);
	63	"num", (fun i->i);
	64	]
	65	(Gen.int_bound 120) (fun _ -> true)
	66
	67	let bad_assume_warn =
	68	Test.make ~name:"WARN_unlikely_precond" ~count:2_000 ~print:Print.int
	69	Gen.int
	70	(fun x ->
	71	QCheck.assume (x mod 100 = 1);
	72	true)
	73
	74	let bad_assume_fail =
	75	Test.make ~name:"FAIL_unlikely_precond" ~count:2_000
	76	~if_assumptions_fail:(`Fatal, 0.1) ~print:Print.int
	77	Gen.int
	78	(fun x ->
	79	QCheck.assume (x mod 100 = 1);
	80	true)
	81	end
	82
	83	(* positive tests of the various generators *)
	84	module Generator = struct
	85	open QCheck2
	86
	87	(* example from issue #23 *)
	88	let char_dist_issue_23 =
	89	Test.make ~name:"char never produces '\\255'" ~count:1_000_000
	90	~print:Print.char
	91	Gen.char (fun c -> c <> '\255')
	92
	93	let char_test =
	94	Test.make ~name:"char has right range'" ~count:1000 ~print:Print.char
	95	Gen.char (fun c -> '\000' <= c && c <= '\255')
	96
	97	let nat_test =
	98	Test.make ~name:"nat has right range" ~count:1000 ~print:Print.int
	99	Gen.nat (fun n -> 0 <= n && n < 10000)
	100
	101	let string_test =
	102	Test.make ~name:"string has right length and content" ~count:1000 ~print:Print.string
	103	Gen.string
	104	(fun s ->
	105	let len = String.length s in
	106	0 <= len && len < 10000
	107	&& String.to_seq s \|>
	108	Seq.fold_left (fun acc c -> acc && '\000' <= c && c <= '\255') true)
	109
	110	let list_test =
	111	Test.make ~name:"list has right length" ~count:1000
	112	~print:Print.(list unit)
	113	Gen.(list unit) (fun l -> let len = List.length l in 0 <= len && len < 10_000)
	114
	115	let list_repeat_test =
	116	Test.make ~name:"list_repeat has constant length" ~count:1000
	117	~print:Print.(pair int (list unit))
	118	Gen.(small_nat >>= fun i -> list_repeat i unit >>= fun l -> return (i,l))
	119	(fun (i,l) -> List.length l = i)
	120
	121	let array_repeat_test =
	122	Test.make ~name:"array_repeat has constant length" ~count:1000
	123	~print:Print.(pair int (array unit))
	124	Gen.(small_nat >>= fun i -> array_repeat i unit >>= fun l -> return (i,l))
	125	(fun (i,l) -> Array.length l = i)
	126
	127	let passing_tree_rev =
	128	Test.make ~count:1000
	129	~name:"tree_rev_is_involutive"
	130	IntTree.gen_tree
	131	(fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree)
	132	end
	133
	134	(* negative tests that exercise shrinking behaviour *)
	135	module Shrink = struct
	136	open QCheck2
	137
	138	let rec fac n = match n with
	139	\| 0 -> 1
	140	\| n -> n * fac (n - 1)
	141
	142	(* example from issue #59 *)
	143	let test_fac_issue59 =
	144	Test.make ~name:"test fac issue59"
	145	(Gen.make_primitive ~gen:(fun st -> Gen.generate1 ~rand:st (Gen.small_int_corners ())) ~shrink:(fun _ -> Seq.empty))
	146	(fun n -> try (fac n) mod n = 0
	147	with
	148	(\| Stack_overflow -> false)
	149	\| Division_by_zero -> (n=0))
	150
	151	let big_bound_issue59 =
	152	Test.make ~name:"big bound issue59" ~print:Print.int
	153	(Gen.small_int_corners()) (fun i -> i < 209609)
	154
	155	let long_shrink =
	156	let listgen = Gen.(list_size (int_range 1000 10000) int) in
	157	Test.make ~name:"long_shrink" ~print:Print.(pair (list int) (list int))
	158	(Gen.pair listgen listgen)
	159	(fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys))
	160
	161	let ints_arent_0_mod_3 =
	162	Test.make ~name:"ints arent 0 mod 3" ~count:1000 ~print:Print.int
	163	Gen.int (fun i -> i mod 3 <> 0)
	164
	165	let ints_are_0 =
	166	Test.make ~name:"ints are 0" ~count:1000 ~print:Print.int
	167	Gen.int (fun i -> Printf.printf "%i\n" i; i = 0)
	168
	169	(* test from issue #59 *)
	170	let ints_smaller_209609 =
	171	Test.make ~name:"ints < 209609" ~print:Print.int
	172	(Gen.small_int_corners()) (fun i -> i < 209609)
	173
	174	let nats_smaller_5001 =
	175	Test.make ~name:"nat < 5001" ~count:1000 ~print:Print.int
	176	Gen.nat (fun n -> n < 5001)
	177
	178	let char_is_never_abcdef =
	179	Test.make ~name:"char is never produces 'abcdef'" ~count:1000 ~print:Print.char
	180	Gen.char (fun c -> not (List.mem c ['a';'b';'c';'d';'e';'f']))
	181
	182	let strings_are_empty =
	183	Test.make ~name:"strings are empty" ~count:1000 ~print:Print.string
	184	Gen.string (fun s -> (Printf.printf "\"%s\"\n" (String.escaped s);) s = "")
	185
	186	let string_never_has_000_char =
	187	Test.make ~name:"string never has a \\000 char" ~count:1000 ~print:Print.string
	188	Gen.string
	189	(fun s -> String.to_seq s \|> Seq.fold_left (fun acc c -> acc && c <> '\000') true)
	190
	191	let string_never_has_255_char =
	192	Test.make ~name:"string never has a \\255 char" ~count:1000 ~print:Print.string
	193	Gen.string
	194	(fun s -> String.to_seq s \|> Seq.fold_left (fun acc c -> acc && c <> '\255') true)
	195
	196	(* tests from issue #64 *)
	197	let print_list xs = print_endline Print.(list int xs)
	198
	199	let lists_are_empty_issue_64 =
	200	Test.make ~name:"lists are empty" ~print:Print.(list int)
	201	Gen.(list small_int) (fun xs -> print_list xs; xs = [])
	202
	203	let list_shorter_10 =
	204	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)
	206
	207	let length_printer xs =
	208	Printf.sprintf "[...] list length: %i" (List.length xs)
	209
	210	let size_gen = Gen.(oneof [small_nat; int_bound 750_000])
	211
	212	let list_shorter_432 =
	213	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)
	216
	217	let list_shorter_4332 =
	218	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)
	221
	222	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))
	225	(fun xs -> try xs = xs @ xs
	226	with Stack_overflow -> false)
	227
	228	let list_unique_elems =
	229	Test.make ~name:"lists have unique elems" ~print:Print.(list int)
	230	Gen.(list small_int)
	231	(fun xs -> let ys = List.sort_uniq Int.compare xs in
	232	print_list xs; List.length xs = List.length ys)
	233
	234	let tree_contains_only_42 =
	235	Test.make ~name:"tree contains only 42" ~print:IntTree.print_tree
	236	IntTree.gen_tree
	237	(fun tree -> IntTree.contains_only_n tree 42)
	238	end
	239
	240	(* tests function generator and shrinker *)
	241	module Function = struct
	242	open QCheck2
	243
	244	let fail_pred_map_commute =
	245	Test.make ~name:"fail_pred_map_commute" ~count:100 ~long_factor:100
	246	~print:Print.(triple (list int) Fn.print Fn.print)
	247	Gen.(triple
	248	(small_list small_int)
	249	(fun1 ~print:Print.int Observable.int int)
	250	(fun1 ~print:Print.bool Observable.int bool))
	251	(fun (l,Fun (_,f),Fun (_,p)) ->
	252	List.filter p (List.map f l) = List.map f (List.filter p l))
	253
	254	let fail_pred_strings =
	255	Test.make ~name:"fail_pred_strings" ~count:100 ~print:Fn.print
	256	(fun1 Observable.string ~print:Print.bool Gen.bool)
	257	(fun (Fun (_,p)) -> not (p "some random string") \|\| p "some other string")
	258
	259	let int_gen = Gen.small_nat (* int *)
	260
	261	(* Another example (false) property *)
	262	let prop_foldleft_foldright =
	263	Test.make ~name:"fold_left fold_right" ~count:1000 ~long_factor:20
	264	~print:Print.(triple int (list int) Fn.print)
	265	Gen.(triple
	266	int_gen
	267	(list int_gen)
	268	(fun2 ~print:Print.int Observable.int Observable.int int_gen))
	269	(fun (z,xs,f) ->
	270	let l1 = List.fold_right (Fn.apply f) xs z in
	271	let l2 = List.fold_left (Fn.apply f) z xs in
	272	if l1=l2 then true
	273	else Test.fail_reportf "l=%s, fold_left=%s, fold_right=%s@."
	274	(Print.(list int) xs)
	275	(Print.int l1)
	276	(Print.int l2)
	277	)
	278
	279	(* Another example (false) property *)
	280	let prop_foldleft_foldright_uncurry =
	281	Test.make ~name:"fold_left fold_right uncurried" ~count:1000 ~long_factor:20
	282	~print:Print.(triple Fn.print int (list int))
	283	Gen.(triple
	284	(fun1 ~print:Print.int Observable.(pair int int) int_gen)
	285	int_gen
	286	(list int_gen))
	287	(fun (f,z,xs) ->
	288	List.fold_right (fun x y -> Fn.apply f (x,y)) xs z =
	289	List.fold_left (fun x y -> Fn.apply f (x,y)) z xs)
	290
	291	(* Same as the above (false) property, but generating+shrinking functions last *)
	292	let prop_foldleft_foldright_uncurry_funlast =
	293	Test.make ~name:"fold_left fold_right uncurried fun last" ~count:1000 ~long_factor:20
	294	~print:Print.(triple int (list int) Fn.print)
	295	Gen.(triple
	296	int_gen
	297	(list int_gen)
	298	(fun1 ~print:Print.int Observable.(pair int int) int_gen))
	299	(fun (z,xs,f) ->
	300	List.fold_right (fun x y -> Fn.apply f (x,y)) xs z =
	301	List.fold_left (fun x y -> Fn.apply f (x,y)) z xs)
	302
	303	(* test from issue #64 *)
	304	let fold_left_test =
	305	Test.make ~name:"fold_left test, fun first" ~print:Print.(quad Fn.print string (list int) (list int))
	306	Gen.(quad (* string -> int -> string *)
	307	(fun2 ~print:Print.string Observable.string Observable.int (small_string ~gen:char))
	308	(small_string ~gen:char)
	309	(list small_int)
	310	(list small_int))
	311	(fun (f,acc,is,js) ->
	312	let f = Fn.apply f in
	313	List.fold_left f acc (is @ js)
	314	= List.fold_left f (List.fold_left f acc is) is) (Typo)
	315	end
	316
	317	(* tests of (inner) find_example(_gen) behaviour *)
	318	module FindExample = struct
	319	open QCheck2
	320
	321	let find_ex =
	322	Test.make ~name:"find_example" ~print:Print.int
	323	Gen.(2--50)
	324	(fun n ->
	325	let st = Random.State.make [\| 0 \|] in
	326	let f m = n < m && m < 2 * n in
	327	try
	328	let m = find_example_gen ~rand:st ~count:100_000 ~f Gen.(0 -- 1000) in
	329	f m
	330	with No_example_found _ -> false)
	331
	332	let find_ex_uncaught_issue_99_1_fail =
	333	let rs = (find_example ~count:10 ~f:(fun _ -> false) Gen.int) in
	334	Test.make ~name:"FAIL_#99_1" rs (fun _ -> true)
	335
	336	let find_ex_uncaught_issue_99_2_succeed =
	337	Test.make ~name:"should_succeed_#99_2" ~count:10
	338	Gen.int (fun i -> i <= max_int)
	339	end
	340
	341	(* tests of statistics and histogram display *)
	342	module Stats = struct
	343	open QCheck2
	344
	345	let bool_dist =
	346	Test.make ~name:"bool dist" ~count:500_000 ~collect:Bool.to_string Gen.bool (fun _ -> true)
	347
	348	let char_dist =
	349	Test.make ~name:"char code dist" ~count:500_000 ~stats:[("char code", Char.code)] Gen.char (fun _ -> true)
	350
	351	let string_len_tests =
	352	let len = ("len",String.length) in
	353	[
	354	Test.make ~name:"string_size len dist" ~count:5_000 ~stats:[len] Gen.(string_size (int_range 5 10)) (fun _ -> true);
	355	Test.make ~name:"string len dist" ~count:5_000 ~stats:[len] Gen.string (fun _ -> true);
	356	Test.make ~name:"string_of len dist" ~count:5_000 ~stats:[len] Gen.(string_of (return 'a')) (fun _ -> true);
	357	Test.make ~name:"string_printable len dist" ~count:5_000 ~stats:[len] Gen.string_printable (fun _ -> true);
	358	Test.make ~name:"small_string len dist" ~count:5_000 ~stats:[len] Gen.(small_string ~gen:char)(ugh)(fun _ -> true);
	359	]
	360
	361	let list_len_tests =
	362	let len = ("len",List.length) in
	363	[ (* test from issue #30 *)
	364	Test.make ~name:"list len dist" ~count:5_000 ~stats:[len] Gen.(list int) (fun _ -> true);
	365	Test.make ~name:"small_list len dist" ~count:5_000 ~stats:[len] Gen.(small_list int) (fun _ -> true);
	366	Test.make ~name:"list_size len dist" ~count:5_000 ~stats:[len] Gen.(list_size (int_range 5 10) int) (fun _ -> true);
	367	Test.make ~name:"list_repeat len dist" ~count:5_000 ~stats:[len] Gen.(list_repeat 42 int) (fun _ -> true);
	368	]
	369
	370	let array_len_tests =
	371	let len = ("len",Array.length) in
	372	[
	373	Test.make ~name:"array len dist" ~count:5_000 ~stats:[len] Gen.(array int) (fun _ -> true);
	374	Test.make ~name:"small_array len dist" ~count:5_000 ~stats:[len] Gen.(small_array int) (fun _ -> true);
	375	Test.make ~name:"array_size len dist" ~count:5_000 ~stats:[len] Gen.(array_size (int_range 5 10) int) (fun _ -> true);
	376	Test.make ~name:"array_repeat len dist" ~count:5_000 ~stats:[len] Gen.(array_repeat 42 int) (fun _ -> true);
	377	]
	378
	379	let int_dist_tests =
	380	let dist = ("dist",fun x -> x) in
	381	[
	382	(* test from issue #40 *)
	383	Test.make ~name:"int_stats_neg" ~count:5000 ~stats:[dist] Gen.small_signed_int (fun _ -> true);
	384	(* distribution tests from PR #45 *)
	385	Test.make ~name:"small_signed_int dist" ~count:1000 ~stats:[dist] Gen.small_signed_int (fun _ -> true);
	386	Test.make ~name:"small_nat dist" ~count:1000 ~stats:[dist] Gen.small_nat (fun _ -> true);
	387	Test.make ~name:"nat dist" ~count:1000 ~stats:[dist] Gen.nat (fun _ -> true);
	388	Test.make ~name:"int_range (-43643) 435434 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-43643) 435434) (fun _ -> true);
	389	Test.make ~name:"int_range (-40000) 40000 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-40000) 40000) (fun _ -> true);
	390	Test.make ~name:"int_range (-4) 4 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-4) 4) (fun _ -> true);
	391	Test.make ~name:"int_range (-4) 17 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-4) 17) (fun _ -> true);
	392	Test.make ~name:"int dist" ~count:100000 ~stats:[dist] Gen.int (fun _ -> true);
	393	Test.make ~name:"oneof int dist" ~count:1000 ~stats:[dist] (Gen.oneofl[min_int;-1;0;1;max_int]) (fun _ -> true);
	394	]
	395
	396	let int_dist_empty_bucket =
	397	Test.make ~name:"int_dist_empty_bucket" ~count:1_000 ~stats:[("dist",fun x -> x)]
	398	Gen.(oneof [small_int_corners ();int]) (fun _ -> true)
	399
	400	let tree_depth_test =
	401	let depth = ("depth", IntTree.depth) in
	402	Test.make ~name:"tree's depth" ~count:1000 ~stats:[depth] IntTree.gen_tree (fun _ -> true)
	403	end
	404
	405	(* Calling runners *)
	406
	407	let () = QCheck_base_runner.set_seed 1234
	408	let _ =
	409	QCheck_base_runner.run_tests ~colors:false ([
	410	Overall.passing;
	411	Overall.failing;
	412	Overall.error;
	413	Overall.collect;
	414	Overall.stats;
	415	Overall.bad_assume_warn;
	416	Overall.bad_assume_fail;
	417	Generator.char_dist_issue_23;
	418	Generator.char_test;
	419	Generator.nat_test;
	420	Generator.string_test;
	421	Generator.list_test;
	422	Generator.list_repeat_test;
	423	Generator.array_repeat_test;
	424	Generator.passing_tree_rev;
	425	(Shrink.test_fac_issue59;)
	426	Shrink.big_bound_issue59;
	427	Shrink.long_shrink;
	428	Shrink.ints_arent_0_mod_3;
	429	Shrink.ints_are_0;
	430	Shrink.ints_smaller_209609;
	431	Shrink.nats_smaller_5001;
	432	Shrink.char_is_never_abcdef;
	433	Shrink.strings_are_empty;
	434	Shrink.string_never_has_000_char;
	435	Shrink.string_never_has_255_char;
	436	Shrink.lists_are_empty_issue_64;
	437	Shrink.list_shorter_10;
	438	Shrink.list_shorter_432;
	439	Shrink.list_shorter_4332;
	440	Shrink.list_equal_dupl;
	441	Shrink.list_unique_elems;
	442	Shrink.tree_contains_only_42;
	443	Function.fail_pred_map_commute;
	444	Function.fail_pred_strings;
	445	Function.prop_foldleft_foldright;
	446	Function.prop_foldleft_foldright_uncurry;
	447	Function.prop_foldleft_foldright_uncurry_funlast;
	448	Function.fold_left_test;
	449	FindExample.find_ex;
	450	FindExample.find_ex_uncaught_issue_99_1_fail;
	451	FindExample.find_ex_uncaught_issue_99_2_succeed;
	452	Stats.bool_dist;
	453	Stats.char_dist;
	454	Stats.tree_depth_test ]
	455	@ Stats.string_len_tests
	456	@ Stats.list_len_tests
	457	@ Stats.array_len_tests
	458	@ Stats.int_dist_tests)
	459
	460	let () = QCheck_base_runner.set_seed 153870556
	461	let _ = QCheck_base_runner.run_tests ~colors:false [Stats.int_dist_empty_bucket]
	462

+446

-0

test/core/QCheck_expect_test.ml less more

	0	( QCheck(1) tests )
	1
	2	(** Module representing a tree data structure, used in tests *)
	3	module IntTree = struct
	4	type tree = Leaf of int \| Node of tree * tree
	5
	6	let leaf x = Leaf x
	7	let node x y = Node (x,y)
	8
	9	let rec depth = function
	10	\| Leaf _ -> 1
	11	\| Node (x, y) -> 1 + max (depth x) (depth y)
	12
	13	let rec print_tree = function
	14	\| Leaf x -> Printf.sprintf "Leaf %d" x
	15	\| Node (x, y) -> Printf.sprintf "Node (%s, %s)" (print_tree x) (print_tree y)
	16
	17	let gen_tree = QCheck.Gen.(sized @@ fix
	18	(fun self n -> match n with
	19	\| 0 -> map leaf nat
	20	\| n ->
	21	frequency
	22	[1, map leaf nat;
	23	2, map2 node (self (n/2)) (self (n/2))]
	24	))
	25
	26	let rec rev_tree = function
	27	\| Node (x, y) -> Node (rev_tree y, rev_tree x)
	28	\| Leaf x -> Leaf x
	29
	30	let passing_tree_rev =
	31	QCheck.Test.make ~count:1000
	32	~name:"tree_rev_is_involutive"
	33	QCheck.(make gen_tree)
	34	(fun tree -> rev_tree (rev_tree tree) = tree)
	35	end
	36
	37	(* tests of overall functionality *)
	38	module Overall = struct
	39	open QCheck
	40
	41	let passing =
	42	Test.make ~name:"list_rev_is_involutive" ~count:100 ~long_factor:100
	43	(list small_int) (fun l -> List.rev (List.rev l) = l)
	44
	45	let failing =
	46	Test.make ~name:"should_fail_sort_id" ~count:10
	47	(small_list small_int) (fun l -> l = List.sort compare l)
	48
	49	exception Error
	50
	51	let error =
	52	Test.make ~name:"should_error_raise_exn" ~count:10
	53	int (fun _ -> raise Error)
	54
	55	let collect =
	56	Test.make ~name:"collect_results" ~count:100 ~long_factor:100
	57	(make ~collect:string_of_int (Gen.int_bound 4))
	58	(fun _ -> true)
	59
	60	let stats =
	61	Test.make ~name:"with_stats" ~count:100 ~long_factor:100
	62	(make (Gen.int_bound 120)
	63	~stats:[
	64	"mod4", (fun i->i mod 4);
	65	"num", (fun i->i);
	66	])
	67	(fun _ -> true)
	68
	69	let bad_assume_warn =
	70	Test.make ~name:"WARN_unlikely_precond" ~count:2_000
	71	int
	72	(fun x ->
	73	QCheck.assume (x mod 100 = 1);
	74	true)
	75
	76	let bad_assume_fail =
	77	Test.make ~name:"FAIL_unlikely_precond" ~count:2_000
	78	~if_assumptions_fail:(`Fatal, 0.1)
	79	int
	80	(fun x ->
	81	QCheck.assume (x mod 100 = 1);
	82	true)
	83	end
	84
	85	(* positive tests of the various generators *)
	86	module Generator = struct
	87	open QCheck
	88
	89	(* example from issue #23 *)
	90	let char_dist_issue_23 =
	91	Test.make ~name:"char never produces '\\255'" ~count:1_000_000 char (fun c -> c <> '\255')
	92
	93	let char_test =
	94	Test.make ~name:"char has right range'" ~count:1000
	95	char (fun c -> '\000' <= c && c <= '\255')
	96
	97	let nat_test =
	98	Test.make ~name:"nat has right range" ~count:1000
	99	(make ~print:Print.int Gen.nat) (fun n -> 0 <= n && n < 10000)
	100
	101	let string_test =
	102	Test.make ~name:"string has right length and content" ~count:1000
	103	string
	104	(fun s ->
	105	let len = String.length s in
	106	0 <= len && len < 10000
	107	&& String.to_seq s \|>
	108	Seq.fold_left (fun acc c -> acc && '\000' <= c && c <= '\255') true)
	109
	110	let list_test =
	111	Test.make ~name:"list has right length" ~count:1000
	112	(list unit) (fun l -> let len = List.length l in 0 <= len && len < 10_000)
	113
	114	let list_repeat_test =
	115	let gen = Gen.(small_nat >>= fun i -> list_repeat i unit >>= fun l -> return (i,l)) in
	116	Test.make ~name:"list_repeat has constant length" ~count:1000
	117	(make ~print:Print.(pair int (list unit)) gen) (fun (i,l) -> List.length l = i)
	118
	119	let array_repeat_test =
	120	let gen = Gen.(small_nat >>= fun i -> array_repeat i unit >>= fun l -> return (i,l)) in
	121	Test.make ~name:"array_repeat has constant length" ~count:1000
	122	(make ~print:Print.(pair int (array unit)) gen) (fun (i,l) -> Array.length l = i)
	123
	124	let passing_tree_rev =
	125	QCheck.Test.make ~count:1000
	126	~name:"tree_rev_is_involutive"
	127	QCheck.(make IntTree.gen_tree)
	128	(fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree)
	129	end
	130
	131	(* negative tests that exercise shrinking behaviour *)
	132	module Shrink = struct
	133	open QCheck
	134
	135	let rec fac n = match n with
	136	\| 0 -> 1
	137	\| n -> n * fac (n - 1)
	138
	139	(* example from issue #59 *)
	140	let test_fac_issue59 =
	141	Test.make ~name:"test fac issue59"
	142	(set_shrink Shrink.nil (small_int_corners ()))
	143	(fun n -> try (fac n) mod n = 0
	144	with
	145	(\| Stack_overflow -> false)
	146	\| Division_by_zero -> (n=0))
	147
	148	let big_bound_issue59 =
	149	Test.make ~name:"big bound issue59"
	150	(small_int_corners()) (fun i -> i < 209609)
	151
	152	let long_shrink =
	153	let listgen = list_of_size (Gen.int_range 1000 10000) int in
	154	Test.make ~name:"long_shrink" (pair listgen listgen)
	155	(fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys))
	156
	157	let ints_arent_0_mod_3 =
	158	Test.make ~name:"ints arent 0 mod 3" ~count:1000
	159	int (fun i -> i mod 3 <> 0)
	160
	161	let ints_are_0 =
	162	Test.make ~name:"ints are 0" ~count:1000
	163	int (fun i -> Printf.printf "%i\n" i; i = 0)
	164
	165	(* test from issue #59 *)
	166	let ints_smaller_209609 =
	167	Test.make ~name:"ints < 209609"
	168	(small_int_corners()) (fun i -> i < 209609)
	169
	170	let nats_smaller_5001 =
	171	Test.make ~name:"nat < 5001" ~count:1000
	172	(make ~print:Print.int ~shrink:Shrink.int Gen.nat) (fun n -> n < 5001)
	173
	174	let char_is_never_abcdef =
	175	Test.make ~name:"char is never produces 'abcdef'" ~count:1000
	176	char (fun c -> not (List.mem c ['a';'b';'c';'d';'e';'f']))
	177
	178	let strings_are_empty =
	179	Test.make ~name:"strings are empty" ~count:1000
	180	string (fun s -> (Printf.printf "\"%s\"\n" (String.escaped s);) s = "")
	181
	182	let string_never_has_000_char =
	183	Test.make ~name:"string never has a \\000 char" ~count:1000
	184	string
	185	(fun s -> String.to_seq s \|> Seq.fold_left (fun acc c -> acc && c <> '\000') true)
	186
	187	let string_never_has_255_char =
	188	Test.make ~name:"string never has a \\255 char" ~count:1000
	189	string
	190	(fun s -> String.to_seq s \|> Seq.fold_left (fun acc c -> acc && c <> '\255') true)
	191
	192	let print_list xs = print_endline Print.(list int xs)
	193	(* test from issue #64 *)
	194	let lists_are_empty_issue_64 =
	195	Test.make ~name:"lists are empty"
	196	(list small_int) (fun xs -> print_list xs; xs = [])
	197
	198	let list_shorter_10 =
	199	Test.make ~name:"lists shorter than 10"
	200	(list small_int) (fun xs -> (print_list xs;) List.length xs < 10)
	201
	202	let length_printer xs =
	203	Printf.sprintf "[...] list length: %i" (List.length xs)
	204
	205	let size_gen = Gen.(oneof [small_nat; int_bound 750_000])
	206
	207	let list_shorter_432 =
	208	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)
	211
	212	let list_shorter_4332 =
	213	Test.make ~name:"lists shorter than 4332"
	214	(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)
	216
	217	let list_equal_dupl =
	218	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)))
	221	(fun xs -> try xs = xs @ xs
	222	with Stack_overflow -> false)
	223
	224	let list_unique_elems =
	225	Test.make ~name:"lists have unique elems"
	226	(list small_int)
	227	(fun xs -> let ys = List.sort_uniq Int.compare xs in
	228	print_list xs; List.length xs = List.length ys)
	229	end
	230
	231	(* tests function generator and shrinker *)
	232	module Function = struct
	233	open QCheck
	234
	235	let fail_pred_map_commute =
	236	Test.make ~name:"fail_pred_map_commute" ~count:100 ~long_factor:100
	237	(triple
	238	(small_list small_int)
	239	(fun1 Observable.int int)
	240	(fun1 Observable.int bool))
	241	(fun (l,Fun (_,f),Fun (_,p)) ->
	242	List.filter p (List.map f l) = List.map f (List.filter p l))
	243
	244	let fail_pred_strings =
	245	Test.make ~name:"fail_pred_strings" ~count:100
	246	(fun1 Observable.string bool)
	247	(fun (Fun (_,p)) -> not (p "some random string") \|\| p "some other string")
	248
	249	let int_gen = small_nat (* int *)
	250
	251	(* Another example (false) property *)
	252	let prop_foldleft_foldright =
	253	Test.make ~name:"fold_left fold_right" ~count:1000 ~long_factor:20
	254	(triple
	255	int_gen
	256	(list int_gen)
	257	(fun2 Observable.int Observable.int int_gen))
	258	(fun (z,xs,f) ->
	259	let l1 = List.fold_right (Fn.apply f) xs z in
	260	let l2 = List.fold_left (Fn.apply f) z xs in
	261	if l1=l2 then true
	262	else Test.fail_reportf "l=%s, fold_left=%s, fold_right=%s@."
	263	(Print.(list int) xs)
	264	(Print.int l1)
	265	(Print.int l2)
	266	)
	267
	268	(* Another example (false) property *)
	269	let prop_foldleft_foldright_uncurry =
	270	Test.make ~name:"fold_left fold_right uncurried" ~count:1000 ~long_factor:20
	271	(triple
	272	(fun1 Observable.(pair int int) int_gen)
	273	int_gen
	274	(list int_gen))
	275	(fun (f,z,xs) ->
	276	List.fold_right (fun x y -> Fn.apply f (x,y)) xs z =
	277	List.fold_left (fun x y -> Fn.apply f (x,y)) z xs)
	278
	279	(* Same as the above (false) property, but generating+shrinking functions last *)
	280	let prop_foldleft_foldright_uncurry_funlast =
	281	Test.make ~name:"fold_left fold_right uncurried fun last" ~count:1000 ~long_factor:20
	282	(triple
	283	int_gen
	284	(list int_gen)
	285	(fun1 Observable.(pair int int) int_gen))
	286	(fun (z,xs,f) ->
	287	List.fold_right (fun x y -> Fn.apply f (x,y)) xs z =
	288	List.fold_left (fun x y -> Fn.apply f (x,y)) z xs)
	289
	290	(* test from issue #64 *)
	291	let fold_left_test =
	292	Test.make ~name:"false fold, fun first"
	293	(quad (* string -> int -> string *)
	294	(fun2 Observable.string Observable.int small_string)
	295	small_string
	296	(list small_int)
	297	(list small_int))
	298	(fun (f,acc,is,js) ->
	299	let f = Fn.apply f in
	300	List.fold_left f acc (is @ js)
	301	= List.fold_left f (List.fold_left f acc is) is) (Typo)
	302	end
	303
	304	(* tests of (inner) find_example(_gen) behaviour *)
	305	module FindExample = struct
	306	open QCheck
	307
	308	let find_ex =
	309	Test.make ~name:"find_example" (2--50)
	310	(fun n ->
	311	let st = Random.State.make [\| 0 \|] in
	312	let f m = n < m && m < 2 * n in
	313	try
	314	let m = find_example_gen ~rand:st ~count:100_000 ~f Gen.(0 -- 1000) in
	315	f m
	316	with No_example_found _ -> false)
	317
	318	let find_ex_uncaught_issue_99_1_fail =
	319	let rs = make (find_example ~count:10 ~f:(fun _ -> false) Gen.int) in
	320	Test.make ~name:"FAIL_#99_1" rs (fun _ -> true)
	321
	322	let find_ex_uncaught_issue_99_2_succeed =
	323	Test.make ~name:"should_succeed_#99_2" ~count:10
	324	int (fun i -> i <= max_int)
	325	end
	326
	327	(* tests of statistics and histogram display *)
	328	module Stats = struct
	329	open QCheck
	330
	331	let bool_dist =
	332	Test.make ~name:"bool dist" ~count:500_000 (set_collect Bool.to_string bool) (fun _ -> true)
	333
	334	let char_dist =
	335	Test.make ~name:"char code dist" ~count:500_000 (add_stat ("char code", Char.code) char) (fun _ -> true)
	336
	337	let string_len_tests =
	338	let len = ("len",String.length) in
	339	[
	340	Test.make ~name:"string_size len dist" ~count:5_000 (add_stat len (string_of_size (Gen.int_range 5 10))) (fun _ -> true);
	341	Test.make ~name:"string len dist" ~count:5_000 (add_stat len string) (fun _ -> true);
	342	Test.make ~name:"string_of len dist" ~count:5_000 (add_stat len (string_gen (Gen.return 'a'))) (fun _ -> true);
	343	Test.make ~name:"printable_string len dist" ~count:5_000 (add_stat len printable_string) (fun _ -> true);
	344	Test.make ~name:"small_string len dist" ~count:5_000 (add_stat len small_string) (fun _ -> true);
	345	]
	346
	347	let list_len_tests =
	348	let len = ("len",List.length) in
	349	[ (* test from issue #30 *)
	350	Test.make ~name:"list len dist" ~count:5_000 (add_stat len (list int)) (fun _ -> true);
	351	Test.make ~name:"small_list len dist" ~count:5_000 (add_stat len (small_list int)) (fun _ -> true);
	352	Test.make ~name:"list_of_size len dist" ~count:5_000 (add_stat len (list_of_size (Gen.int_range 5 10) int)) (fun _ -> true);
	353	Test.make ~name:"list_repeat len dist" ~count:5_000 (add_stat len (make Gen.(list_repeat 42 int))) (fun _ -> true);
	354	]
	355
	356	let array_len_tests =
	357	let len = ("len",Array.length) in
	358	[
	359	Test.make ~name:"array len dist" ~count:5_000 (add_stat len (array int)) (fun _ -> true);
	360	Test.make ~name:"small_array len dist" ~count:5_000 (add_stat len (make Gen.(small_array int))) (fun _ -> true);
	361	Test.make ~name:"array_of_size len dist" ~count:5_000 (add_stat len (array_of_size (Gen.int_range 5 10) int)) (fun _ -> true);
	362	Test.make ~name:"array_repeat len dist" ~count:5_000 (add_stat len (make Gen.(array_repeat 42 int))) (fun _ -> true);
	363	]
	364
	365	let int_dist_tests =
	366	let dist = ("dist",fun x -> x) in
	367	[ (* test from issue #40 *)
	368	Test.make ~name:"int_stats_neg" ~count:5000 (add_stat dist small_signed_int) (fun _ -> true);
	369	(* distribution tests from PR #45 *)
	370	Test.make ~name:"small_signed_int dist" ~count:1000 (add_stat dist small_signed_int) (fun _ -> true);
	371	Test.make ~name:"small_nat dist" ~count:1000 (add_stat dist small_nat) (fun _ -> true);
	372	Test.make ~name:"nat dist" ~count:1000 (add_stat dist (make Gen.nat)) (fun _ -> true);
	373	Test.make ~name:"int_range (-43643) 435434 dist" ~count:1000 (add_stat dist (int_range (-43643) 435434)) (fun _ -> true);
	374	Test.make ~name:"int_range (-40000) 40000 dist" ~count:1000 (add_stat dist (int_range (-40000) 40000)) (fun _ -> true);
	375	Test.make ~name:"int_range (-4) 4 dist" ~count:1000 (add_stat dist (int_range (-4) 4)) (fun _ -> true);
	376	Test.make ~name:"int_range (-4) 17 dist" ~count:1000 (add_stat dist (int_range (-4) 17)) (fun _ -> true);
	377	Test.make ~name:"int dist" ~count:100000 (add_stat dist int) (fun _ -> true);
	378	Test.make ~name:"oneof int dist" ~count:1000 (add_stat dist (oneofl[min_int;-1;0;1;max_int])) (fun _ -> true);
	379	]
	380
	381	let int_dist_empty_bucket =
	382	Test.make ~name:"int_dist_empty_bucket" ~count:1_000
	383	(add_stat ("dist",fun x -> x) (oneof [small_int_corners ();int])) (fun _ -> true)
	384
	385	let tree_depth_test =
	386	let depth = ("depth", IntTree.depth) in
	387	Test.make ~name:"tree's depth" ~count:1000 (add_stat depth (make IntTree.gen_tree)) (fun _ -> true)
	388	end
	389
	390	(* Calling runners *)
	391
	392	let () = QCheck_base_runner.set_seed 1234
	393	let _ =
	394	QCheck_base_runner.run_tests ~colors:false ([
	395	Overall.passing;
	396	Overall.failing;
	397	Overall.error;
	398	Overall.collect;
	399	Overall.stats;
	400	Overall.bad_assume_warn;
	401	Overall.bad_assume_fail;
	402	Generator.char_dist_issue_23;
	403	Generator.char_test;
	404	Generator.nat_test;
	405	Generator.string_test;
	406	Generator.list_test;
	407	Generator.list_repeat_test;
	408	Generator.array_repeat_test;
	409	Generator.passing_tree_rev;
	410	(Shrink.test_fac_issue59;)
	411	Shrink.big_bound_issue59;
	412	Shrink.long_shrink;
	413	Shrink.ints_arent_0_mod_3;
	414	Shrink.ints_are_0;
	415	Shrink.ints_smaller_209609;
	416	Shrink.nats_smaller_5001;
	417	Shrink.char_is_never_abcdef;
	418	Shrink.strings_are_empty;
	419	Shrink.string_never_has_000_char;
	420	Shrink.string_never_has_255_char;
	421	Shrink.lists_are_empty_issue_64;
	422	Shrink.list_shorter_10;
	423	Shrink.list_shorter_432;
	424	Shrink.list_shorter_4332;
	425	Shrink.list_equal_dupl;
	426	Shrink.list_unique_elems;
	427	Function.fail_pred_map_commute;
	428	Function.fail_pred_strings;
	429	Function.prop_foldleft_foldright;
	430	Function.prop_foldleft_foldright_uncurry;
	431	Function.prop_foldleft_foldright_uncurry_funlast;
	432	Function.fold_left_test;
	433	FindExample.find_ex;
	434	FindExample.find_ex_uncaught_issue_99_1_fail;
	435	FindExample.find_ex_uncaught_issue_99_2_succeed;
	436	Stats.bool_dist;
	437	Stats.char_dist;
	438	Stats.tree_depth_test]
	439	@ Stats.string_len_tests
	440	@ Stats.list_len_tests
	441	@ Stats.array_len_tests
	442	@ Stats.int_dist_tests)
	443
	444	let () = QCheck_base_runner.set_seed 153870556
	445	let _ = QCheck_base_runner.run_tests ~colors:false [Stats.int_dist_empty_bucket]

+45

-0

test/core/dune less more

	0
	1	(test
	2	(name test)
	3	(modules test)
	4	(package qcheck-core)
	5	(libraries qcheck-core alcotest))
	6
	7	(executables
	8	(names QCheck_expect_test QCheck2_expect_test)
	9	(modules QCheck_expect_test QCheck2_expect_test)
	10	(libraries qcheck-core qcheck-core.runner))
	11
	12	;; rules for QCheck_expect_test
	13	(rule
	14	(targets qcheck_output.txt)
	15	(deps ./QCheck_expect_test.exe)
	16	(package qcheck-core)
	17	(enabled_if (= %{os_type} "Unix"))
	18	(action
	19	(with-stdout-to
	20	%{targets}
	21	(run ./QCheck_expect_test.exe --no-colors))))
	22
	23	(rule
	24	(alias runtest)
	25	(package qcheck-core)
	26	(enabled_if (= %{os_type} "Unix"))
	27	(action (diff qcheck_output.txt.expected qcheck_output.txt)))
	28
	29	;; rules for QCheck2_expect_test
	30	(rule
	31	(targets qcheck2_output.txt)
	32	(deps ./QCheck2_expect_test.exe)
	33	(package qcheck-core)
	34	(enabled_if (= %{os_type} "Unix"))
	35	(action
	36	(with-stdout-to
	37	%{targets}
	38	(run ./QCheck2_expect_test.exe --no-colors))))
	39
	40	(rule
	41	(alias runtest)
	42	(package qcheck-core)
	43	(enabled_if (= %{os_type} "Unix"))
	44	(action (diff qcheck2_output.txt.expected qcheck2_output.txt)))

+971

-0

test/core/qcheck2_output.txt.expected less more

	0	random seed: 1234
	1	2724675603984413065
	2	0
	3	1362337801992206532
	4	0
	5	681168900996103266
	6	0
	7	340584450498051633
	8	0
	9	170292225249025816
	10	0
	11	85146112624512908
	12	0
	13	42573056312256454
	14	0
	15	21286528156128227
	16	0
	17	10643264078064113
	18	0
	19	5321632039032056
	20	0
	21	2660816019516028
	22	0
	23	1330408009758014
	24	0
	25	665204004879007
	26	0
	27	332602002439503
	28	0
	29	166301001219751
	30	0
	31	83150500609875
	32	0
	33	41575250304937
	34	0
	35	20787625152468
	36	0
	37	10393812576234
	38	0
	39	5196906288117
	40	0
	41	2598453144058
	42	0
	43	1299226572029
	44	0
	45	649613286014
	46	0
	47	324806643007
	48	0
	49	162403321503
	50	0
	51	81201660751
	52	0
	53	40600830375
	54	0
	55	20300415187
	56	0
	57	10150207593
	58	0
	59	5075103796
	60	0
	61	2537551898
	62	0
	63	1268775949
	64	0
	65	634387974
	66	0
	67	317193987
	68	0
	69	158596993
	70	0
	71	79298496
	72	0
	73	39649248
	74	0
	75	19824624
	76	0
	77	9912312
	78	0
	79	4956156
	80	0
	81	2478078
	82	0
	83	1239039
	84	0
	85	619519
	86	0
	87	309759
	88	0
	89	154879
	90	0
	91	77439
	92	0
	93	38719
	94	0
	95	19359
	96	0
	97	9679
	98	0
	99	4839
	100	0
	101	2419
	102	0
	103	1209
	104	0
	105	604
	106	0
	107	302
	108	0
	109	151
	110	0
	111	75
	112	0
	113	37
	114	0
	115	18
	116	0
	117	9
	118	0
	119	4
	120	0
	121	2
	122	0
	123	1
	124	0
	125	[7; 1; 42; 1; 8; 5; 3; 9; 5; 38; 3; 3; 0; 1; 98; 1; 4; 13; 9; 2; 6; 9; 47; 6; 5; 8; 8; 6; 0; 9; 7; 2; 8; 6; 62; 6; 4; 31; 19; 1; 41; 60; 6; 5; 8; 1; 1; 4; 7; 7; 0; 5; 5; 71; 14; 26; 47; 5; 1; 6; 34; 9; 4; 2; 37; 3; 8; 4; 31; 6; 2; 1; 0; 7; 5; 1; 0; 15; 6; 1; 8; 13; 0; 6; 2; 4; 2; 6; 6; 1; 4; 1; 9; 79; 0; 87; 6; 8; 8; 62; 1; 4; 62; 6; 31; 1; 5; 6; 5; 9; 3; 3; 1; 79; 4; 3; 2; 67; 5; 7; 12; 70; 8; 8; 6; 1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	126	[]
	127	[9; 61; 8; 4; 69; 2; 0; 72; 4; 41; 3; 8; 75; 83; 7; 7; 3; 9; 5; 8; 4; 1; 0; 2; 1; 4; 7; 6; 2; 1; 4; 86; 3; 79; 7; 86; 52; 39; 19; 0; 4; 7; 7; 7; 0; 4; 8; 8; 0; 5; 13; 1; 5; 0; 7; 12; 64; 34; 1; 1; 85; 8; 2; 9; 76; 0; 2; 5; 76; 69; 8; 8; 0; 1; 2; 2; 4; 60; 29; 5; 9; 4; 0; 8; 3; 3; 5; 1; 35; 8; 2; 7; 23; 61; 56; 8; 1; 1; 78; 7; 5; 0; 30; 9; 3; 7; 28; 57; 98; 3; 52; 3; 82; 7; 5; 5; 6; 8; 1; 6; 8; 9; 8; 16; 0]
	128	[]
	129	[1; 9; 8; 28; 47; 8; 5; 6; 8; 9; 2; 5; 8; 30; 6; 8; 84; 0; 6; 7; 76; 7; 9; 1; 0; 5; 76; 95; 2; 2; 1; 45; 7; 8; 8; 1; 6; 37; 5; 6; 73; 8; 0; 85; 8; 0; 4; 5; 2; 0; 26; 59; 0; 5; 13; 4; 7; 3; 6; 8; 1; 3]
	130	[]
	131	[5; 0; 0; 4; 10; 2; 4; 9; 5; 73; 6; 1; 5; 5; 3; 10; 5; 31; 1; 4; 3; 8; 9; 13; 41; 20; 96; 5; 1; 2; 8]
	132	[]
	133	[9; 8; 73; 5; 8; 2; 1; 8; 2; 6; 4; 18; 5; 76; 3]
	134	[]
	135	[0; 6; 2; 8; 8; 1; 4]
	136	[]
	137	[5; 2; 3]
	138	[]
	139	[3]
	140	[]
	141	[0]
	142	[7; 1; 42; 1; 8; 5; 3; 9; 5; 38; 3; 3; 0; 1; 98; 1; 4; 13; 9; 2; 6; 9; 47; 6; 5; 8; 8; 6; 0; 9; 7; 2; 8; 6; 62; 6; 4; 31; 19; 1; 41; 60; 6; 5; 8; 1; 1; 4; 7; 7; 0; 5; 5; 71; 14; 26; 47; 5; 1; 6; 34; 9; 4; 2; 37; 3; 8; 4; 31; 6; 2; 1; 0; 7; 5; 1; 0; 15; 6; 1; 8; 13; 0; 6; 2; 4; 2; 6; 6; 1; 4; 1; 9; 79; 0; 87; 6; 8; 8; 62; 1; 4; 62; 6; 31; 1; 5; 6; 5; 9; 3; 3; 1; 79; 4; 3; 2; 67; 5; 7; 12; 70; 8; 8; 6; 1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	143	[]
	144	[9; 61; 8; 4; 69; 2; 0; 72; 4; 41; 3; 8; 75; 83; 7; 7; 3; 9; 5; 8; 4; 1; 0; 2; 1; 4; 7; 6; 2; 1; 4; 86; 3; 79; 7; 86; 52; 39; 19; 0; 4; 7; 7; 7; 0; 4; 8; 8; 0; 5; 13; 1; 5; 0; 7; 12; 64; 34; 1; 1; 85; 8; 2; 9; 76; 0; 2; 5; 76; 69; 8; 8; 0; 1; 2; 2; 4; 60; 29; 5; 9; 4; 0; 8; 3; 3; 5; 1; 35; 8; 2; 7; 23; 61; 56; 8; 1; 1; 78; 7; 5; 0; 30; 9; 3; 7; 28; 57; 98; 3; 52; 3; 82; 7; 5; 5; 6; 8; 1; 6; 8; 9; 8; 16; 0]
	145	[]
	146	[1; 9; 8; 28; 47; 8; 5; 6; 8; 9; 2; 5; 8; 30; 6; 8; 84; 0; 6; 7; 76; 7; 9; 1; 0; 5; 76; 95; 2; 2; 1; 45; 7; 8; 8; 1; 6; 37; 5; 6; 73; 8; 0; 85; 8; 0; 4; 5; 2; 0; 26; 59; 0; 5; 13; 4; 7; 3; 6; 8; 1; 3]
	147	[]
	148	[5; 0; 0; 4; 10; 2; 4; 9; 5; 73; 6; 1; 5; 5; 3; 10; 5; 31; 1; 4; 3; 8; 9; 13; 41; 20; 96; 5; 1; 2; 8]
	149	[]
	150	[9; 8; 73; 5; 8; 2; 1; 8; 2; 6; 4; 18; 5; 76; 3]
	151	[]
	152	[0; 6; 2; 8; 8; 1; 4]
	153	[]
	154	[5; 2; 3]
	155	[3; 2; 7; 3; 3]
	156	[]
	157	[5; 3]
	158	[5; 3; 2]
	159	[9; 87; 7; 0]
	160	[0; 2; 7; 3; 3]
	161	[0; 0; 7; 3; 3]
	162	[0; 0; 0; 3; 3]
	163	[0; 0; 0; 0; 3]
	164	[0; 0; 0; 0; 0]
	165
	166	--- Failure --------------------------------------------------------------------
	167
	168	Test should_fail_sort_id failed (9 shrink steps):
	169
	170	[1; 0]
	171
	172	=== Error ======================================================================
	173
	174	Test should_error_raise_exn errored on (1 shrink steps):
	175
	176	0
	177
	178	exception Dune__exe__QCheck2_expect_test.Overall.Error
	179
	180
	181	+++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	182
	183	Collect results for test collect_results:
	184
	185	4: 20 cases
	186	3: 25 cases
	187	2: 17 cases
	188	1: 18 cases
	189	0: 20 cases
	190
	191	+++ Stats for with_stats ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	192
	193	stats mod4:
	194	num: 100, avg: 1.68, stddev: 1.09, median 2, min 0, max 3
	195	0: ############################## 17
	196	1: ################################################### 29
	197	2: ######################################## 23
	198	3: ####################################################### 31
	199
	200	stats num:
	201	num: 100, avg: 66.84, stddev: 31.94, median 65, min 2, max 120
	202	2.. 7: ################## 3
	203	8.. 13: ################## 3
	204	14.. 19: 0
	205	20.. 25: ########################################## 7
	206	26.. 31: ######################## 4
	207	32.. 37: ######################## 4
	208	38.. 43: ################## 3
	209	44.. 49: ################################################ 8
	210	50.. 55: #################################### 6
	211	56.. 61: #################################### 6
	212	62.. 67: ####################################################### 9
	213	68.. 73: ########################################## 7
	214	74.. 79: ######################## 4
	215	80.. 85: ################## 3
	216	86.. 91: ############ 2
	217	92.. 97: ########################################## 7
	218	98..103: #################################### 6
	219	104..109: #################################### 6
	220	110..115: ####################################################### 9
	221	116..121: ################## 3
	222
	223	!!! Warning !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	224
	225	Warning for test WARN_unlikely_precond:
	226
	227	WARNING: only 0.5% tests (of 2000) passed precondition for "WARN_unlikely_precond"
	228
	229	NOTE: it is likely that the precondition is too strong, or that the generator is buggy.
	230
	231	--- Failure --------------------------------------------------------------------
	232
	233	Test FAIL_unlikely_precond failed:
	234
	235	ERROR: only 0.5% tests (of 2000) passed precondition for "FAIL_unlikely_precond"
	236
	237	NOTE: it is likely that the precondition is too strong, or that the generator is buggy.
	238
	239
	240	--- Failure --------------------------------------------------------------------
	241
	242	Test char never produces '\255' failed (0 shrink steps):
	243
	244	'\255'
	245
	246	--- Failure --------------------------------------------------------------------
	247
	248	Test big bound issue59 failed (0 shrink steps):
	249
	250	4611686018427387903
	251
	252	--- Failure --------------------------------------------------------------------
	253
	254	Test long_shrink failed (3039 shrink steps):
	255
	256	([0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0], [0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 1])
	257
	258	--- Failure --------------------------------------------------------------------
	259
	260	Test ints arent 0 mod 3 failed (2 shrink steps):
	261
	262	0
	263
	264	--- Failure --------------------------------------------------------------------
	265
	266	Test ints are 0 failed (61 shrink steps):
	267
	268	1
	269
	270	--- Failure --------------------------------------------------------------------
	271
	272	Test ints < 209609 failed (0 shrink steps):
	273
	274	4611686018427387903
	275
	276	--- Failure --------------------------------------------------------------------
	277
	278	Test nat < 5001 failed (7 shrink steps):
	279
	280	5001
	281
	282	--- Failure --------------------------------------------------------------------
	283
	284	Test char is never produces 'abcdef' failed (1 shrink steps):
	285
	286	'a'
	287
	288	--- Failure --------------------------------------------------------------------
	289
	290	Test strings are empty failed (8 shrink steps):
	291
	292	"a"
	293
	294	--- Failure --------------------------------------------------------------------
	295
	296	Test string never has a \000 char failed (22 shrink steps):
	297
	298	"aaaaaa\000aaaaaaaaaaaaaaaa"
	299
	300	--- Failure --------------------------------------------------------------------
	301
	302	Test string never has a \255 char failed (59 shrink steps):
	303
	304	"aaaaaaaaaaaaaaaaaaaaaaaaaa\255aaaaaaaaaaaaaaaaaaaaaaaa"
	305
	306	--- Failure --------------------------------------------------------------------
	307
	308	Test lists are empty failed (8 shrink steps):
	309
	310	[0]
	311
	312	--- Failure --------------------------------------------------------------------
	313
	314	Test lists shorter than 10 failed (16 shrink steps):
	315
	316	[0; 0; 0; 0; 0; 0; 0; 0; 0; 0]
	317
	318	--- Failure --------------------------------------------------------------------
	319
	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:
	341
	342	--- Failure --------------------------------------------------------------------
	343
	344	Test lists have unique elems failed (11 shrink steps):
	345
	346	[0; 0; 0; 0; 0]
	347
	348	--- Failure --------------------------------------------------------------------
	349
	350	Test tree contains only 42 failed (2 shrink steps):
	351
	352	Leaf 0
	353
	354	--- Failure --------------------------------------------------------------------
	355
	356	Test fail_pred_map_commute failed (16 shrink steps):
	357
	358	([2], {_ -> 0}, {1 -> false; 2 -> true; _ -> false})
	359
	360	--- Failure --------------------------------------------------------------------
	361
	362	Test fail_pred_strings failed (1 shrink steps):
	363
	364	{"some random string" -> true; _ -> false}
	365
	366	--- Failure --------------------------------------------------------------------
	367
	368	Test fold_left fold_right failed (22 shrink steps):
	369
	370	(0, [1], {(1, 0) -> 1; (8, 0) -> 0; (8, 8) -> 0; (8, 93) -> 0; (7, 7) -> 0; (24, 5) -> 0; (7, 0) -> 0; (0, 2) -> 0; (2, 4) -> 0; (9, 8) -> 0; (4, 9) -> 0; (1, 24) -> 0; (9, 5) -> 0; (80, 9) -> 0; (24, 0) -> 0; (1, 8) -> 0; (5, 7) -> 0; (0, 7) -> 0; (7, 8) -> 0; (0, 24) -> 0; _ -> 0})
	371
	372	+++ Messages ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	373
	374	Messages for test fold_left fold_right:
	375
	376	l=[1], fold_left=1, fold_right=0
	377
	378
	379	--- Failure --------------------------------------------------------------------
	380
	381	Test fold_left fold_right uncurried failed (325 shrink steps):
	382
	383	({(23, 62) -> 0; (9, 42) -> 0; (8, 61) -> 0; (8, 5) -> 0; (30, 5) -> 0; (9, 6) -> 0; (76, 6) -> 0; (19, 31) -> 0; (7, 62) -> 0; (0, 7) -> 1; (7, 1) -> 0; (78, 4) -> 0; (8, 2) -> 0; (78, 0) -> 0; (3, 47) -> 0; (4, 8) -> 0; (98, 9) -> 0; (1, 38) -> 0; (0, 26) -> 0; (1, 7) -> 0; (86, 3) -> 0; (9, 37) -> 0; (8, 1) -> 0; (79, 9) -> 0; (3, 5) -> 0; (56, 8) -> 0; (2, 5) -> 0; (8, 8) -> 0; (56, 67) -> 0; (5, 60) -> 0; (2, 31) -> 0; (61, 6) -> 0; (12, 5) -> 0; (76, 2) -> 0; (78, 8) -> 0; (1, 1) -> 0; (8, 9) -> 0; (7, 8) -> 0; (2, 9) -> 0; (29, 7) -> 0; (5, 8) -> 0; (28, 6) -> 0; (1, 4) -> 0; (9, 79) -> 0; (0, 1) -> 0; (1, 41) -> 0; (82, 98) -> 0; (6, 79) -> 0; (7, 6) -> 0; (4, 3) -> 0; (8, 12) -> 0; (5, 1) -> 0; (39, 1) -> 0; (3, 6) -> 0; (1, 2) -> 0; (76, 31) -> 0; (4, 1) -> 0; (6, 5) -> 0; (0, 8) -> 0; (8, 7) -> 0; (2, 6) -> 0; (52, 5) -> 0; (8, 47) -> 0; (5, 3) -> 0; (7, 9) -> 0; (13, 13) -> 0; (0, 87) -> 0; (82, 0) -> 0; (34, 8) -> 0; (1, 14) -> 0; (2, 71) -> 0; (52, 4) -> 0; (1, 3) -> 0; (85, 6) -> 0; (8, 19) -> 0; (3, 13) -> 0; (69, 1) -> 0; (5, 62) -> 0; (0, 15) -> 0; (34, 0) -> 0; (9, 4) -> 0; (0, 6) -> 0; (1, 8) -> 0; (86, 6) -> 0; (4, 5) -> 0; (3, 1) -> 0; (57, 2) -> 0; (3, 3) -> 0; (4, 0) -> 0; (30, 6) -> 0; (5, 34) -> 0; (0, 4) -> 0; (2, 3) -> 0; (5, 6) -> 0; (5, 7) -> 0; (5, 0) -> 0; (4, 4) -> 0; (7, 5) -> 0; (78, 2) -> 0; (9, 8) -> 0; (7, 70) -> 0; (35, 1) -> 0; (64, 7) -> 0; (60, 0) -> 0; (1, 9) -> 0; _ -> 0}, 0, [0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 7])
	384
	385	--- Failure --------------------------------------------------------------------
	386
	387	Test fold_left fold_right uncurried fun last failed (25 shrink steps):
	388
	389	(0, [1], {(0, 2) -> 0; (8, 80) -> 0; (93, 9) -> 0; (7, 24) -> 0; (8, 0) -> 0; (9, 7) -> 0; (0, 24) -> 0; (0, 7) -> 0; (7, 1) -> 0; (8, 9) -> 0; (24, 0) -> 0; (5, 8) -> 0; (1, 0) -> 1; (4, 8) -> 0; (7, 0) -> 0; (5, 7) -> 0; (8, 4) -> 0; (24, 5) -> 0; (0, 1) -> 0; (2, 8) -> 0; (9, 1) -> 0; (8, 8) -> 0; _ -> 0})
	390
	391	--- Failure --------------------------------------------------------------------
	392
	393	Test fold_left test, fun first failed (15 shrink steps):
	394
	395	({_ -> ""}, "a", [], [0])
	396
	397	--- Failure --------------------------------------------------------------------
	398
	399	Test FAIL_#99_1 failed:
	400
	401	ERROR: uncaught exception in generator for test FAIL_#99_1 after 100 steps:
	402	Exception: QCheck2.No_example_found("<example>")
	403	Backtrace:
	404
	405	+++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	406
	407	Collect results for test bool dist:
	408
	409	true: 250134 cases
	410	false: 249866 cases
	411
	412	+++ Stats for char code dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	413
	414	stats char code:
	415	num: 500000, avg: 127.42, stddev: 73.92, median 127, min 0, max 255
	416	0.. 12: ###################################################### 25509
	417	13.. 25: ###################################################### 25398
	418	26.. 38: ###################################################### 25293
	419	39.. 51: ###################################################### 25448
	420	52.. 64: ###################################################### 25392
	421	65.. 77: ####################################################### 25660
	422	78.. 90: ###################################################### 25462
	423	91..103: ###################################################### 25331
	424	104..116: ##################################################### 25129
	425	117..129: ###################################################### 25351
	426	130..142: ###################################################### 25492
	427	143..155: ###################################################### 25370
	428	156..168: ###################################################### 25658
	429	169..181: ###################################################### 25400
	430	182..194: ##################################################### 25167
	431	195..207: ###################################################### 25338
	432	208..220: ##################################################### 25181
	433	221..233: ##################################################### 25145
	434	234..246: ###################################################### 25567
	435	247..259: ##################################### 17709
	436
	437	+++ Stats for tree's depth ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	438
	439	stats depth:
	440	num: 1000, avg: 3.74, stddev: 3.28, median 3, min 1, max 15
	441	1: ####################################################### 377
	442	2: ################ 113
	443	3: ############ 87
	444	4: ################# 123
	445	5: ########### 81
	446	6: #### 33
	447	7: ##### 40
	448	8: ##### 39
	449	9: # 9
	450	10: ### 25
	451	11: ####### 49
	452	12: 4
	453	13: # 9
	454	14: # 7
	455	15: 4
	456
	457	+++ Stats for string_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	458
	459	stats len:
	460	num: 5000, avg: 7.49, stddev: 1.70, median 7, min 5, max 10
	461	5: ##################################################### 837
	462	6: ##################################################### 826
	463	7: ###################################################### 843
	464	8: ####################################################### 855
	465	9: #################################################### 813
	466	10: ##################################################### 826
	467
	468	+++ Stats for string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	469
	470	stats len:
	471	num: 5000, avg: 384.53, stddev: 1330.61, median 9, min 0, max 9969
	472	0.. 498: ####################################################### 4246
	473	499.. 997: ###### 518
	474	998..1496: 21
	475	1497..1995: 10
	476	1996..2494: 11
	477	2495..2993: 10
	478	2994..3492: 13
	479	3493..3991: 13
	480	3992..4490: 5
	481	4491..4989: 10
	482	4990..5488: 19
	483	5489..5987: 9
	484	5988..6486: 10
	485	6487..6985: 12
	486	6986..7484: 17
	487	7485..7983: 16
	488	7984..8482: 16
	489	8483..8981: 16
	490	8982..9480: 16
	491	9481..9979: 12
	492
	493	+++ Stats for string_of len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	494
	495	stats len:
	496	num: 5000, avg: 363.14, stddev: 1245.80, median 9, min 0, max 9986
	497	0.. 499: ####################################################### 4270
	498	500.. 999: ###### 493
	499	1000.. 1499: 16
	500	1500.. 1999: 11
	501	2000.. 2499: 15
	502	2500.. 2999: 17
	503	3000.. 3499: 11
	504	3500.. 3999: 19
	505	4000.. 4499: 14
	506	4500.. 4999: 10
	507	5000.. 5499: 16
	508	5500.. 5999: 11
	509	6000.. 6499: 15
	510	6500.. 6999: 13
	511	7000.. 7499: 12
	512	7500.. 7999: 16
	513	8000.. 8499: 11
	514	8500.. 8999: 4
	515	9000.. 9499: 13
	516	9500.. 9999: 13
	517
	518	+++ Stats for string_printable len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	519
	520	stats len:
	521	num: 5000, avg: 384.53, stddev: 1330.61, median 9, min 0, max 9969
	522	0.. 498: ####################################################### 4246
	523	499.. 997: ###### 518
	524	998..1496: 21
	525	1497..1995: 10
	526	1996..2494: 11
	527	2495..2993: 10
	528	2994..3492: 13
	529	3493..3991: 13
	530	3992..4490: 5
	531	4491..4989: 10
	532	4990..5488: 19
	533	5489..5987: 9
	534	5988..6486: 10
	535	6487..6985: 12
	536	6986..7484: 17
	537	7485..7983: 16
	538	7984..8482: 16
	539	8483..8981: 16
	540	8982..9480: 16
	541	9481..9979: 12
	542
	543	+++ Stats for small_string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	544
	545	stats len:
	546	num: 5000, avg: 15.57, stddev: 24.36, median 6, min 0, max 99
	547	0.. 4: #################################################### 1925
	548	5.. 9: ####################################################### 2005
	549	10.. 14: # 52
	550	15.. 19: # 50
	551	20.. 24: # 55
	552	25.. 29: # 56
	553	30.. 34: # 55
	554	35.. 39: # 49
	555	40.. 44: # 65
	556	45.. 49: # 65
	557	50.. 54: # 55
	558	55.. 59: # 68
	559	60.. 64: # 61
	560	65.. 69: # 65
	561	70.. 74: # 57
	562	75.. 79: # 66
	563	80.. 84: # 65
	564	85.. 89: # 64
	565	90.. 94: # 60
	566	95.. 99: # 62
	567
	568	+++ Stats for list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	569
	570	stats len:
	571	num: 5000, avg: 400.16, stddev: 1371.90, median 9, min 0, max 9987
	572	0.. 499: ####################################################### 4246
	573	500.. 999: ###### 502
	574	1000.. 1499: 13
	575	1500.. 1999: 10
	576	2000.. 2499: 14
	577	2500.. 2999: 14
	578	3000.. 3499: 20
	579	3500.. 3999: 7
	580	4000.. 4499: 13
	581	4500.. 4999: 16
	582	5000.. 5499: 12
	583	5500.. 5999: 15
	584	6000.. 6499: 15
	585	6500.. 6999: 13
	586	7000.. 7499: 16
	587	7500.. 7999: 12
	588	8000.. 8499: 11
	589	8500.. 8999: 16
	590	9000.. 9499: 15
	591	9500.. 9999: 20
	592
	593	+++ Stats for small_list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	594
	595	stats len:
	596	num: 5000, avg: 16.14, stddev: 24.86, median 6, min 0, max 99
	597	0.. 4: ###################################################### 1923
	598	5.. 9: ####################################################### 1936
	599	10.. 14: # 61
	600	15.. 19: # 59
	601	20.. 24: # 62
	602	25.. 29: # 70
	603	30.. 34: # 61
	604	35.. 39: # 64
	605	40.. 44: # 64
	606	45.. 49: # 56
	607	50.. 54: # 65
	608	55.. 59: # 55
	609	60.. 64: # 60
	610	65.. 69: # 62
	611	70.. 74: # 57
	612	75.. 79: # 69
	613	80.. 84: ## 73
	614	85.. 89: # 67
	615	90.. 94: # 62
	616	95.. 99: ## 74
	617
	618	+++ Stats for list_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	619
	620	stats len:
	621	num: 5000, avg: 7.49, stddev: 1.71, median 8, min 5, max 10
	622	5: ####################################################### 867
	623	6: ################################################### 813
	624	7: ################################################### 815
	625	8: #################################################### 833
	626	9: ###################################################### 857
	627	10: ################################################### 815
	628
	629	+++ Stats for list_repeat len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	630
	631	stats len:
	632	num: 5000, avg: 42.00, stddev: 0.00, median 42, min 42, max 42
	633	42: ####################################################### 5000
	634
	635	+++ Stats for array len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	636
	637	stats len:
	638	num: 5000, avg: 400.16, stddev: 1371.90, median 9, min 0, max 9987
	639	0.. 499: ####################################################### 4246
	640	500.. 999: ###### 502
	641	1000.. 1499: 13
	642	1500.. 1999: 10
	643	2000.. 2499: 14
	644	2500.. 2999: 14
	645	3000.. 3499: 20
	646	3500.. 3999: 7
	647	4000.. 4499: 13
	648	4500.. 4999: 16
	649	5000.. 5499: 12
	650	5500.. 5999: 15
	651	6000.. 6499: 15
	652	6500.. 6999: 13
	653	7000.. 7499: 16
	654	7500.. 7999: 12
	655	8000.. 8499: 11
	656	8500.. 8999: 16
	657	9000.. 9499: 15
	658	9500.. 9999: 20
	659
	660	+++ Stats for small_array len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	661
	662	stats len:
	663	num: 5000, avg: 16.14, stddev: 24.86, median 6, min 0, max 99
	664	0.. 4: ###################################################### 1923
	665	5.. 9: ####################################################### 1936
	666	10.. 14: # 61
	667	15.. 19: # 59
	668	20.. 24: # 62
	669	25.. 29: # 70
	670	30.. 34: # 61
	671	35.. 39: # 64
	672	40.. 44: # 64
	673	45.. 49: # 56
	674	50.. 54: # 65
	675	55.. 59: # 55
	676	60.. 64: # 60
	677	65.. 69: # 62
	678	70.. 74: # 57
	679	75.. 79: # 69
	680	80.. 84: ## 73
	681	85.. 89: # 67
	682	90.. 94: # 62
	683	95.. 99: ## 74
	684
	685	+++ Stats for array_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	686
	687	stats len:
	688	num: 5000, avg: 7.49, stddev: 1.71, median 8, min 5, max 10
	689	5: ####################################################### 867
	690	6: ################################################### 813
	691	7: ################################################### 815
	692	8: #################################################### 833
	693	9: ###################################################### 857
	694	10: ################################################### 815
	695
	696	+++ Stats for array_repeat len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	697
	698	stats len:
	699	num: 5000, avg: 42.00, stddev: 0.00, median 42, min 42, max 42
	700	42: ####################################################### 5000
	701
	702	+++ Stats for int_stats_neg ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	703
	704	stats dist:
	705	num: 5000, avg: 0.17, stddev: 29.68, median 0, min -99, max 99
	706	-99..-90: # 65
	707	-89..-80: # 63
	708	-79..-70: # 64
	709	-69..-60: # 58
	710	-59..-50: # 67
	711	-49..-40: # 72
	712	-39..-30: # 61
	713	-29..-20: # 61
	714	-19..-10: # 67
	715	-9.. 0: ####################################################### 2076
	716	1.. 10: ############################################## 1764
	717	11.. 20: # 66
	718	21.. 30: # 64
	719	31.. 40: # 64
	720	41.. 50: # 67
	721	51.. 60: # 60
	722	61.. 70: # 75
	723	71.. 80: # 60
	724	81.. 90: # 60
	725	91..100: # 66
	726
	727	+++ Stats for small_signed_int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	728
	729	stats dist:
	730	num: 1000, avg: 0.90, stddev: 28.23, median 0, min -99, max 99
	731	-99..-90: # 12
	732	-89..-80: # 11
	733	-79..-70: # 9
	734	-69..-60: 6
	735	-59..-50: # 11
	736	-49..-40: # 13
	737	-39..-30: # 9
	738	-29..-20: # 13
	739	-19..-10: 8
	740	-9.. 0: ####################################################### 453
	741	1.. 10: ######################################### 340
	742	11.. 20: # 15
	743	21.. 30: # 11
	744	31.. 40: # 12
	745	41.. 50: # 13
	746	51.. 60: # 13
	747	61.. 70: # 16
	748	71.. 80: # 9
	749	81.. 90: # 16
	750	91..100: # 10
	751
	752	+++ Stats for small_nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	753
	754	stats dist:
	755	num: 1000, avg: 15.11, stddev: 23.27, median 6, min 0, max 99
	756	0.. 4: #################################################### 377
	757	5.. 9: ####################################################### 392
	758	10.. 14: ## 20
	759	15.. 19: ## 15
	760	20.. 24: # 11
	761	25.. 29: ## 17
	762	30.. 34: ## 19
	763	35.. 39: ## 17
	764	40.. 44: # 10
	765	45.. 49: # 9
	766	50.. 54: # 8
	767	55.. 59: # 9
	768	60.. 64: ## 15
	769	65.. 69: # 10
	770	70.. 74: # 13
	771	75.. 79: ## 19
	772	80.. 84: # 11
	773	85.. 89: # 13
	774	90.. 94: 5
	775	95.. 99: # 10
	776
	777	+++ Stats for nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	778
	779	stats dist:
	780	num: 1000, avg: 363.02, stddev: 1215.04, median 9, min 0, max 9476
	781	0.. 473: ####################################################### 847
	782	474.. 947: ###### 95
	783	948..1421: 14
	784	1422..1895: 3
	785	1896..2369: 0
	786	2370..2843: 3
	787	2844..3317: 2
	788	3318..3791: 3
	789	3792..4265: 2
	790	4266..4739: 4
	791	4740..5213: 3
	792	5214..5687: 4
	793	5688..6161: 3
	794	6162..6635: 4
	795	6636..7109: 1
	796	7110..7583: 4
	797	7584..8057: 2
	798	8058..8531: 1
	799	8532..9005: 1
	800	9006..9479: 4
	801
	802	+++ Stats for int_range (-43643) 435434 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	803
	804	stats dist:
	805	num: 1000, avg: 195335.64, stddev: 136803.99, median 195583, min -43624, max 435210
	806	-43624..-19683: ############################################ 52
	807	-19682.. 4259: ######################################## 47
	808	4260.. 28201: ############################## 36
	809	28202.. 52143: ############################################ 52
	810	52144.. 76085: ########################################## 50
	811	76086..100027: ####################################################### 64
	812	100028..123969: ############################################### 55
	813	123970..147911: ######################################## 47
	814	147912..171853: ############################################## 54
	815	171854..195795: #################################### 43
	816	195796..219737: ############################################## 54
	817	219738..243679: ########################################### 51
	818	243680..267621: ################################################ 57
	819	267622..291563: ########################################## 49
	820	291564..315505: #################################### 42
	821	315506..339447: ###################################### 45
	822	339448..363389: ################################################ 57
	823	363390..387331: ###################################### 45
	824	387332..411273: ########################################## 49
	825	411274..435215: ########################################### 51
	826
	827	+++ Stats for int_range (-40000) 40000 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	828
	829	stats dist:
	830	num: 1000, avg: -173.78, stddev: 23042.92, median 180, min -39859, max 39942
	831	-39859..-35869: ############################################# 56
	832	-35868..-31878: ################################### 43
	833	-31877..-27887: ################################################# 60
	834	-27886..-23896: ##################################### 46
	835	-23895..-19905: ######################################## 49
	836	-19904..-15914: #################################### 45
	837	-15913..-11923: ############################################ 54
	838	-11922.. -7932: ############################################### 58
	839	-7931.. -3941: ######################################### 51
	840	-3940.. 50: ############################ 35
	841	51.. 4041: ####################################### 48
	842	4042.. 8032: ########################################## 52
	843	8033.. 12023: ######################################### 51
	844	12024.. 16014: ########################################### 53
	845	16015.. 20005: ############################################ 54
	846	20006.. 23996: ################################## 42
	847	23997.. 27987: ####################################################### 67
	848	27988.. 31978: ################################ 40
	849	31979.. 35969: ######################################### 51
	850	35970.. 39960: #################################### 45
	851
	852	+++ Stats for int_range (-4) 4 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	853
	854	stats dist:
	855	num: 1000, avg: 0.02, stddev: 2.55, median 0, min -4, max 4
	856	-4: ############################################ 99
	857	-3: ##################################################### 118
	858	-2: ################################################## 111
	859	-1: ################################################## 113
	860	0: ################################################## 113
	861	1: ##################################################### 118
	862	2: ############################################# 102
	863	3: ####################################################### 122
	864	4: ############################################## 104
	865
	866	+++ Stats for int_range (-4) 17 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	867
	868	stats dist:
	869	num: 1000, avg: 6.67, stddev: 6.39, median 7, min -4, max 17
	870	-4..-3: ############################################# 90
	871	-2..-1: ############################################# 91
	872	0.. 1: ########################################## 84
	873	2.. 3: ############################################## 92
	874	4.. 5: ########################################### 87
	875	6.. 7: ########################################### 86
	876	8.. 9: ############################################ 89
	877	10..11: ########################################### 87
	878	12..13: ####################################################### 110
	879	14..15: ############################################# 91
	880	16..17: ############################################## 93
	881	18..19: 0
	882	20..21: 0
	883	22..23: 0
	884	24..25: 0
	885	26..27: 0
	886	28..29: 0
	887	30..31: 0
	888	32..33: 0
	889	34..35: 0
	890
	891	+++ Stats for int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	892
	893	stats dist:
	894	num: 100000, avg: 2541076923587387.50, stddev: 2660730801206827008.00, median 158655268318060, min -4611522359435274428, max 4611540922436307689
	895	-4611522359435274428..-4150369195341695293: ##################################################### 4976
	896	-4150369195341695292..-3689216031248116157: ##################################################### 4963
	897	-3689216031248116156..-3228062867154537021: ###################################################### 5038
	898	-3228062867154537020..-2766909703060957885: ##################################################### 4979
	899	-2766909703060957884..-2305756538967378749: ##################################################### 5001
	900	-2305756538967378748..-1844603374873799613: ##################################################### 4982
	901	-1844603374873799612..-1383450210780220477: ##################################################### 5025
	902	-1383450210780220476.. -922297046686641341: #################################################### 4901
	903	-922297046686641340.. -461143882593062205: ####################################################### 5126
	904	-461143882593062204.. 9281500516931: ##################################################### 5008
	905	9281500516932.. 461162445594096067: ###################################################### 5041
	906	461162445594096068.. 922315609687675203: ##################################################### 5001
	907	922315609687675204.. 1383468773781254339: ##################################################### 4986
	908	1383468773781254340.. 1844621937874833475: ##################################################### 4949
	909	1844621937874833476.. 2305775101968412611: ##################################################### 5025
	910	2305775101968412612.. 2766928266061991747: ##################################################### 5022
	911	2766928266061991748.. 3228081430155570883: ##################################################### 4958
	912	3228081430155570884.. 3689234594249150019: ##################################################### 4998
	913	3689234594249150020.. 4150387758342729155: ##################################################### 4982
	914	4150387758342729156.. 4611540922436308291: ###################################################### 5039
	915
	916	+++ Stats for oneof int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	917
	918	stats dist:
	919	num: 1000, avg: 4611686018427388.00, stddev: 2905870896563567616.00, median 0, min -4611686018427387904, max 4611686018427387903
	920	-4611686018427387904..-4150517416584649089: ################## 208
	921	-4150517416584649088..-3689348814741910273: 0
	922	-3689348814741910272..-3228180212899171457: 0
	923	-3228180212899171456..-2767011611056432641: 0
	924	-2767011611056432640..-2305843009213693825: 0
	925	-2305843009213693824..-1844674407370955009: 0
	926	-1844674407370955008..-1383505805528216193: 0
	927	-1383505805528216192.. -922337203685477377: 0
	928	-922337203685477376.. -461168601842738561: 0
	929	-461168601842738560.. 255: ####################################################### 603
	930	256.. 461168601842739071: 0
	931	461168601842739072.. 922337203685477887: 0
	932	922337203685477888.. 1383505805528216703: 0
	933	1383505805528216704.. 1844674407370955519: 0
	934	1844674407370955520.. 2305843009213694335: 0
	935	2305843009213694336.. 2767011611056433151: 0
	936	2767011611056433152.. 3228180212899171967: 0
	937	3228180212899171968.. 3689348814741910783: 0
	938	3689348814741910784.. 4150517416584649599: 0
	939	4150517416584649600.. 4611686018427387903: ################# 189
	940	================================================================================
	941	1 warning(s)
	942	failure (27 tests failed, 1 tests errored, ran 67 tests)
	943	random seed: 153870556
	944
	945	+++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	946
	947	stats dist:
	948	num: 1000, avg: -55083208105414400.00, stddev: 1847115855773139200.00, median 9, min -4590718933436425025, max 4611686018427387903
	949	-4590718933436425025..-4130598685843234370: ## 26
	950	-4130598685843234369..-3670478438250043714: # 13
	951	-3670478438250043713..-3210358190656853058: ### 37
	952	-3210358190656853057..-2750237943063662402: ### 30
	953	-2750237943063662401..-2290117695470471746: ## 27
	954	-2290117695470471745..-1829997447877281090: ## 24
	955	-1829997447877281089..-1369877200284090434: ## 27
	956	-1369877200284090433.. -909756952690899778: ## 27
	957	-909756952690899777.. -449636705097709122: ## 21
	958	-449636705097709121.. 10483542495481534: ####################################################### 531
	959	10483542495481535.. 470603790088672190: ## 21
	960	470603790088672191.. 930724037681862846: ## 27
	961	930724037681862847.. 1390844285275053502: ## 24
	962	1390844285275053503.. 1850964532868244158: ## 25
	963	1850964532868244159.. 2311084780461434814: ## 28
	964	2311084780461434815.. 2771205028054625470: ## 23
	965	2771205028054625471.. 3231325275647816126: ## 23
	966	3231325275647816127.. 3691445523241006782: ## 25
	967	3691445523241006783.. 4151565770834197438: # 17
	968	4151565770834197439.. 4611686018427387903: ## 24
	969	================================================================================
	970	success (ran 1 tests)

+894

-0

test/core/qcheck_output.txt.expected less more

	0	random seed: 1234
	1	2724675603984413065
	2	1362337801992206533
	3	681168900996103267
	4	340584450498051634
	5	170292225249025817
	6	85146112624512909
	7	42573056312256455
	8	21286528156128228
	9	10643264078064114
	10	5321632039032057
	11	2660816019516029
	12	1330408009758015
	13	665204004879008
	14	332602002439504
	15	166301001219752
	16	83150500609876
	17	41575250304938
	18	20787625152469
	19	10393812576235
	20	5196906288118
	21	2598453144059
	22	1299226572030
	23	649613286015
	24	324806643008
	25	162403321504
	26	81201660752
	27	40600830376
	28	20300415188
	29	10150207594
	30	5075103797
	31	2537551899
	32	1268775950
	33	634387975
	34	317193988
	35	158596994
	36	79298497
	37	39649249
	38	19824625
	39	9912313
	40	4956157
	41	2478079
	42	1239040
	43	619520
	44	309760
	45	154880
	46	77440
	47	38720
	48	19360
	49	9680
	50	4840
	51	2420
	52	1210
	53	605
	54	303
	55	152
	56	76
	57	38
	58	19
	59	10
	60	5
	61	3
	62	2
	63	1
	64	0
	65	[7; 1; 42; 1; 8; 5; 3; 9; 5; 38; 3; 3; 0; 1; 98; 1; 4; 13; 9; 2; 6; 9; 47; 6; 5; 8; 8; 6; 0; 9; 7; 2; 8; 6; 62; 6; 4; 31; 19; 1; 41; 60; 6; 5; 8; 1; 1; 4; 7; 7; 0; 5; 5; 71; 14; 26; 47; 5; 1; 6; 34; 9; 4; 2; 37; 3; 8; 4; 31; 6; 2; 1; 0; 7; 5; 1; 0; 15; 6; 1; 8; 13; 0; 6; 2; 4; 2; 6; 6; 1; 4; 1; 9; 79; 0; 87; 6; 8; 8; 62; 1; 4; 62; 6; 31; 1; 5; 6; 5; 9; 3; 3; 1; 79; 4; 3; 2; 67; 5; 7; 12; 70; 8; 8; 6; 1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	66	[1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	67	[36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	68	[8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	69	[4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	70	[5; 1; 2; 9; 74; 7; 7]
	71	[74; 7; 7]
	72	[7]
	73	[]
	74	[4]
	75	[]
	76	[2]
	77	[]
	78	[1]
	79	[]
	80	[0]
	81	[]
	82	[7; 1; 42; 1; 8; 5; 3; 9; 5; 38; 3; 3; 0; 1; 98; 1; 4; 13; 9; 2; 6; 9; 47; 6; 5; 8; 8; 6; 0; 9; 7; 2; 8; 6; 62; 6; 4; 31; 19; 1; 41; 60; 6; 5; 8; 1; 1; 4; 7; 7; 0; 5; 5; 71; 14; 26; 47; 5; 1; 6; 34; 9; 4; 2; 37; 3; 8; 4; 31; 6; 2; 1; 0; 7; 5; 1; 0; 15; 6; 1; 8; 13; 0; 6; 2; 4; 2; 6; 6; 1; 4; 1; 9; 79; 0; 87; 6; 8; 8; 62; 1; 4; 62; 6; 31; 1; 5; 6; 5; 9; 3; 3; 1; 79; 4; 3; 2; 67; 5; 7; 12; 70; 8; 8; 6; 1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	83	[1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	84	[36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	85	[8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	86	[4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
	87	[5; 1; 2; 9; 74; 7; 7]
	88	[74; 7; 7]
	89	[7]
	90	[74]
	91	[7; 7]
	92	[7]
	93	[7]
	94	[4; 7]
	95	[6; 7]
	96	[6; 7]
	97	[7; 4]
	98	[7; 6]
	99	[7; 6]
	100
	101	--- Failure --------------------------------------------------------------------
	102
	103	Test should_fail_sort_id failed (18 shrink steps):
	104
	105	[1; 0]
	106
	107	=== Error ======================================================================
	108
	109	Test should_error_raise_exn errored on (63 shrink steps):
	110
	111	0
	112
	113	exception Dune__exe__QCheck_expect_test.Overall.Error
	114
	115
	116	+++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	117
	118	Collect results for test collect_results:
	119
	120	4: 20 cases
	121	3: 25 cases
	122	2: 17 cases
	123	1: 18 cases
	124	0: 20 cases
	125
	126	+++ Stats for with_stats ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	127
	128	stats mod4:
	129	num: 100, avg: 1.68, stddev: 1.09, median 2, min 0, max 3
	130	0: ############################## 17
	131	1: ################################################### 29
	132	2: ######################################## 23
	133	3: ####################################################### 31
	134
	135	stats num:
	136	num: 100, avg: 66.84, stddev: 31.94, median 65, min 2, max 120
	137	2.. 7: ################## 3
	138	8.. 13: ################## 3
	139	14.. 19: 0
	140	20.. 25: ########################################## 7
	141	26.. 31: ######################## 4
	142	32.. 37: ######################## 4
	143	38.. 43: ################## 3
	144	44.. 49: ################################################ 8
	145	50.. 55: #################################### 6
	146	56.. 61: #################################### 6
	147	62.. 67: ####################################################### 9
	148	68.. 73: ########################################## 7
	149	74.. 79: ######################## 4
	150	80.. 85: ################## 3
	151	86.. 91: ############ 2
	152	92.. 97: ########################################## 7
	153	98..103: #################################### 6
	154	104..109: #################################### 6
	155	110..115: ####################################################### 9
	156	116..121: ################## 3
	157
	158	!!! Warning !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	159
	160	Warning for test WARN_unlikely_precond:
	161
	162	WARNING: only 0.5% tests (of 2000) passed precondition for "WARN_unlikely_precond"
	163
	164	NOTE: it is likely that the precondition is too strong, or that the generator is buggy.
	165
	166	--- Failure --------------------------------------------------------------------
	167
	168	Test FAIL_unlikely_precond failed:
	169
	170	ERROR: only 0.5% tests (of 2000) passed precondition for "FAIL_unlikely_precond"
	171
	172	NOTE: it is likely that the precondition is too strong, or that the generator is buggy.
	173
	174
	175	--- Failure --------------------------------------------------------------------
	176
	177	Test char never produces '\255' failed (0 shrink steps):
	178
	179	'\255'
	180
	181	--- Failure --------------------------------------------------------------------
	182
	183	Test big bound issue59 failed (52 shrink steps):
	184
	185	209609
	186
	187	--- Failure --------------------------------------------------------------------
	188
	189	Test long_shrink failed (149 shrink steps):
	190
	191	([0], [-1])
	192
	193	--- Failure --------------------------------------------------------------------
	194
	195	Test ints arent 0 mod 3 failed (84 shrink steps):
	196
	197	-21
	198
	199	--- Failure --------------------------------------------------------------------
	200
	201	Test ints are 0 failed (62 shrink steps):
	202
	203	1
	204
	205	--- Failure --------------------------------------------------------------------
	206
	207	Test ints < 209609 failed (52 shrink steps):
	208
	209	209609
	210
	211	--- Failure --------------------------------------------------------------------
	212
	213	Test nat < 5001 failed (6 shrink steps):
	214
	215	5001
	216
	217	--- Failure --------------------------------------------------------------------
	218
	219	Test char is never produces 'abcdef' failed (0 shrink steps):
	220
	221	'd'
	222
	223	--- Failure --------------------------------------------------------------------
	224
	225	Test strings are empty failed (249 shrink steps):
	226
	227	"\177"
	228
	229	--- Failure --------------------------------------------------------------------
	230
	231	Test string never has a \000 char failed (25 shrink steps):
	232
	233	"\000"
	234
	235	--- Failure --------------------------------------------------------------------
	236
	237	Test string never has a \255 char failed (249 shrink steps):
	238
	239	"\255"
	240
	241	--- Failure --------------------------------------------------------------------
	242
	243	Test lists are empty failed (11 shrink steps):
	244
	245	[0]
	246
	247	--- Failure --------------------------------------------------------------------
	248
	249	Test lists shorter than 10 failed (50 shrink steps):
	250
	251	[0; 0; 0; 0; 0; 0; 0; 0; 0; 0]
	252
	253	--- Failure --------------------------------------------------------------------
	254
	255	Test lists shorter than 432 failed (1696 shrink steps):
	256
	257	[...] list length: 432
	258
	259	--- Failure --------------------------------------------------------------------
	260
	261	Test lists shorter than 4332 failed (13 shrink steps):
	262
	263	[...] list length: 4332
	264
	265	--- Failure --------------------------------------------------------------------
	266
	267	Test lists equal to duplication failed (20 shrink steps):
	268
	269	[...] list length: 1
	270
	271	--- Failure --------------------------------------------------------------------
	272
	273	Test lists have unique elems failed (7 shrink steps):
	274
	275	[7; 7]
	276
	277	--- Failure --------------------------------------------------------------------
	278
	279	Test fail_pred_map_commute failed (127 shrink steps):
	280
	281	([3], {_ -> 0}, {3 -> false; _ -> true})
	282
	283	--- Failure --------------------------------------------------------------------
	284
	285	Test fail_pred_strings failed (1 shrink steps):
	286
	287	{some random string -> true; _ -> false}
	288
	289	--- Failure --------------------------------------------------------------------
	290
	291	Test fold_left fold_right failed (25 shrink steps):
	292
	293	(0, [1], {(1, 0) -> 1; _ -> 0})
	294
	295	+++ Messages ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	296
	297	Messages for test fold_left fold_right:
	298
	299	l=[1], fold_left=1, fold_right=0
	300
	301
	302	--- Failure --------------------------------------------------------------------
	303
	304	Test fold_left fold_right uncurried failed (111 shrink steps):
	305
	306	({(5, 7) -> 0; _ -> 7}, 0, [5; 0])
	307
	308	--- Failure --------------------------------------------------------------------
	309
	310	Test fold_left fold_right uncurried fun last failed (26 shrink steps):
	311
	312	(0, [1], {(0, 1) -> 1; _ -> 0})
	313
	314	--- Failure --------------------------------------------------------------------
	315
	316	Test false fold, fun first failed (40 shrink steps):
	317
	318	({_ -> ""}, "z", [], [0])
	319
	320	--- Failure --------------------------------------------------------------------
	321
	322	Test FAIL_#99_1 failed:
	323
	324	ERROR: uncaught exception in generator for test FAIL_#99_1 after 100 steps:
	325	Exception: QCheck.No_example_found("<example>")
	326	Backtrace:
	327
	328	+++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	329
	330	Collect results for test bool dist:
	331
	332	true: 250134 cases
	333	false: 249866 cases
	334
	335	+++ Stats for char code dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	336
	337	stats char code:
	338	num: 500000, avg: 127.42, stddev: 73.92, median 127, min 0, max 255
	339	0.. 12: ###################################################### 25509
	340	13.. 25: ###################################################### 25398
	341	26.. 38: ###################################################### 25293
	342	39.. 51: ###################################################### 25448
	343	52.. 64: ###################################################### 25392
	344	65.. 77: ####################################################### 25660
	345	78.. 90: ###################################################### 25462
	346	91..103: ###################################################### 25331
	347	104..116: ##################################################### 25129
	348	117..129: ###################################################### 25351
	349	130..142: ###################################################### 25492
	350	143..155: ###################################################### 25370
	351	156..168: ###################################################### 25658
	352	169..181: ###################################################### 25400
	353	182..194: ##################################################### 25167
	354	195..207: ###################################################### 25338
	355	208..220: ##################################################### 25181
	356	221..233: ##################################################### 25145
	357	234..246: ###################################################### 25567
	358	247..259: ##################################### 17709
	359
	360	+++ Stats for tree's depth ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	361
	362	stats depth:
	363	num: 1000, avg: 3.74, stddev: 3.28, median 3, min 1, max 15
	364	1: ####################################################### 377
	365	2: ################ 113
	366	3: ############ 87
	367	4: ################# 123
	368	5: ########### 81
	369	6: #### 33
	370	7: ##### 40
	371	8: ##### 39
	372	9: # 9
	373	10: ### 25
	374	11: ####### 49
	375	12: 4
	376	13: # 9
	377	14: # 7
	378	15: 4
	379
	380	+++ Stats for string_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	381
	382	stats len:
	383	num: 5000, avg: 7.49, stddev: 1.70, median 7, min 5, max 10
	384	5: ##################################################### 837
	385	6: ##################################################### 826
	386	7: ###################################################### 843
	387	8: ####################################################### 855
	388	9: #################################################### 813
	389	10: ##################################################### 826
	390
	391	+++ Stats for string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	392
	393	stats len:
	394	num: 5000, avg: 384.53, stddev: 1330.61, median 9, min 0, max 9969
	395	0.. 498: ####################################################### 4246
	396	499.. 997: ###### 518
	397	998..1496: 21
	398	1497..1995: 10
	399	1996..2494: 11
	400	2495..2993: 10
	401	2994..3492: 13
	402	3493..3991: 13
	403	3992..4490: 5
	404	4491..4989: 10
	405	4990..5488: 19
	406	5489..5987: 9
	407	5988..6486: 10
	408	6487..6985: 12
	409	6986..7484: 17
	410	7485..7983: 16
	411	7984..8482: 16
	412	8483..8981: 16
	413	8982..9480: 16
	414	9481..9979: 12
	415
	416	+++ Stats for string_of len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	417
	418	stats len:
	419	num: 5000, avg: 363.14, stddev: 1245.80, median 9, min 0, max 9986
	420	0.. 499: ####################################################### 4270
	421	500.. 999: ###### 493
	422	1000.. 1499: 16
	423	1500.. 1999: 11
	424	2000.. 2499: 15
	425	2500.. 2999: 17
	426	3000.. 3499: 11
	427	3500.. 3999: 19
	428	4000.. 4499: 14
	429	4500.. 4999: 10
	430	5000.. 5499: 16
	431	5500.. 5999: 11
	432	6000.. 6499: 15
	433	6500.. 6999: 13
	434	7000.. 7499: 12
	435	7500.. 7999: 16
	436	8000.. 8499: 11
	437	8500.. 8999: 4
	438	9000.. 9499: 13
	439	9500.. 9999: 13
	440
	441	+++ Stats for printable_string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	442
	443	stats len:
	444	num: 5000, avg: 384.53, stddev: 1330.61, median 9, min 0, max 9969
	445	0.. 498: ####################################################### 4246
	446	499.. 997: ###### 518
	447	998..1496: 21
	448	1497..1995: 10
	449	1996..2494: 11
	450	2495..2993: 10
	451	2994..3492: 13
	452	3493..3991: 13
	453	3992..4490: 5
	454	4491..4989: 10
	455	4990..5488: 19
	456	5489..5987: 9
	457	5988..6486: 10
	458	6487..6985: 12
	459	6986..7484: 17
	460	7485..7983: 16
	461	7984..8482: 16
	462	8483..8981: 16
	463	8982..9480: 16
	464	9481..9979: 12
	465
	466	+++ Stats for small_string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	467
	468	stats len:
	469	num: 5000, avg: 15.57, stddev: 24.36, median 6, min 0, max 99
	470	0.. 4: #################################################### 1925
	471	5.. 9: ####################################################### 2005
	472	10.. 14: # 52
	473	15.. 19: # 50
	474	20.. 24: # 55
	475	25.. 29: # 56
	476	30.. 34: # 55
	477	35.. 39: # 49
	478	40.. 44: # 65
	479	45.. 49: # 65
	480	50.. 54: # 55
	481	55.. 59: # 68
	482	60.. 64: # 61
	483	65.. 69: # 65
	484	70.. 74: # 57
	485	75.. 79: # 66
	486	80.. 84: # 65
	487	85.. 89: # 64
	488	90.. 94: # 60
	489	95.. 99: # 62
	490
	491	+++ Stats for list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	492
	493	stats len:
	494	num: 5000, avg: 400.16, stddev: 1371.90, median 9, min 0, max 9987
	495	0.. 499: ####################################################### 4246
	496	500.. 999: ###### 502
	497	1000.. 1499: 13
	498	1500.. 1999: 10
	499	2000.. 2499: 14
	500	2500.. 2999: 14
	501	3000.. 3499: 20
	502	3500.. 3999: 7
	503	4000.. 4499: 13
	504	4500.. 4999: 16
	505	5000.. 5499: 12
	506	5500.. 5999: 15
	507	6000.. 6499: 15
	508	6500.. 6999: 13
	509	7000.. 7499: 16
	510	7500.. 7999: 12
	511	8000.. 8499: 11
	512	8500.. 8999: 16
	513	9000.. 9499: 15
	514	9500.. 9999: 20
	515
	516	+++ Stats for small_list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	517
	518	stats len:
	519	num: 5000, avg: 16.14, stddev: 24.86, median 6, min 0, max 99
	520	0.. 4: ###################################################### 1923
	521	5.. 9: ####################################################### 1936
	522	10.. 14: # 61
	523	15.. 19: # 59
	524	20.. 24: # 62
	525	25.. 29: # 70
	526	30.. 34: # 61
	527	35.. 39: # 64
	528	40.. 44: # 64
	529	45.. 49: # 56
	530	50.. 54: # 65
	531	55.. 59: # 55
	532	60.. 64: # 60
	533	65.. 69: # 62
	534	70.. 74: # 57
	535	75.. 79: # 69
	536	80.. 84: ## 73
	537	85.. 89: # 67
	538	90.. 94: # 62
	539	95.. 99: ## 74
	540
	541	+++ Stats for list_of_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	542
	543	stats len:
	544	num: 5000, avg: 7.49, stddev: 1.71, median 8, min 5, max 10
	545	5: ####################################################### 867
	546	6: ################################################### 813
	547	7: ################################################### 815
	548	8: #################################################### 833
	549	9: ###################################################### 857
	550	10: ################################################### 815
	551
	552	+++ Stats for list_repeat len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	553
	554	stats len:
	555	num: 5000, avg: 42.00, stddev: 0.00, median 42, min 42, max 42
	556	42: ####################################################### 5000
	557
	558	+++ Stats for array len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	559
	560	stats len:
	561	num: 5000, avg: 400.16, stddev: 1371.90, median 9, min 0, max 9987
	562	0.. 499: ####################################################### 4246
	563	500.. 999: ###### 502
	564	1000.. 1499: 13
	565	1500.. 1999: 10
	566	2000.. 2499: 14
	567	2500.. 2999: 14
	568	3000.. 3499: 20
	569	3500.. 3999: 7
	570	4000.. 4499: 13
	571	4500.. 4999: 16
	572	5000.. 5499: 12
	573	5500.. 5999: 15
	574	6000.. 6499: 15
	575	6500.. 6999: 13
	576	7000.. 7499: 16
	577	7500.. 7999: 12
	578	8000.. 8499: 11
	579	8500.. 8999: 16
	580	9000.. 9499: 15
	581	9500.. 9999: 20
	582
	583	+++ Stats for small_array len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	584
	585	stats len:
	586	num: 5000, avg: 16.14, stddev: 24.86, median 6, min 0, max 99
	587	0.. 4: ###################################################### 1923
	588	5.. 9: ####################################################### 1936
	589	10.. 14: # 61
	590	15.. 19: # 59
	591	20.. 24: # 62
	592	25.. 29: # 70
	593	30.. 34: # 61
	594	35.. 39: # 64
	595	40.. 44: # 64
	596	45.. 49: # 56
	597	50.. 54: # 65
	598	55.. 59: # 55
	599	60.. 64: # 60
	600	65.. 69: # 62
	601	70.. 74: # 57
	602	75.. 79: # 69
	603	80.. 84: ## 73
	604	85.. 89: # 67
	605	90.. 94: # 62
	606	95.. 99: ## 74
	607
	608	+++ Stats for array_of_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	609
	610	stats len:
	611	num: 5000, avg: 7.49, stddev: 1.71, median 8, min 5, max 10
	612	5: ####################################################### 867
	613	6: ################################################### 813
	614	7: ################################################### 815
	615	8: #################################################### 833
	616	9: ###################################################### 857
	617	10: ################################################### 815
	618
	619	+++ Stats for array_repeat len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	620
	621	stats len:
	622	num: 5000, avg: 42.00, stddev: 0.00, median 42, min 42, max 42
	623	42: ####################################################### 5000
	624
	625	+++ Stats for int_stats_neg ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	626
	627	stats dist:
	628	num: 5000, avg: 0.17, stddev: 29.68, median 0, min -99, max 99
	629	-99..-90: # 65
	630	-89..-80: # 63
	631	-79..-70: # 64
	632	-69..-60: # 58
	633	-59..-50: # 67
	634	-49..-40: # 72
	635	-39..-30: # 61
	636	-29..-20: # 61
	637	-19..-10: # 67
	638	-9.. 0: ####################################################### 2076
	639	1.. 10: ############################################## 1764
	640	11.. 20: # 66
	641	21.. 30: # 64
	642	31.. 40: # 64
	643	41.. 50: # 67
	644	51.. 60: # 60
	645	61.. 70: # 75
	646	71.. 80: # 60
	647	81.. 90: # 60
	648	91..100: # 66
	649
	650	+++ Stats for small_signed_int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	651
	652	stats dist:
	653	num: 1000, avg: 0.90, stddev: 28.23, median 0, min -99, max 99
	654	-99..-90: # 12
	655	-89..-80: # 11
	656	-79..-70: # 9
	657	-69..-60: 6
	658	-59..-50: # 11
	659	-49..-40: # 13
	660	-39..-30: # 9
	661	-29..-20: # 13
	662	-19..-10: 8
	663	-9.. 0: ####################################################### 453
	664	1.. 10: ######################################### 340
	665	11.. 20: # 15
	666	21.. 30: # 11
	667	31.. 40: # 12
	668	41.. 50: # 13
	669	51.. 60: # 13
	670	61.. 70: # 16
	671	71.. 80: # 9
	672	81.. 90: # 16
	673	91..100: # 10
	674
	675	+++ Stats for small_nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	676
	677	stats dist:
	678	num: 1000, avg: 15.11, stddev: 23.27, median 6, min 0, max 99
	679	0.. 4: #################################################### 377
	680	5.. 9: ####################################################### 392
	681	10.. 14: ## 20
	682	15.. 19: ## 15
	683	20.. 24: # 11
	684	25.. 29: ## 17
	685	30.. 34: ## 19
	686	35.. 39: ## 17
	687	40.. 44: # 10
	688	45.. 49: # 9
	689	50.. 54: # 8
	690	55.. 59: # 9
	691	60.. 64: ## 15
	692	65.. 69: # 10
	693	70.. 74: # 13
	694	75.. 79: ## 19
	695	80.. 84: # 11
	696	85.. 89: # 13
	697	90.. 94: 5
	698	95.. 99: # 10
	699
	700	+++ Stats for nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	701
	702	stats dist:
	703	num: 1000, avg: 363.02, stddev: 1215.04, median 9, min 0, max 9476
	704	0.. 473: ####################################################### 847
	705	474.. 947: ###### 95
	706	948..1421: 14
	707	1422..1895: 3
	708	1896..2369: 0
	709	2370..2843: 3
	710	2844..3317: 2
	711	3318..3791: 3
	712	3792..4265: 2
	713	4266..4739: 4
	714	4740..5213: 3
	715	5214..5687: 4
	716	5688..6161: 3
	717	6162..6635: 4
	718	6636..7109: 1
	719	7110..7583: 4
	720	7584..8057: 2
	721	8058..8531: 1
	722	8532..9005: 1
	723	9006..9479: 4
	724
	725	+++ Stats for int_range (-43643) 435434 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	726
	727	stats dist:
	728	num: 1000, avg: 195335.64, stddev: 136803.99, median 195583, min -43624, max 435210
	729	-43624..-19683: ############################################ 52
	730	-19682.. 4259: ######################################## 47
	731	4260.. 28201: ############################## 36
	732	28202.. 52143: ############################################ 52
	733	52144.. 76085: ########################################## 50
	734	76086..100027: ####################################################### 64
	735	100028..123969: ############################################### 55
	736	123970..147911: ######################################## 47
	737	147912..171853: ############################################## 54
	738	171854..195795: #################################### 43
	739	195796..219737: ############################################## 54
	740	219738..243679: ########################################### 51
	741	243680..267621: ################################################ 57
	742	267622..291563: ########################################## 49
	743	291564..315505: #################################### 42
	744	315506..339447: ###################################### 45
	745	339448..363389: ################################################ 57
	746	363390..387331: ###################################### 45
	747	387332..411273: ########################################## 49
	748	411274..435215: ########################################### 51
	749
	750	+++ Stats for int_range (-40000) 40000 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	751
	752	stats dist:
	753	num: 1000, avg: -173.78, stddev: 23042.92, median 180, min -39859, max 39942
	754	-39859..-35869: ############################################# 56
	755	-35868..-31878: ################################### 43
	756	-31877..-27887: ################################################# 60
	757	-27886..-23896: ##################################### 46
	758	-23895..-19905: ######################################## 49
	759	-19904..-15914: #################################### 45
	760	-15913..-11923: ############################################ 54
	761	-11922.. -7932: ############################################### 58
	762	-7931.. -3941: ######################################### 51
	763	-3940.. 50: ############################ 35
	764	51.. 4041: ####################################### 48
	765	4042.. 8032: ########################################## 52
	766	8033.. 12023: ######################################### 51
	767	12024.. 16014: ########################################### 53
	768	16015.. 20005: ############################################ 54
	769	20006.. 23996: ################################## 42
	770	23997.. 27987: ####################################################### 67
	771	27988.. 31978: ################################ 40
	772	31979.. 35969: ######################################### 51
	773	35970.. 39960: #################################### 45
	774
	775	+++ Stats for int_range (-4) 4 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	776
	777	stats dist:
	778	num: 1000, avg: 0.02, stddev: 2.55, median 0, min -4, max 4
	779	-4: ############################################ 99
	780	-3: ##################################################### 118
	781	-2: ################################################## 111
	782	-1: ################################################## 113
	783	0: ################################################## 113
	784	1: ##################################################### 118
	785	2: ############################################# 102
	786	3: ####################################################### 122
	787	4: ############################################## 104
	788
	789	+++ Stats for int_range (-4) 17 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	790
	791	stats dist:
	792	num: 1000, avg: 6.67, stddev: 6.39, median 7, min -4, max 17
	793	-4..-3: ############################################# 90
	794	-2..-1: ############################################# 91
	795	0.. 1: ########################################## 84
	796	2.. 3: ############################################## 92
	797	4.. 5: ########################################### 87
	798	6.. 7: ########################################### 86
	799	8.. 9: ############################################ 89
	800	10..11: ########################################### 87
	801	12..13: ####################################################### 110
	802	14..15: ############################################# 91
	803	16..17: ############################################## 93
	804	18..19: 0
	805	20..21: 0
	806	22..23: 0
	807	24..25: 0
	808	26..27: 0
	809	28..29: 0
	810	30..31: 0
	811	32..33: 0
	812	34..35: 0
	813
	814	+++ Stats for int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	815
	816	stats dist:
	817	num: 100000, avg: 2541076923587387.50, stddev: 2660730801206827008.00, median 158655268318060, min -4611522359435274428, max 4611540922436307689
	818	-4611522359435274428..-4150369195341695293: ##################################################### 4976
	819	-4150369195341695292..-3689216031248116157: ##################################################### 4963
	820	-3689216031248116156..-3228062867154537021: ###################################################### 5038
	821	-3228062867154537020..-2766909703060957885: ##################################################### 4979
	822	-2766909703060957884..-2305756538967378749: ##################################################### 5001
	823	-2305756538967378748..-1844603374873799613: ##################################################### 4982
	824	-1844603374873799612..-1383450210780220477: ##################################################### 5025
	825	-1383450210780220476.. -922297046686641341: #################################################### 4901
	826	-922297046686641340.. -461143882593062205: ####################################################### 5126
	827	-461143882593062204.. 9281500516931: ##################################################### 5008
	828	9281500516932.. 461162445594096067: ###################################################### 5041
	829	461162445594096068.. 922315609687675203: ##################################################### 5001
	830	922315609687675204.. 1383468773781254339: ##################################################### 4986
	831	1383468773781254340.. 1844621937874833475: ##################################################### 4949
	832	1844621937874833476.. 2305775101968412611: ##################################################### 5025
	833	2305775101968412612.. 2766928266061991747: ##################################################### 5022
	834	2766928266061991748.. 3228081430155570883: ##################################################### 4958
	835	3228081430155570884.. 3689234594249150019: ##################################################### 4998
	836	3689234594249150020.. 4150387758342729155: ##################################################### 4982
	837	4150387758342729156.. 4611540922436308291: ###################################################### 5039
	838
	839	+++ Stats for oneof int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	840
	841	stats dist:
	842	num: 1000, avg: 4611686018427388.00, stddev: 2905870896563567616.00, median 0, min -4611686018427387904, max 4611686018427387903
	843	-4611686018427387904..-4150517416584649089: ################## 208
	844	-4150517416584649088..-3689348814741910273: 0
	845	-3689348814741910272..-3228180212899171457: 0
	846	-3228180212899171456..-2767011611056432641: 0
	847	-2767011611056432640..-2305843009213693825: 0
	848	-2305843009213693824..-1844674407370955009: 0
	849	-1844674407370955008..-1383505805528216193: 0
	850	-1383505805528216192.. -922337203685477377: 0
	851	-922337203685477376.. -461168601842738561: 0
	852	-461168601842738560.. 255: ####################################################### 603
	853	256.. 461168601842739071: 0
	854	461168601842739072.. 922337203685477887: 0
	855	922337203685477888.. 1383505805528216703: 0
	856	1383505805528216704.. 1844674407370955519: 0
	857	1844674407370955520.. 2305843009213694335: 0
	858	2305843009213694336.. 2767011611056433151: 0
	859	2767011611056433152.. 3228180212899171967: 0
	860	3228180212899171968.. 3689348814741910783: 0
	861	3689348814741910784.. 4150517416584649599: 0
	862	4150517416584649600.. 4611686018427387903: ################# 189
	863	================================================================================
	864	1 warning(s)
	865	failure (26 tests failed, 1 tests errored, ran 66 tests)
	866	random seed: 153870556
	867
	868	+++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	869
	870	stats dist:
	871	num: 1000, avg: -55083208105414400.00, stddev: 1847115855773139200.00, median 9, min -4590718933436425025, max 4611686018427387903
	872	-4590718933436425025..-4130598685843234370: ## 26
	873	-4130598685843234369..-3670478438250043714: # 13
	874	-3670478438250043713..-3210358190656853058: ### 37
	875	-3210358190656853057..-2750237943063662402: ### 30
	876	-2750237943063662401..-2290117695470471746: ## 27
	877	-2290117695470471745..-1829997447877281090: ## 24
	878	-1829997447877281089..-1369877200284090434: ## 27
	879	-1369877200284090433.. -909756952690899778: ## 27
	880	-909756952690899777.. -449636705097709122: ## 21
	881	-449636705097709121.. 10483542495481534: ####################################################### 531
	882	10483542495481535.. 470603790088672190: ## 21
	883	470603790088672191.. 930724037681862846: ## 27
	884	930724037681862847.. 1390844285275053502: ## 24
	885	1390844285275053503.. 1850964532868244158: ## 25
	886	1850964532868244159.. 2311084780461434814: ## 28
	887	2311084780461434815.. 2771205028054625470: ## 23
	888	2771205028054625471.. 3231325275647816126: ## 23
	889	3231325275647816127.. 3691445523241006782: ## 25
	890	3691445523241006783.. 4151565770834197438: # 17
	891	4151565770834197439.. 4611686018427387903: ## 24
	892	================================================================================
	893	success (ran 1 tests)

+139

-0

test/core/test.ml less more

	0	open QCheck2
	1
	2	module Shrink = struct
	3	let test_int_towards () =
	4	Alcotest.(check' (list int))
	5	~msg:"int_towards 0 100"
	6	~actual:(Shrink.int_towards 0 100 \|> List.of_seq)
	7	~expected:[0; 50; 75; 88; 94; 97; 99];
	8	Alcotest.(check' (list int))
	9	~msg:"int_towards 500 1000"
	10	~actual:(Shrink.int_towards 500 1000 \|> List.of_seq)
	11	~expected:[500; 750; 875; 938; 969; 985; 993; 997; 999];
	12	Alcotest.(check' (list int))
	13	~msg:"int_towards (-50) (-26)"
	14	~actual:(Shrink.int_towards (-50) (-26) \|> List.of_seq)
	15	~expected:[-50; -38; -32; -29; -28; -27]
	16
	17	let test_int32_towards () =
	18	Alcotest.(check' (list int32))
	19	~msg:"int32_towards 0l 100l"
	20	~actual:(Shrink.int32_towards 0l 100l \|> List.of_seq)
	21	~expected:[0l; 50l; 75l; 88l; 94l; 97l; 99l];
	22	Alcotest.(check' (list int32))
	23	~msg:"int32_towards 500l 1000l"
	24	~actual:(Shrink.int32_towards 500l 1000l \|> List.of_seq)
	25	~expected:[500l; 750l; 875l; 938l; 969l; 985l; 993l; 997l; 999l];
	26	Alcotest.(check' (list int32))
	27	~msg:"int32_towards (-50l) (-26l)"
	28	~actual:(Shrink.int32_towards (-50l) (-26l) \|> List.of_seq)
	29	~expected:[-50l; -38l; -32l; -29l; -28l; -27l]
	30
	31	let test_int64_towards () =
	32	Alcotest.(check' (list int64))
	33	~msg:"int64_towards 0L 100L"
	34	~actual:(Shrink.int64_towards 0L 100L \|> List.of_seq)
	35	~expected:[0L; 50L; 75L; 88L; 94L; 97L; 99L];
	36	Alcotest.(check' (list int64))
	37	~msg:"int64_towards 500L 1000L"
	38	~actual:(Shrink.int64_towards 500L 1000L \|> List.of_seq)
	39	~expected:[500L; 750L; 875L; 938L; 969L; 985L; 993L; 997L; 999L];
	40	Alcotest.(check' (list int64))
	41	~msg:"int64_towards (-50L) (-26L)"
	42	~actual:(Shrink.int64_towards (-50L) (-26L) \|> List.of_seq)
	43	~expected:[-50L; -38L; -32L; -29L; -28L; -27L]
	44
	45	let test_float_towards () =
	46	Alcotest.(check' (list (float 0.0001)))
	47	~msg:"float_towards 0. 100."
	48	~actual:(Shrink.float_towards 0. 100. \|> List.of_seq)
	49	~expected:[0.; 50.; 75.; 87.5; 93.75; 96.875; 98.4375; 99.2188; 99.6094; 99.8047; 99.9023; 99.9512; 99.9756; 99.9878; 99.9939];
	50	Alcotest.(check' (list (float 0.001)))
	51	~msg:"float_towards 500. 1000."
	52	~actual:(Shrink.float_towards 500. 1000. \|> List.of_seq)
	53	~expected:[500.; 750.; 875.; 937.5; 968.75; 984.375; 992.188; 996.094; 998.047; 999.023; 999.512; 999.756; 999.878; 999.939; 999.969];
	54	Alcotest.(check' (list (float 0.0001)))
	55	~msg:"float_towards (-50.) (-26.)"
	56	~actual:(Shrink.float_towards (-50.) (-26.) \|> List.of_seq)
	57	~expected:[-50.; -38.; -32.; -29.; -27.5; -26.75; -26.375; -26.1875; -26.0938; -26.0469; -26.0234; -26.0117; -26.0059; -26.0029; -26.0015]
	58
	59	let tests = ("Shrink", Alcotest.[
	60	test_case "int_towards" `Quick test_int_towards;
	61	test_case "int32_towards" `Quick test_int32_towards;
	62	test_case "int64_towards" `Quick test_int64_towards;
	63	test_case "float_towards" `Quick test_float_towards
	64	])
	65	end
	66
	67	module Gen = struct
	68	let test_gen_opt ~ratio =
	69	let opt_int = Gen.opt ?ratio Gen.int in
	70	let nb = ref 0 in
	71	for _i = 0 to 1000 do
	72	Gen.generate1 opt_int \|> function None -> () \| Some _ -> nb := !nb + 1
	73	done;
	74	!nb
	75
	76	let test_gen_opt_default () =
	77	let nb = test_gen_opt ~ratio:None in
	78	let b = nb > 800 && nb < 900 in
	79	Alcotest.(check bool) "Gen.opt produces around 85% of Some" b true
	80
	81	let test_gen_opt_custom () =
	82	let nb = test_gen_opt ~ratio:(Some 0.5) in
	83	let b = nb > 450 && nb < 550 in
	84	Alcotest.(check bool) "Gen.opt produces around 50% of Some" b true
	85
	86	let tests =
	87	("Gen", Alcotest.[
	88	test_case "opt with default ratio" `Quick test_gen_opt_default;
	89	test_case "opt with custom ratio" `Quick test_gen_opt_custom;
	90	])
	91	end
	92
	93	module Test = struct
	94	let test_count_n ?count expected =
	95	let t = QCheck2.(Test.make ?count Gen.int (fun _ -> true)) in
	96	let msg = Printf.sprintf "QCheck2.Test.make ~count:%s \|> get_count = %d"
	97	(Option.fold ~none:"None" ~some:string_of_int count) expected
	98	in
	99	Alcotest.(check int) msg expected (QCheck2.Test.test_get_count t)
	100
	101	let test_count_10 () = test_count_n ~count:10 10
	102
	103	let test_count_0 () = test_count_n ~count:0 0
	104
	105	let test_count_default () = test_count_n 100
	106
	107	let test_count_env () =
	108	let () = Unix.putenv "QCHECK_COUNT" "5" in
	109	let t = QCheck2.(Test.make Gen.int (fun _ -> true)) in
	110	let actual = QCheck2.Test.test_get_count t in
	111	Alcotest.(check int) "default count is from QCHECK_COUNT" 5 actual
	112
	113	let tests =
	114	("Test", Alcotest.[
	115	test_case "make with custom count" `Quick test_count_10;
	116	test_case "make with custom count" `Quick test_count_0;
	117	test_case "make with default count" `Quick test_count_default;
	118	test_case "make with env count" `Quick test_count_env;
	119	])
	120	end
	121
	122	module String = struct
	123
	124	let test_string_shrinking () =
	125	let shrink_result = QCheck2.(find_example_gen ~f:(fun s -> s <> s ^ s) Gen.string) in
	126	Alcotest.(check string) "Shrinking a non-empty string shrinks to \"a\"" "a" shrink_result
	127
	128	let tests = ("String", Alcotest.[test_case "shrinking" `Quick test_string_shrinking])
	129	end
	130
	131	let () =
	132	Alcotest.run "QCheck"
	133	[
	134	Shrink.tests;
	135	Gen.tests;
	136	Test.tests;
	137	String.tests
	138	]