pax_global_header00006660000000000000000000000064141767712500014524gustar00rootroot0000000000000052 comment=7bc126593ecc06d71d076b4caca06ce7bc380d56 qcheck-0.18.1/000077500000000000000000000000001417677125000130515ustar00rootroot00000000000000qcheck-0.18.1/.github/000077500000000000000000000000001417677125000144115ustar00rootroot00000000000000qcheck-0.18.1/.github/workflows/000077500000000000000000000000001417677125000164465ustar00rootroot00000000000000qcheck-0.18.1/.github/workflows/gh-pages.yml000066400000000000000000000016511417677125000206670ustar00rootroot00000000000000name: github pages on: push: branches: - master # Set a branch name to trigger deployment jobs: deploy: runs-on: ubuntu-latest steps: - uses: actions/checkout@main - name: Cache opam id: cache-opam uses: actions/cache@v2 with: path: ~/.opam key: opam-ubuntu-latest-4.12.0 - uses: avsm/setup-ocaml@v1 with: ocaml-version: '4.12.0' - name: Pin run: opam pin -n . - name: Depext run: opam depext -yt qcheck-ounit qcheck-core qcheck - name: Deps run: opam install -d . --deps-only - name: Build run: opam exec -- dune build @doc - name: Deploy uses: peaceiris/actions-gh-pages@v3 with: github_token: ${{ secrets.GITHUB_TOKEN }} publish_dir: ./_build/default/_doc/_html/ destination_dir: dev enable_jekyll: true qcheck-0.18.1/.github/workflows/main.yml000066400000000000000000000013401417677125000201130ustar00rootroot00000000000000name: build on: push: branches: - master pull_request: branches: - master jobs: run: name: Build strategy: matrix: os: - macos-latest - ubuntu-latest - windows-latest ocaml-compiler: - 4.08.x - 4.12.x runs-on: ${{ matrix.os }} steps: - uses: actions/checkout@v2 - uses: ocaml/setup-ocaml@v2 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - run: opam pin -n . - run: opam depext -yt qcheck qcheck-core qcheck-ounit qcheck-alcotest - run: opam install -t . --deps-only - run: opam exec -- dune build - run: opam exec -- dune runtest if: ${{ matrix.os == 'ubuntu-latest'}} qcheck-0.18.1/.gitignore000066400000000000000000000001421417677125000150360ustar00rootroot00000000000000.*.swp .*.swo _build *.native .session TAGS *.docdir man *.install *.tar.gz *.byte .merlin _opam/ qcheck-0.18.1/.gitmodules000066400000000000000000000001241417677125000152230ustar00rootroot00000000000000[submodule "check-fun"] path = check-fun url = https://github.com/jmid/qcheck-fun qcheck-0.18.1/.header000066400000000000000000000002231417677125000142770ustar00rootroot00000000000000(* QCheck: Random testing for OCaml copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard all rights reserved. *) qcheck-0.18.1/.travis.yml000066400000000000000000000010671417677125000151660ustar00rootroot00000000000000language: c install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh script: bash -ex .travis-docker.sh services: - docker env: global: - PINS="qcheck:. qcheck-core:. qcheck-ounit:. qcheck-alcotest:." - DISTRO="ubuntu-16.04" - PACKAGE="qcheck" - DEPOPTS="ounit alcotest" matrix: # OCAML_VERSION is used by https://github.com/ocaml/ocaml-ci-scripts/blob/master/README-travis.md - OCAML_VERSION="4.08" - OCAML_VERSION="4.09" - OCAML_VERSION="4.10" - OCAML_VERSION="4.11" - OCAML_VERSION="4.12" qcheck-0.18.1/AUTHORS000066400000000000000000000003211417677125000141150ustar00rootroot00000000000000Simon Cruanes Rudi Grinberg Jacques-Pascal Deplaix Jan Midtgaard Valentin Chaboche qcheck-0.18.1/CHANGELOG.md000066400000000000000000000164011417677125000146640ustar00rootroot00000000000000# Changes ## 0.18.1 - fix `Gen.{nat,pos}_split{2,}` - fix stack overflow in #156 ## 0.18 This releases marks the addition of `QCheck2`, a module where generation and shrinking are better integrated. See [#109](https://github.com/c-cube/qcheck/pull/109) and [#116](https://github.com/c-cube/qcheck/pull/116). This API is still experimental. The normal `QCheck` module is still there and hasn't changed much. deprecations and breakges: - make `QCheck.Test_result.t` abstract and add missing getters - deprecate `QCheck.oneof` - deprecate `Gen.string_readable` in favor of `Gen.(string_of char)` or the new `Gen.string_printable` - require at least OCaml 4.08 other changes: - unsigned int32 and int64 - rename `small_int_corners` - add `?ratio` to `opt`, to modify random distribution of options ## 0.17 - new function: `Gen.delay` - install printer for an internal exception - fix(runner): use random state independently for each test - Fixes distribution and `min_int` issues - doc: point to @jmid 's website ## 0.16 - fix(runner): detect more failures in the runner - fix: catch exceptions in generators and log them. (#99) - test: add test for #99 - fix doc ## 0.15 - fix: in main runner, remove reset line in more places if `colors=false` - fix: invalid arg in `int_range` when a<0 - fix(runner): do not use ansi code for random seed if `colors=false` - feat: on `>=4.08`, provide let operators ## 0.14 - modify `int_range` to make it accept ranges bigger than `max_int`. - less newline-verbose stats - add `int{32,64}` shrinkers to arbitrary gens - add `int{32,int64}` shrinkers - move to ounit2 for `QCheck_ounit` ## 0.13 - make counter private - Add debug shrinking log - fix: small fix related to stdlib/pervasives - feat: add flatten combinators in `gen` ## 0.12 - fix singleton list shrinking - feat: add `Gen.char_range` and `Gen.(<$>)` (credit @spewspews) ## 0.11 - Add `QCheck.Gen.{string_of,string_readable}` - fix `int_bound` bound inclusiveness problem - change implementation of `int_bound` to generate values using `Random.State.int` for `bound < 2^30` - add weighted shuffled lists generator - add `float_range` to generate a floating-point number in the given range (inclusive) - add `float_bound_inclusive` and `float_bound_exclusive` to generate floating-point numbers between 0 and a given bound ## 0.10 - `Shrink`: decompose Shrink.list into Shrink.list_spine and Shrink.list_elems - `Gen.fix` has a more general and useful type - update README to include `Rely` section (qcheck now available for reason-native!) - Fix stat printing - speed-up list shrinker - Better int shrinking - core: modify proba distributions again, add `big_nat` - feat: add `small_array`, modify distributions - print number of warnings in runner's summary - refactor: modify type of results to make them more accurate - feat: warn/fail if too many tests passed only b/c precondition failed ## 0.9 - add `qcheck-ounit` sublibrary - use environment variables to configure `qcheck-alcotest` tests - alcotest backend for qcheck - make `qcheck.ounit` tests verbose by default - make `qcheck` is a compatibility library, depends on `qcheck-core` - split lib into `qcheck` and `qcheck.ounit` - add `TestResult.is_success` helper - give access to list of instances in test results - allow setting `time_between_msg` in runner - chore: remove submodule - chore: add travis support - doc: explanations about qcheck.ounit runners - doc: update readme ## 0.8 - migrate to jbuilder - fix warnings - add some useful functions - update oasis files (close #48) - update copyright header (closes #47) ## 0.7 - switch to BSD license, make it more explicit (close #43) - improve multi-line message printing in ounit (closes #46) - fix complexity of `add_stat` - allow negative entries in statistics (see #40) - add a way for tests to report messages to the user (see #39) - add `QCheck.Shrink.int_aggressive` and make default int shrinker faster - shrinker for `map_keep_input` - add `QCheck.set_gen`, missing for some reason - more compact verbose output (see #33) - better handling of dynamic progress line - Add colors to checkmarks in verbose mode - improve statistics display for runner - recover exception of shrunk input - print status line before the solving starts ## 0.6 - add `find_example` and `find_example_gen` to synthesize values from properties (see #31) - add `QCheck.gen` for accessing the random generator easily - colorful runners, with `--no-colors` to disable them - add more generator (for corner cases) - better generation of random functions (see #8), using `Observable` and an efficient internal representation using heterogeneous tuples, printing, and shrinking. deprecate old hacks. - add statistics gathering and display (see #30) - better printing of Tuple - improve `Shrink.{array,list}` (see #32) - Change asserts to raise `Invalid_arg` (following the doc), and update doc - Change `Gen.{int_bount,int_range}` to support up to 2^62 ## 0.5.3.1 - fix regression in runner output (print results of `collect`) - update the `@since` tags ## 0.5.3 - missing char in `Gen.char` (close #23) - add `test` and `doc` to opam - add `small_list` generator - add `~long_factor` to tests and runner, for long tests - add more examples in readme, better doc for runners - improved reporting when running qcheck tests - add `Test.get_count` on test cells ## 0.5.2 - Add cli option for backtraces in `QCheck_runner` - Add test case for raising exception - Better handling of backtraces - All tests now have a name - Add step function called on each instance in a test - make `small_int` a deprecated alias to `small_nat` - add `small_signed_int` - remove some warnings - use safe-string, and fix related bug - Add long tests options to `QCheck_runner` - Add `length` specification for `to_ounit2_test` - Added paragraph in README about long tests ## 0.5.1 - document exceptions - add `small_nat`, change `small_int` semantics (close #10) - add `QCheck.assume_fail` - add `QCheck.assume`; explain preconditions a bit (close #9) - Polish documentation - Added quad support uniformly ## 0.5 - merge back from `qtest`: big changes in API, shrinking, use `'a arbitrary` type that combines printer, generator, shrinker, etc. (see git log) - merlin file - reorganize sources, `_oasis`, `.merlin`, etc. ## 0.4 - bugfix in `fix_fuel` - if verbose enabled, print each test case - add `QCheck.run_main` - `QCheck_ounit.~::` - add `(>:::)` - add `qcheck_ounit ml{lib,dylib}` - trivial ounit integration - make `test_cell.name` optional - `Arbitrary.fix_fuel(_gen)`: add a recursive case - `Arbitrary.fix_fuel_gen`, similar to `fix_fuel` but threading a state bottom-up to make choices depend on the path - `Arbitrary.fail_fix` to fail in a fixpoint - helper cases for `Arbitrary.fix_fuel` ## 0.3 - get rid of submodule `generator` - `Arbitrary.fix_fuel`, to generate complex recursive structures - new combinators (infix map, applicative funs, shuffle) - remove generator/Generator, and a deprecation warning - output of printers of lists/arrays now parsable by ocaml toplevel ## 0.2 - integrate Gabriel Scherer's `Generator` into `QCheck` - add `|||` - add `Prop.raises` - print the faulty instance in case of error (if a printer is available) - some combinators for `QCheck.Arbitrary` - `QCheck.mk_test` takes more arguments ## 0.1 - oasis based build system - source files qcheck-0.18.1/LICENSE000066400000000000000000000024711417677125000140620ustar00rootroot00000000000000copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. qcheck-0.18.1/Makefile000066400000000000000000000021031417677125000145050ustar00rootroot00000000000000 all: build test build: @dune build @install test: @dune runtest --no-buffer --force clean: @dune clean doc: @dune build @doc example-test: @dune exec example/ounit/QCheck_test.exe example-ounit-test: @dune exec example/ounit/QCheck_ounit_test.exe example-runner: @dune exec example/QCheck_runner_test.exe -- -v --debug-shrink=log.tmp example-alcotest: @dune exec example/alcotest/QCheck_alcotest_test.exe VERSION=$(shell awk '/^version:/ {print $$2}' qcheck.opam) update_next_tag: @echo "update version to $(VERSION)..." sed -i "s/NEXT_VERSION/$(VERSION)/g" `find src -name '*.ml' -or -name '*.mli'` sed -i "s/NEXT_RELEASE/$(VERSION)/g" `find src -name '*.ml' -or -name '*.mli'` release: update_next_tag @echo "release version $(VERSION)..." git tag -f $(VERSION) ; git push origin :$(VERSION) ; git push origin $(VERSION) opam publish https://github.com/c-cube/qcheck/archive/$(VERSION).tar.gz @echo "review the release, then type 'opam publish submit qcheck.$(VERSION)/'" watch: @dune build @all -w .PHONY: benchs test examples update_next_tag watch release qcheck-0.18.1/README.adoc000066400000000000000000000270231417677125000146420ustar00rootroot00000000000000= QCheck :toc: macro :toclevels: 4 :source-highlighter: pygments QuickCheck inspired property-based testing for OCaml, and combinators to generate random values to run tests on. 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] The documentation can be found https://c-cube.github.io/qcheck/[here]. This library spent some time in https://github.com/vincent-hugot/iTeML[qtest], but is now standalone again! To construct advanced random generators, the following libraries might be of interest: - https://gitlab.inria.fr/fpottier/feat/[Feat] - @gasche's https://github.com/gasche/random-generator/[generator library] Jan Midtgaard (@jmid) has http://janmidtgaard.dk/quickcheck/index.html[a lecture] about property-based testing that relies on QCheck. toc::[] == Use See the documentation. I also wrote https://cedeela.fr/quickcheck-for-ocaml[a blog post] that explains how to use it and some design choices; however, be warned that the API changed in lots of small ways (in the right direction, I hope) so the code will not work any more. <> is an updated version of the blog post's examples. == Build $ make You can use opam: $ opam install qcheck == License The code is now released under the BSD license. [[examples]] == An Introduction to the Library First, let's see a few tests. Let's open a toplevel (e.g. utop) and type the following to load QCheck: [source,OCaml] ---- #require "qcheck";; ---- NOTE: alternatively, it is now possible to locally do: `dune utop src` to load `qcheck`. === List Reverse is Involutive We write a random test for checking that `List.rev (List.rev l) = l` for any list `l`: [source,OCaml] ---- let test = QCheck.Test.make ~count:1000 ~name:"list_rev_is_involutive" QCheck.(list small_nat) (fun l -> List.rev (List.rev l) = l);; (* we can check right now the property... *) QCheck.Test.check_exn test;; ---- In the above example, we applied the combinator `list` to the random generator `small_nat` (ints between 0 and 100), to create a new generator of lists of random integers. These builtin generators come with printers and shrinkers which are handy for outputting and minimizing a counterexample when a test fails. Consider the buggy property `List.rev l = l`: [source,OCaml] ---- let test = QCheck.Test.make ~count:1000 ~name:"my_buggy_test" QCheck.(list small_nat) (fun l -> List.rev l = l);; ---- When we run this test we are presented with a counterexample: [source,OCaml] ---- # QCheck.Test.check_exn test;; Exception: QCheck.Test.Test_fail ("my_buggy_test", ["[0; 1] (after 23 shrink steps)"]). ---- In this case QCheck found the minimal counterexample `[0;1]` to the property `List.rev l = l` and it spent 23 steps shrinking it. Now, let's run the buggy test with a decent runner that will print the results nicely (the exact output will change at each run, because of the random seed): ---- # QCheck_runner.run_tests [test];; --- Failure -------------------------------------------------------------------- Test my_buggy_test failed (10 shrink steps): [0; 1] ================================================================================ failure (1 tests failed, 0 tests errored, ran 1 tests) - : int = 1 ---- For an even nicer output `QCheck_runner.run_tests` also accepts an optional parameter `~verbose:true`. === Mirrors and Trees `QCheck` provides many useful combinators to write generators, especially for recursive types, algebraic types, and tuples. Let's see how to generate random trees: [source,OCaml] ---- type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let tree_gen = QCheck.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] ));; (* generate a few trees, just to check what they look like: *) QCheck.Gen.generate ~n:20 tree_gen;; let arbitrary_tree = let open QCheck.Iter in let rec print_tree = function | Leaf i -> "Leaf " ^ (string_of_int i) | Node (a,b) -> "Node (" ^ (print_tree a) ^ "," ^ (print_tree b) ^ ")" in let rec shrink_tree = function | Leaf i -> QCheck.Shrink.int i >|= leaf | Node (a,b) -> of_list [a;b] <+> (shrink_tree a >|= fun a' -> node a' b) <+> (shrink_tree b >|= fun b' -> node a b') in QCheck.make tree_gen ~print:print_tree ~shrink:shrink_tree;; ---- Here we write a generator of random trees, `tree_gen`, using the `fix` combinator. `fix` is *sized* (it is a function from `int` to a random generator; in particular for size 0 it returns only leaves). The `sized` combinator first generates a random size, and then applies its argument to this size. Other combinators include monadic abstraction, lifting functions, generation of lists, arrays, and a choice function. Then, we define `arbitrary_tree`, a `tree QCheck.arbitrary` value, which contains everything needed for testing on trees: - a random generator (mandatory), weighted with `frequency` to increase the chance of generating deep trees - a printer (optional), very useful for printing counterexamples - a *shrinker* (optional), very useful for trying to reduce big counterexamples to small counterexamples that are usually more easy to understand. The above shrinker strategy is to - reduce the integer leaves, and - substitute an internal `Node` with either of its subtrees or by splicing in a recursively shrunk subtree. A range of combinators in `QCheck.Shrink` and `QCheck.Iter` are available for building shrinking functions. We can write a failing test using this generator to see the printer and shrinker in action: [source,OCaml] ---- let rec mirror_tree (t:tree) : tree = match t with | Leaf _ -> t | Node (a,b) -> node (mirror_tree b) (mirror_tree a);; let test_buggy = QCheck.Test.make ~name:"buggy_mirror" ~count:200 arbitrary_tree (fun t -> t = mirror_tree t);; QCheck_runner.run_tests [test_buggy];; ---- This test fails with: [source,OCaml] ---- --- Failure -------------------------------------------------------------------- Test mirror_buggy failed (6 shrink steps): Node (Leaf 0,Leaf 1) ================================================================================ failure (1 tests failed, 0 tests errored, ran 1 tests) - : int = 1 ---- With the (new found) understanding that mirroring a tree changes its structure, we can formulate another property that involves sequentializing its elements in a traversal: [source,OCaml] ---- let tree_infix (t:tree): int list = let rec aux acc t = match t with | Leaf i -> i :: acc | Node (a,b) -> aux (aux acc b) a in aux [] t;; let test_mirror = QCheck.Test.make ~name:"mirror_tree" ~count:200 arbitrary_tree (fun t -> List.rev (tree_infix t) = tree_infix (mirror_tree t));; QCheck_runner.run_tests [test_mirror];; ---- === Preconditions The functions `QCheck.assume` and `QCheck.(==>)` can be used for tests with preconditions. For instance, `List.hd l :: List.tl l = l` only holds for non-empty lists. Without the precondition, the property is false and will even raise an exception in some cases. [source,OCaml] ---- let test_hd_tl = QCheck.(Test.make (list int) (fun l -> assume (l <> []); l = List.hd l :: List.tl l));; QCheck_runner.run_tests [test_hd_tl];; ---- === Long tests It is often useful to have two version of a testsuite: a short one that runs reasonably fast (so that it is effectively run each time a projet is built), and a long one that might be more exhaustive (but whose running time makes it impossible to run at each build). To that end, each test has a 'long' version. In the long version of a test, the number of tests to run is multiplied by the `~long_factor` argument of `QCheck.Test.make`. === Runners The module `QCheck_runner` defines several functions to run tests, including compatibility with `OUnit`. The easiest one is probably `run_tests`, but if you write your tests in a separate executable you can also use `run_tests_main` which parses command line arguments and exits with `0` in case of success, or an error number otherwise. === Integration within OUnit https://github.com/gildor478/ounit[OUnit] is a popular unit-testing framework for OCaml. QCheck provides a sub-library `qcheck-ounit` with some helpers, in `QCheck_ounit`, to convert its random tests into OUnit tests that can be part of a wider test-suite. [source,OCaml] ---- let passing = QCheck.Test.make ~count:1000 ~name:"list_rev_is_involutive" QCheck.(list small_nat) (fun l -> List.rev (List.rev l) = l);; let failing = QCheck.Test.make ~count:10 ~name:"fail_sort_id" QCheck.(list small_nat) (fun l -> l = List.sort compare l);; let _ = let open OUnit in run_test_tt_main ("tests" >::: List.map QCheck_ounit.to_ounit_test [passing; failing]) ---- NOTE: the package `qcheck` contains the module `QCheck_runner` which contains both custom runners and OUnit-based runners. === Integration within alcotest https://github.com/mirage/alcotest/[Alcotest] is a simple and colorful test framework for OCaml. QCheck now provides a sub-library `qcheck-alcotest` to easily integrate into an alcotest test suite: [source,OCaml] ---- let passing = QCheck.Test.make ~count:1000 ~name:"list_rev_is_involutive" QCheck.(list small_int) (fun l -> List.rev (List.rev l) = l);; let failing = QCheck.Test.make ~count:10 ~name:"fail_sort_id" QCheck.(list small_int) (fun l -> l = List.sort compare l);; let () = let suite = List.map QCheck_alcotest.to_alcotest [ passing; failing] in Alcotest.run "my test" [ "suite", suite ] ---- === Integration within Rely https://reason-native.com/docs/rely/[Rely] is a Jest-inspire native reason testing framework. @reason-native/qcheck-rely is available via NPM and provides matchers for the easy use of qCheck within Rely. [source, Reason] ---- open TestFramework; open QCheckRely; let {describe} = extendDescribe(QCheckRely.Matchers.matchers); describe("qcheck-rely", ({test}) => { test("passing test", ({expect}) => { let passing = QCheck.Test.make( ~count=1000, ~name="list_rev_is_involutive", QCheck.(list(small_int)), l => List.rev(List.rev(l)) == l ); expect.ext.qCheckTest(passing); (); }); test("failing test", ({expect}) => { let failing = QCheck.Test.make( ~count=10, ~name="fail_sort_id", QCheck.(list(small_int)), l => l == List.sort(compare, l) ); expect.ext.qCheckTest(failing); (); }); }); ---- === Deriver A ppx_deriver is provided to derive QCheck generators from a type declaration. ```ocaml type tree = Leaf of int | Node of tree * tree [@@deriving qcheck] ``` See the according https://github.com/c-cube/qcheck/tree/master/src/ppx_deriving_qcheck/[README] for more information and examples. === Compatibility notes Starting with 0.9, the library is split into several components: - `qcheck-core` depends only on unix and bytes. It contains the module `QCheck` and a `QCheck_base_runner` module with our custom runners. - `qcheck-ounit` provides an integration layer for `OUnit` - `qcheck` provides a compatibility API with older versions of qcheck, using both `qcheck-core` and `qcheck-ounit`. It provides `QCheck_runner` which is similar to older versions and contains both custom and Ounit-based runners. - `qcheck-alcotest` provides an integration layer with `alcotest` Normally, for contributors, `opam pin https://github.com/c-cube/qcheck` will pin all these packages. qcheck-0.18.1/dune-project000066400000000000000000000000361417677125000153720ustar00rootroot00000000000000(lang dune 2.2) (name qcheck) qcheck-0.18.1/example/000077500000000000000000000000001417677125000145045ustar00rootroot00000000000000qcheck-0.18.1/example/QCheck_runner_test.ml000066400000000000000000000132331417677125000206260ustar00rootroot00000000000000 let passing = QCheck.Test.make ~count:100 ~long_factor:100 ~name:"list_rev_is_involutive" QCheck.(list small_int) (fun l -> List.rev (List.rev l) = l);; let failing = QCheck.Test.make ~count:10 ~name:"should_fail_sort_id" QCheck.(small_list small_int) (fun l -> l = List.sort compare l);; exception Error let error = QCheck.Test.make ~count:10 ~name:"should_error_raise_exn" QCheck.int (fun _ -> raise Error) let collect = QCheck.Test.make ~count:100 ~long_factor:100 ~name:"collect_results" QCheck.(make ~collect:string_of_int (Gen.int_bound 4)) (fun _ -> true) let stats = QCheck.Test.make ~count:100 ~long_factor:100 ~name:"with_stats" QCheck.(make (Gen.int_bound 120) ~stats:[ "mod4", (fun i->i mod 4); "num", (fun i->i); ] ) (fun _ -> true) let fun1 = QCheck.Test.make ~count:100 ~long_factor:100 ~name:"FAIL_pred_map_commute" QCheck.(triple (small_list small_int) (fun1 Observable.int int) (fun1 Observable.int bool)) (fun (l,QCheck.Fun (_,f), QCheck.Fun (_,p)) -> List.filter p (List.map f l) = List.map f (List.filter p l)) let fun2 = QCheck.Test.make ~count:100 ~name:"FAIL_fun2_pred_strings" QCheck.(fun1 Observable.string bool) (fun (QCheck.Fun (_,p)) -> not (p "some random string") || p "some other string") let bad_assume_warn = QCheck.Test.make ~count:2_000 ~name:"WARN_unlikely_precond" QCheck.int (fun x -> QCheck.assume (x mod 100 = 1); true) let bad_assume_fail = QCheck.Test.make ~count:2_000 ~if_assumptions_fail:(`Fatal, 0.1) ~name:"FAIL_unlikely_precond" QCheck.int (fun x -> QCheck.assume (x mod 100 = 1); true) let int_gen = QCheck.small_nat (* int *) (* Another example (false) property *) let prop_foldleft_foldright = let open QCheck in Test.make ~name:"fold_left fold_right" ~count:1000 ~long_factor:20 (triple int_gen (list int_gen) (fun2 Observable.int Observable.int int_gen)) (fun (z,xs,f) -> let l1 = List.fold_right (Fn.apply f) xs z in let l2 = List.fold_left (Fn.apply f) z xs in if l1=l2 then true else QCheck.Test.fail_reportf "l=%s, fold_left=%s, fold_right=%s@." (QCheck.Print.(list int) xs) (QCheck.Print.int l1) (QCheck.Print.int l2) ) (* Another example (false) property *) let prop_foldleft_foldright_uncurry = let open QCheck in Test.make ~name:"fold_left fold_right uncurried" ~count:1000 ~long_factor:20 (triple (fun1 Observable.(pair int int) int_gen) int_gen (list int_gen)) (fun (f,z,xs) -> List.fold_right (fun x y -> Fn.apply f (x,y)) xs z = List.fold_left (fun x y -> Fn.apply f (x,y)) z xs) let long_shrink = let open QCheck in let listgen = list_of_size (Gen.int_range 1000 10000) int in Test.make ~name:"long_shrink" (pair listgen listgen) (fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys)) let find_ex = let open QCheck in Test.make ~name:"find_example" (2--50) (fun n -> let st = Random.State.make [| 0 |] in let f m = n < m && m < 2 * n in try let m = find_example_gen ~rand:st ~count:100_000 ~f Gen.(0 -- 1000) in f m with No_example_found _ -> false) let find_ex_uncaught_issue_99 : _ list = let open QCheck in let t1 = let rs = make (find_example ~count:10 ~f:(fun _ -> false) Gen.int) in Test.make ~name:"FAIL_#99_1" rs (fun _ -> true) in let t2 = Test.make ~name:"should_succeed_#99_2" ~count:10 int (fun i -> i <= max_int) in [t1;t2] (* test shrinking on integers *) let shrink_int = QCheck.Test.make ~count:1000 ~name:"mod3_should_fail" QCheck.int (fun i -> i mod 3 <> 0);; let stats_negs = QCheck.(Test.make ~count:5_000 ~name:"stats_neg" (add_stat ("dist",fun x -> x) small_signed_int)) (fun _ -> true) type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let gen_tree = QCheck.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] )) let rec rev_tree = function | Node (x, y) -> Node (rev_tree y, rev_tree x) | Leaf x -> Leaf x let passing_tree_rev = QCheck.Test.make ~count:1000 ~name:"tree_rev_is_involutive" QCheck.(make gen_tree) (fun tree -> rev_tree (rev_tree tree) = tree) let stats_tests = let open QCheck in [ Test.make ~name:"stat_display_test_1" ~count:1000 (add_stat ("dist",fun x -> x) small_signed_int) (fun _ -> true); Test.make ~name:"stat_display_test_2" ~count:1000 (add_stat ("dist",fun x -> x) small_nat) (fun _ -> true); Test.make ~name:"stat_display_test_3" ~count:1000 (add_stat ("dist",fun x -> x) (int_range (-43643) 435434)) (fun _ -> true); Test.make ~name:"stat_display_test_4" ~count:1000 (add_stat ("dist",fun x -> x) (int_range (-40000) 40000)) (fun _ -> true); Test.make ~name:"stat_display_test_5" ~count:1000 (add_stat ("dist",fun x -> x) (int_range (-4) 4)) (fun _ -> true); Test.make ~name:"stat_display_test_6" ~count:1000 (add_stat ("dist",fun x -> x) (int_range (-4) 17)) (fun _ -> true); Test.make ~name:"stat_display_test_7" ~count:100000 (add_stat ("dist",fun x -> x) int) (fun _ -> true); ] let () = QCheck_runner.run_tests_main ([ passing; failing; error; collect; stats; fun1; fun2; prop_foldleft_foldright; prop_foldleft_foldright_uncurry; long_shrink; find_ex; shrink_int; stats_negs; bad_assume_warn; bad_assume_fail; passing_tree_rev; ] @ find_ex_uncaught_issue_99 @ stats_tests) qcheck-0.18.1/example/alcotest/000077500000000000000000000000001417677125000163225ustar00rootroot00000000000000qcheck-0.18.1/example/alcotest/QCheck_alcotest_test.ml000066400000000000000000000025771417677125000227620ustar00rootroot00000000000000let passing = QCheck.Test.make ~count:1000 ~name:"list_rev_is_involutive" QCheck.(list small_int) (fun l -> List.rev (List.rev l) = l);; let failing = QCheck.Test.make ~count:10 ~name:"fail_sort_id" QCheck.(list small_int) (fun l -> l = List.sort compare l);; exception Error let error = QCheck.Test.make ~count:10 ~name:"error_raise_exn" QCheck.int (fun _ -> raise Error) let simple_qcheck = QCheck.Test.make ~name:"fail_check_err_message" ~count: 100 QCheck.small_int (fun _ -> QCheck.Test.fail_reportf "@[this@ will@ always@ fail@]") type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let gen_tree = QCheck.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] )) let rec rev_tree = function | Node (x, y) -> Node (rev_tree y, rev_tree x) | Leaf x -> Leaf x let passing_tree_rev = QCheck.Test.make ~count:1000 ~name:"tree_rev_is_involutive" QCheck.(make gen_tree) (fun tree -> rev_tree (rev_tree tree) = tree) let () = Printexc.record_backtrace true; let module A = Alcotest in let suite = List.map QCheck_alcotest.to_alcotest [ passing; failing; error; simple_qcheck; passing_tree_rev ] in A.run "my test" [ "suite", suite ] qcheck-0.18.1/example/alcotest/dune000066400000000000000000000010131417677125000171730ustar00rootroot00000000000000 (executable (name QCheck_alcotest_test) (libraries qcheck-core qcheck-alcotest alcotest)) (rule (targets output.txt) (deps ./QCheck_alcotest_test.exe) (enabled_if (= %{os_type} "Unix")) (action (with-accepted-exit-codes 1 (setenv QCHECK_SEED 1234 (with-stdout-to %{targets} (run ./run_alcotest.sh --color=never)))))) (rule (alias runtest) (package qcheck-alcotest) (enabled_if (= %{os_type} "Unix")) (action (diff output.txt.expected output.txt))) qcheck-0.18.1/example/alcotest/output.txt.expected000066400000000000000000000024361417677125000222300ustar00rootroot00000000000000qcheck random seed: 1234 Testing `my test'. [OK] suite 0 list_rev_is_involutive. > [FAIL] suite 1 fail_sort_id. [FAIL] suite 2 error_raise_exn. [FAIL] suite 3 fail_check_err_message. [OK] suite 4 tree_rev_is_involutive. ┌──────────────────────────────────────────────────────────────────────────────┐ │ [FAIL] suite 1 fail_sort_id. │ └──────────────────────────────────────────────────────────────────────────────┘ test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps) [exception] test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps) ────────────────────────────────────────────────────────────────────────────── 3 failures! 5 tests run. qcheck-0.18.1/example/alcotest/run_alcotest.sh000077500000000000000000000006401417677125000213630ustar00rootroot00000000000000#!/usr/bin/env sh # custom script to run qcheck-alcotest and filter non reproducible parts OUT=`./QCheck_alcotest_test.exe $@` CODE=$? # remove non deterministic output echo "$OUT" | grep -v 'This run has ID' \ | grep -v 'Full test results in' \ | grep -v 'Logs saved to' \ | grep -v 'Raised at ' \ | grep -v 'Called from ' \ | sed 's/! in .*s\./!/' \ | sed 's/[ \t]*$//g' \ | tr -s "\n" exit $CODE qcheck-0.18.1/example/dune000066400000000000000000000007011417677125000153600ustar00rootroot00000000000000 (executables (names QCheck_runner_test) (libraries qcheck)) (rule (targets output.txt) (deps ./QCheck_runner_test.exe) (enabled_if (= %{os_type} "Unix")) (action (with-accepted-exit-codes 1 (with-stdout-to %{targets} (run ./QCheck_runner_test.exe --no-colors -s 1234))))) (rule (alias runtest) (enabled_if (= %{os_type} "Unix")) (package qcheck) (action (diff output.txt.expected output.txt))) qcheck-0.18.1/example/ounit/000077500000000000000000000000001417677125000156425ustar00rootroot00000000000000qcheck-0.18.1/example/ounit/QCheck_ounit_test.ml000066400000000000000000000025401417677125000216100ustar00rootroot00000000000000let passing = QCheck.Test.make ~count:1000 ~name:"list_rev_is_involutive" QCheck.(list small_int) (fun l -> List.rev (List.rev l) = l);; let failing = QCheck.Test.make ~count:10 ~name:"fail_sort_id" QCheck.(list small_int) (fun l -> l = List.sort compare l);; exception Error let error = QCheck.Test.make ~count:10 ~name:"error_raise_exn" QCheck.int (fun _ -> raise Error) let simple_qcheck = QCheck.Test.make ~name:"fail_check_err_message" ~count: 100 QCheck.small_int (fun _ -> QCheck.Test.fail_reportf "@[this@ will@ always@ fail@]") type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let gen_tree = QCheck.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] )) let rec rev_tree = function | Node (x, y) -> Node (rev_tree y, rev_tree x) | Leaf x -> Leaf x let passing_tree_rev = QCheck.Test.make ~count:1000 ~name:"tree_rev_is_involutive" QCheck.(make gen_tree) (fun tree -> rev_tree (rev_tree tree) = tree) let () = Printexc.record_backtrace true; let open OUnit2 in run_test_tt_main ("tests" >::: List.map QCheck_ounit.to_ounit2_test [passing; failing; error; simple_qcheck; passing_tree_rev]) qcheck-0.18.1/example/ounit/QCheck_test.ml000066400000000000000000000017661417677125000204030ustar00rootroot00000000000000let (|>) x f = f x module Q = QCheck let passing = Q.Test.make ~count:1000 ~long_factor:2 ~name:"list_rev_is_involutive" Q.(list small_int) (fun l -> List.rev (List.rev l) = l);; let failing = Q.Test.make ~count:10 ~name:"should_fail_sort_id" Q.(small_list small_int) (fun l -> l = List.sort compare l);; exception Error let error = Q.Test.make ~count:10 ~name:"should_error_raise_exn" Q.int (fun _ -> raise Error) open OUnit let regression_23 = "issue_23" >:: (fun () -> let l = Q.Gen.(generate ~n:100_000 char) in OUnit.assert_bool "must contain '\255'" (List.exists (fun c->c = '\255') l) ) let regressions = [ regression_23 ] let others = [ passing; failing; error; ] |> List.map (fun t -> QCheck_ounit.to_ounit_test t) let suite = "tests" >::: (regressions @ others) let () = try exit (QCheck_ounit.run suite) with Arg.Bad msg -> print_endline msg; exit 1 | Arg.Help msg -> print_endline msg; exit 0 qcheck-0.18.1/example/ounit/dune000066400000000000000000000007361417677125000165260ustar00rootroot00000000000000 (executables (names QCheck_ounit_test QCheck_test) (libraries ounit2 qcheck-ounit)) (rule (targets output.txt) (deps ./QCheck_ounit_test.exe) (enabled_if (= %{os_type} "Unix")) (action (with-accepted-exit-codes 1 (with-stdout-to %{targets} (run ./run_ounit.sh -runner=sequential -seed 1234))))) (rule (alias runtest) (package qcheck-ounit) (enabled_if (= %{os_type} "Unix")) (action (diff output.txt.expected output.txt))) qcheck-0.18.1/example/ounit/output.txt.expected000066400000000000000000000023661417677125000215520ustar00rootroot00000000000000.FEF. ============================================================================== Error: tests:2:error_raise_exn. Error: tests:2:error_raise_exn (in the log). test `error_raise_exn` raised exception `Dune__exe__QCheck_ounit_test.Error` on `0 (after 63 shrink steps)` ------------------------------------------------------------------------------ ============================================================================== Error: tests:3:fail_check_err_message. Error: tests:3:fail_check_err_message (in the log). Error: tests:3:fail_check_err_message (in the code). test `fail_check_err_message` failed on ≥ 1 cases: 0 (after 7 shrink steps) this will always fail ------------------------------------------------------------------------------ ============================================================================== Error: tests:1:fail_sort_id. Error: tests:1:fail_sort_id (in the log). Error: tests:1:fail_sort_id (in the code). test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps) ------------------------------------------------------------------------------ Ran: 5 tests in: seconds. FAILED: Cases: 5 Tried: 5 Errors: 1 Failures: 2 Skip: 0 Todo: 0 Timeouts: 0. qcheck-0.18.1/example/ounit/run_ounit.sh000077500000000000000000000005101417677125000202170ustar00rootroot00000000000000#!/usr/bin/env sh # custom script to run qcheck-ounit and filter non reproducible parts OUT=`./QCheck_ounit_test.exe $@` CODE=$? # remove non deterministic output echo "$OUT" \ | grep -v 'File .*, line .*' \ | grep -v 'Called from ' \ | grep -v 'Raised at ' \ | sed 's/in: .*seconds/in: seconds/' exit $CODE qcheck-0.18.1/example/output.txt.expected000066400000000000000000000450601417677125000204120ustar00rootroot00000000000000random seed: 1234 --- Failure -------------------------------------------------------------------- Test should_fail_sort_id failed (18 shrink steps): [1; 0] === Error ====================================================================== Test should_error_raise_exn errored on (63 shrink steps): 0 exception Dune__exe__QCheck_runner_test.Error +++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Collect results for test collect_results: 4: 20 cases 3: 25 cases 2: 17 cases 1: 18 cases 0: 20 cases +++ Stats for with_stats ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats mod4: num: 100, avg: 1.68, stddev: 1.09, median 2, min 0, max 3 0: ############################## 17 1: ################################################### 29 2: ######################################## 23 3: ####################################################### 31 stats num: num: 100, avg: 66.84, stddev: 31.94, median 65, min 2, max 120 2.. 7: ################## 3 8.. 13: ################## 3 14.. 19: 0 20.. 25: ########################################## 7 26.. 31: ######################## 4 32.. 37: ######################## 4 38.. 43: ################## 3 44.. 49: ################################################ 8 50.. 55: #################################### 6 56.. 61: #################################### 6 62.. 67: ####################################################### 9 68.. 73: ########################################## 7 74.. 79: ######################## 4 80.. 85: ################## 3 86.. 91: ############ 2 92.. 97: ########################################## 7 98..103: #################################### 6 104..109: #################################### 6 110..115: ####################################################### 9 116..121: ################## 3 --- Failure -------------------------------------------------------------------- Test FAIL_pred_map_commute failed (127 shrink steps): ([3], {_ -> 0}, {3 -> false; _ -> true}) --- Failure -------------------------------------------------------------------- Test FAIL_fun2_pred_strings failed (1 shrink steps): {some random string -> true; _ -> false} --- Failure -------------------------------------------------------------------- Test fold_left fold_right failed (25 shrink steps): (0, [1], {(1, 0) -> 1; _ -> 0}) +++ Messages ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Messages for test fold_left fold_right: l=[1], fold_left=1, fold_right=0 --- Failure -------------------------------------------------------------------- Test fold_left fold_right uncurried failed (111 shrink steps): ({(5, 7) -> 0; _ -> 7}, 0, [5; 0]) --- Failure -------------------------------------------------------------------- Test long_shrink failed (149 shrink steps): ([0], [-1]) --- Failure -------------------------------------------------------------------- Test mod3_should_fail failed (84 shrink steps): -21 +++ Stats for stats_neg ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 5000, avg: 0.17, stddev: 29.68, median 0, min -99, max 99 -99..-90: # 65 -89..-80: # 63 -79..-70: # 64 -69..-60: # 58 -59..-50: # 67 -49..-40: # 72 -39..-30: # 61 -29..-20: # 61 -19..-10: # 67 -9.. 0: ####################################################### 2076 1.. 10: ############################################## 1764 11.. 20: # 66 21.. 30: # 64 31.. 40: # 64 41.. 50: # 67 51.. 60: # 60 61.. 70: # 75 71.. 80: # 60 81.. 90: # 60 91..100: # 66 !!! Warning !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Warning for test WARN_unlikely_precond: WARNING: only 0.5% tests (of 2000) passed precondition for "WARN_unlikely_precond" NOTE: it is likely that the precondition is too strong, or that the generator is buggy. --- Failure -------------------------------------------------------------------- Test FAIL_unlikely_precond failed: ERROR: only 0.5% tests (of 2000) passed precondition for "FAIL_unlikely_precond" NOTE: it is likely that the precondition is too strong, or that the generator is buggy. --- Failure -------------------------------------------------------------------- Test FAIL_#99_1 failed: ERROR: uncaught exception in generator for test FAIL_#99_1 after 100 steps: Exception: QCheck.No_example_found("") Backtrace: +++ Stats for stat_display_test_1 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 0.90, stddev: 28.23, median 0, min -99, max 99 -99..-90: # 12 -89..-80: # 11 -79..-70: # 9 -69..-60: 6 -59..-50: # 11 -49..-40: # 13 -39..-30: # 9 -29..-20: # 13 -19..-10: 8 -9.. 0: ####################################################### 453 1.. 10: ######################################### 340 11.. 20: # 15 21.. 30: # 11 31.. 40: # 12 41.. 50: # 13 51.. 60: # 13 61.. 70: # 16 71.. 80: # 9 81.. 90: # 16 91..100: # 10 +++ Stats for stat_display_test_2 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 15.11, stddev: 23.27, median 6, min 0, max 99 0.. 4: #################################################### 377 5.. 9: ####################################################### 392 10.. 14: ## 20 15.. 19: ## 15 20.. 24: # 11 25.. 29: ## 17 30.. 34: ## 19 35.. 39: ## 17 40.. 44: # 10 45.. 49: # 9 50.. 54: # 8 55.. 59: # 9 60.. 64: ## 15 65.. 69: # 10 70.. 74: # 13 75.. 79: ## 19 80.. 84: # 11 85.. 89: # 13 90.. 94: 5 95.. 99: # 10 +++ Stats for stat_display_test_3 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 195335.64, stddev: 136803.99, median 195583, min -43624, max 435210 -43624..-19683: ############################################ 52 -19682.. 4259: ######################################## 47 4260.. 28201: ############################## 36 28202.. 52143: ############################################ 52 52144.. 76085: ########################################## 50 76086..100027: ####################################################### 64 100028..123969: ############################################### 55 123970..147911: ######################################## 47 147912..171853: ############################################## 54 171854..195795: #################################### 43 195796..219737: ############################################## 54 219738..243679: ########################################### 51 243680..267621: ################################################ 57 267622..291563: ########################################## 49 291564..315505: #################################### 42 315506..339447: ###################################### 45 339448..363389: ################################################ 57 363390..387331: ###################################### 45 387332..411273: ########################################## 49 411274..435215: ########################################### 51 +++ Stats for stat_display_test_4 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: -173.78, stddev: 23042.92, median 180, min -39859, max 39942 -39859..-35869: ############################################# 56 -35868..-31878: ################################### 43 -31877..-27887: ################################################# 60 -27886..-23896: ##################################### 46 -23895..-19905: ######################################## 49 -19904..-15914: #################################### 45 -15913..-11923: ############################################ 54 -11922.. -7932: ############################################### 58 -7931.. -3941: ######################################### 51 -3940.. 50: ############################ 35 51.. 4041: ####################################### 48 4042.. 8032: ########################################## 52 8033.. 12023: ######################################### 51 12024.. 16014: ########################################### 53 16015.. 20005: ############################################ 54 20006.. 23996: ################################## 42 23997.. 27987: ####################################################### 67 27988.. 31978: ################################ 40 31979.. 35969: ######################################### 51 35970.. 39960: #################################### 45 +++ Stats for stat_display_test_5 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 0.02, stddev: 2.55, median 0, min -4, max 4 -4: ############################################ 99 -3: ##################################################### 118 -2: ################################################## 111 -1: ################################################## 113 0: ################################################## 113 1: ##################################################### 118 2: ############################################# 102 3: ####################################################### 122 4: ############################################## 104 +++ Stats for stat_display_test_6 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 6.67, stddev: 6.39, median 7, min -4, max 17 -4..-3: ############################################# 90 -2..-1: ############################################# 91 0.. 1: ########################################## 84 2.. 3: ############################################## 92 4.. 5: ########################################### 87 6.. 7: ########################################### 86 8.. 9: ############################################ 89 10..11: ########################################### 87 12..13: ####################################################### 110 14..15: ############################################# 91 16..17: ############################################## 93 18..19: 0 20..21: 0 22..23: 0 24..25: 0 26..27: 0 28..29: 0 30..31: 0 32..33: 0 34..35: 0 +++ Stats for stat_display_test_7 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 100000, avg: 2541076923587387.50, stddev: 2660730801206827008.00, median 158655268318060, min -4611522359435274428, max 4611540922436307689 -4611522359435274428..-4150369195341695293: ##################################################### 4976 -4150369195341695292..-3689216031248116157: ##################################################### 4963 -3689216031248116156..-3228062867154537021: ###################################################### 5038 -3228062867154537020..-2766909703060957885: ##################################################### 4979 -2766909703060957884..-2305756538967378749: ##################################################### 5001 -2305756538967378748..-1844603374873799613: ##################################################### 4982 -1844603374873799612..-1383450210780220477: ##################################################### 5025 -1383450210780220476.. -922297046686641341: #################################################### 4901 -922297046686641340.. -461143882593062205: ####################################################### 5126 -461143882593062204.. 9281500516931: ##################################################### 5008 9281500516932.. 461162445594096067: ###################################################### 5041 461162445594096068.. 922315609687675203: ##################################################### 5001 922315609687675204.. 1383468773781254339: ##################################################### 4986 1383468773781254340.. 1844621937874833475: ##################################################### 4949 1844621937874833476.. 2305775101968412611: ##################################################### 5025 2305775101968412612.. 2766928266061991747: ##################################################### 5022 2766928266061991748.. 3228081430155570883: ##################################################### 4958 3228081430155570884.. 3689234594249150019: ##################################################### 4998 3689234594249150020.. 4150387758342729155: ##################################################### 4982 4150387758342729156.. 4611540922436308291: ###################################################### 5039 ================================================================================ 1 warning(s) failure (9 tests failed, 1 tests errored, ran 25 tests) qcheck-0.18.1/qcheck-alcotest.opam000066400000000000000000000013511417677125000170010ustar00rootroot00000000000000opam-version: "2.0" maintainer: "simon.cruanes.2007@m4x.org" author: [ "the qcheck contributors" ] homepage: "https://github.com/c-cube/qcheck/" license: "BSD-2-Clause" synopsis: "Alcotest backend for qcheck" doc: ["http://c-cube.github.io/qcheck/"] version: "0.18.1" tags: [ "test" "quickcheck" "qcheck" "alcotest" ] build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "dune" { >= "2.2" } "base-bytes" "base-unix" "qcheck-core" { = version } "alcotest" "odoc" {with-doc} "ocaml" {>= "4.08.0"} ] dev-repo: "git+https://github.com/c-cube/qcheck.git" bug-reports: "https://github.com/c-cube/qcheck/issues" qcheck-0.18.1/qcheck-core.opam000066400000000000000000000013511417677125000161130ustar00rootroot00000000000000opam-version: "2.0" maintainer: "simon.cruanes.2007@m4x.org" author: [ "the qcheck contributors" ] homepage: "https://github.com/c-cube/qcheck/" license: "BSD-2-Clause" synopsis: "Core qcheck library" doc: ["http://c-cube.github.io/qcheck/"] version: "0.18.1" tags: [ "test" "property" "quickcheck" ] build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "dune" { >= "2.2" } "base-bytes" "base-unix" "alcotest" {with-test} "odoc" {with-doc} "ocaml" {>= "4.08.0"} ] dev-repo: "git+https://github.com/c-cube/qcheck.git" bug-reports: "https://github.com/c-cube/qcheck/issues" conflicts: [ "ounit" { < "2.0" } ] qcheck-0.18.1/qcheck-ounit.opam000066400000000000000000000013301417677125000163160ustar00rootroot00000000000000opam-version: "2.0" maintainer: "simon.cruanes.2007@m4x.org" author: [ "the qcheck contributors" ] license: "BSD-2-Clause" homepage: "https://github.com/c-cube/qcheck/" doc: ["http://c-cube.github.io/qcheck/"] synopsis: "OUnit backend for qcheck" version: "0.18.1" tags: [ "qcheck" "quickcheck" "ounit" ] build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "dune" { >= "2.2" } "base-bytes" "base-unix" "qcheck-core" { = version } "ounit2" "odoc" {with-doc} "ocaml" {>= "4.08.0"} ] dev-repo: "git+https://github.com/c-cube/qcheck.git" bug-reports: "https://github.com/c-cube/qcheck/issues" qcheck-0.18.1/qcheck.opam000066400000000000000000000014631417677125000151710ustar00rootroot00000000000000opam-version: "2.0" maintainer: "simon.cruanes.2007@m4x.org" author: [ "the qcheck contributors" ] synopsis: "Compatibility package for qcheck" homepage: "https://github.com/c-cube/qcheck/" license: "BSD-2-Clause" doc: ["http://c-cube.github.io/qcheck/"] version: "0.18.1" tags: [ "test" "property" "quickcheck" ] build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "dune" { >= "2.2" } "base-bytes" "base-unix" "qcheck-core" { = version } "qcheck-ounit" { = version } "alcotest" {with-test} "odoc" {with-doc} "ocaml" {>= "4.08.0"} ] dev-repo: "git+https://github.com/c-cube/qcheck.git" bug-reports: "https://github.com/c-cube/qcheck/issues" conflicts: [ "ounit" { < "2.0" } ] qcheck-0.18.1/src/000077500000000000000000000000001417677125000136405ustar00rootroot00000000000000qcheck-0.18.1/src/QCheck_runner.ml000066400000000000000000000000611417677125000167160ustar00rootroot00000000000000 include QCheck_base_runner include QCheck_ounit qcheck-0.18.1/src/alcotest/000077500000000000000000000000001417677125000154565ustar00rootroot00000000000000qcheck-0.18.1/src/alcotest/QCheck_alcotest.ml000066400000000000000000000020041417677125000210400ustar00rootroot00000000000000 module Q = QCheck2 module T = QCheck2.Test module Raw = QCheck_base_runner.Raw let seed_ = lazy ( let s = try int_of_string @@ Sys.getenv "QCHECK_SEED" with _ -> Random.self_init(); Random.int 1_000_000_000 in Printf.printf "qcheck random seed: %d\n%!" s; s ) let default_rand () = (* random seed, for repeatability of tests *) Random.State.make [| Lazy.force seed_ |] let verbose_ = lazy ( match Sys.getenv "QCHECK_VERBOSE" with | "1" | "true" -> true | _ -> false | exception Not_found -> false ) let long_ = lazy ( match Sys.getenv "QCHECK_LONG" with | "1" | "true" -> true | _ -> false | exception Not_found -> false ) let to_alcotest ?(verbose=Lazy.force verbose_) ?(long=Lazy.force long_) ?(rand=default_rand()) (t:T.t) = let T.Test cell = t in let print = Raw.print_std in let run() = T.check_cell_exn cell ~long ~rand ~call:(Raw.callback ~colors:false ~verbose ~print_res:true ~print) in let name = T.get_name cell in name, `Slow, run qcheck-0.18.1/src/alcotest/QCheck_alcotest.mli000066400000000000000000000012701417677125000212150ustar00rootroot00000000000000 (** {1 Alcotest backend for QCheck} We use environment variables for controlling QCheck here, since alcotest doesn't seem to provide a lot of flexibility. - [QCHECK_VERBOSE] if "1" or "true", will make tests verbose - [QCHECK_SEED] if an integer, will fix the seed - [QCHECK_LONG] is present, will trigger long tests @since 0.9 *) val to_alcotest : ?verbose:bool -> ?long:bool -> ?rand:Random.State.t -> QCheck2.Test.t -> unit Alcotest.test_case (** Convert a qcheck test into an alcotest test @param verbose used to print information on stdout (default: [verbose()]) @param rand the random generator to use (default: [random_state ()]) @since 0.9 *) qcheck-0.18.1/src/alcotest/dune000066400000000000000000000003321417677125000163320ustar00rootroot00000000000000 (library (name qcheck_alcotest) (public_name qcheck-alcotest) (wrapped false) (libraries unix bytes qcheck-core qcheck-core.runner alcotest) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) ) qcheck-0.18.1/src/core/000077500000000000000000000000001417677125000145705ustar00rootroot00000000000000qcheck-0.18.1/src/core/QCheck.ml000066400000000000000000001203701417677125000162630ustar00rootroot00000000000000(* QCheck: Random testing for OCaml copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard all rights reserved. *) (** {1 Quickcheck inspired property-based testing} *) let poly_compare=compare open Printf module RS = Random.State let (|>) x f = f x let rec foldn ~f ~init:acc i = if i = 0 then acc else foldn ~f ~init:(f acc i) (i-1) let _is_some = function Some _ -> true | None -> false let _opt_map_or ~d ~f = function | None -> d | Some x -> f x let _opt_or a b = match a with | None -> b | Some x -> x let _opt_map ~f = function | None -> None | Some x -> Some (f x) let _opt_map_2 ~f a b = match a, b with | Some x, Some y -> Some (f x y) | _ -> None let _opt_map_3 ~f a b c = match a, b, c with | Some x, Some y, Some z -> Some (f x y z) | _ -> None let _opt_map_4 ~f a b c d = match a, b, c, d with | Some x, Some y, Some z, Some w -> Some (f x y z w) | _ -> None let _opt_sum a b = match a, b with | Some _, _ -> a | None, _ -> b let sum_int = List.fold_left (+) 0 exception No_example_found of string (* raised if an example failed to be found *) let assume = QCheck2.assume let assume_fail = QCheck2.assume_fail let (==>) = QCheck2.(==>) module Gen = struct type 'a t = RS.t -> 'a type 'a sized = int -> Random.State.t -> 'a let return x _st = x let pure = return let (>>=) gen f st = f (gen st) st let (<*>) f x st = f st (x st) let map f x st = f (x st) let map2 f x y st = f (x st) (y st) let map3 f x y z st = f (x st) (y st) (z st) let map_keep_input f gen st = let x = gen st in x, f x let (>|=) x f st = f (x st) let (<$>) f x st = f (x st) let oneof l st = List.nth l (Random.State.int st (List.length l)) st let oneofl xs st = List.nth xs (Random.State.int st (List.length xs)) let oneofa xs st = Array.get xs (Random.State.int st (Array.length xs)) let frequencyl l st = let sums = sum_int (List.map fst l) in let i = Random.State.int st sums in let rec aux acc = function | ((x,g)::xs) -> if i < acc+x then g else aux (acc+x) xs | _ -> failwith "frequency" in aux 0 l let frequencya a = frequencyl (Array.to_list a) let frequency l st = frequencyl l st st let small_nat st = let p = RS.float st 1. in if p < 0.75 then RS.int st 10 else RS.int st 100 (* natural number generator *) let nat st = let p = RS.float st 1. in if p < 0.5 then RS.int st 10 else if p < 0.75 then RS.int st 100 else if p < 0.95 then RS.int st 1_000 else RS.int st 10_000 let big_nat st = let p = RS.float st 1. in if p < 0.75 then nat st else RS.int st 1_000_000 let unit _st = () let bool st = RS.bool st let float st = exp (RS.float st 15. *. (if RS.float st 1. < 0.5 then 1. else -1.)) *. (if RS.float st 1. < 0.5 then 1. else -1.) let pfloat st = abs_float (float st) let nfloat st = -.(pfloat st) let float_bound_inclusive bound st = RS.float st bound let float_bound_exclusive bound st = match bound with | 0. -> raise (Invalid_argument "Gen.float_bound_exclusive") | b_pos when bound > 0. -> RS.float st (b_pos -. epsilon_float) | b_neg -> RS.float st (b_neg +. epsilon_float) let float_range low high = if high < low || high -. low > max_float then invalid_arg "Gen.float_range"; fun st -> low +. (float_bound_inclusive (high -. low) st) let (--.) = float_range let neg_int st = -(nat st) let opt ?(ratio = 0.85) f st = let p = RS.float st 1. in if p < (1.0 -. ratio) then None else Some (f st) (* Uniform random int generator *) let pint = if Sys.word_size = 32 then fun st -> RS.bits st else (* word size = 64 *) fun st -> (* Technically we could write [3] but this is clearer *) let two_bits_mask = 0b11 in (* Top 2 bits *) let left = ((RS.bits st land two_bits_mask) lsl 60) in (* Middle 30 bits *) let middle = (RS.bits st lsl 30) in (* Bottom 30 bits *) let right = RS.bits st in left lor middle lor right let int st = if RS.bool st then - (pint st) - 1 else pint st let int_bound n = if n < 0 then invalid_arg "Gen.int_bound"; if n <= (1 lsl 30) - 2 then fun st -> Random.State.int st (n + 1) else fun st -> let r = pint st in r mod (n + 1) let int_range a b = if b < a then invalid_arg "Gen.int_range"; if a >= 0 || b < 0 then ( (* range smaller than max_int *) assert (b-a >= 0); fun st -> a + (int_bound (b-a) st) ) else ( (* range potentially bigger than max_int: we split on 0 and choose the itv wrt to their size ratio *) fun st -> let f_a = float_of_int a in let ratio = (-.f_a) /. (1. +. float_of_int b -. f_a) in if Random.State.float st 1. <= ratio then - (int_bound (- (a+1)) st) - 1 else int_bound b st ) let (--) = int_range (* NOTE: we keep this alias to not break code that uses [small_int] for sizes of strings, arrays, etc. *) let small_int = small_nat let small_signed_int st = if bool st then small_nat st else - (small_nat st) let char_range a b = map Char.chr (Char.code a -- Char.code b) let random_binary_string st length = (* 0b011101... *) let s = Bytes.create (length + 2) in Bytes.set s 0 '0'; Bytes.set s 1 'b'; for i = 0 to length - 1 do Bytes.set s (i+2) (if RS.bool st then '0' else '1') done; Bytes.unsafe_to_string s let ui32 st = Int32.of_string (random_binary_string st 32) let ui64 st = Int64.of_string (random_binary_string st 64) let list_size size gen st = foldn ~f:(fun acc _ -> (gen st)::acc) ~init:[] (size st) let list gen st = list_size nat gen st let list_repeat n g = list_size (return n) g let array_size size gen st = Array.init (size st) (fun _ -> gen st) let array gen st = array_size nat gen st let array_repeat n g = array_size (return n) g let flatten_l l st = List.map (fun f->f st) l let flatten_a a st = Array.map (fun f->f st) a let flatten_opt o st = match o with | None -> None | Some f -> Some (f st) let flatten_res r st = match r with | Ok f -> Ok (f st) | Error e -> Error e let shuffle_a a st = for i = Array.length a-1 downto 1 do let j = Random.State.int st (i+1) in let tmp = a.(i) in a.(i) <- a.(j); a.(j) <- tmp; done let shuffle_l l st = let a = Array.of_list l in shuffle_a a st; Array.to_list a let shuffle_w_l l st = let sample (w, v) = let fl_w = float_of_int w in (float_bound_inclusive 1. st ** (1. /. fl_w), v) in let samples = List.rev_map sample l in List.sort (fun (w1, _) (w2, _) -> poly_compare w1 w2) samples |> List.rev_map snd let range_subset ~size low high st = let range_size = high - low + 1 in if not (0 <= size && size <= range_size) then invalid_arg "Gen.range_subset"; (* The algorithm below is attributed to Floyd, see for example https://eyalsch.wordpress.com/2010/04/01/random-sample/ https://math.stackexchange.com/questions/178690 Note: the code is easier to read when drawing from [0..range_size-1] rather than [low..high]. We draw in [0..bound], and shift the results by adding [low] when writing them to the result array. *) let module ISet = Set.Make(Int) in let s = ref ISet.empty in for i = range_size - size to range_size - 1 do let pos = int_range 0 i st in let choice = if ISet.mem pos !s then i else pos in s := ISet.add choice !s; done; let arr = Array.make size 0 in let idx = ref 0 in ISet.iter (fun choice -> arr.(!idx) <- low + choice; incr idx) !s; arr let array_subset size arr st = range_subset ~size 0 (Array.length arr - 1) st |> Array.map (fun i -> arr.(i)) let pair g1 g2 st = (g1 st, g2 st) let triple g1 g2 g3 st = (g1 st, g2 st, g3 st) let quad g1 g2 g3 g4 st = (g1 st, g2 st, g3 st, g4 st) let char st = char_of_int (RS.int st 256) let printable_chars = let l = 126-32+1 in let s = Bytes.create l in for i = 0 to l-2 do Bytes.set s i (char_of_int (32+i)) done; Bytes.set s (l-1) '\n'; Bytes.unsafe_to_string s let printable st = printable_chars.[RS.int st (String.length printable_chars)] let numeral st = char_of_int (48 + RS.int st 10) let string_size ?(gen = char) size st = let s = Bytes.create (size st) in for i = 0 to Bytes.length s - 1 do Bytes.set s i (gen st) done; Bytes.unsafe_to_string s let string ?gen st = string_size ?gen nat st let string_of gen = string_size ~gen nat let string_printable = string_size ~gen:printable nat let string_readable = string_printable let small_string ?gen st = string_size ?gen small_nat st let small_list gen = list_size small_nat gen let small_array gen = array_size small_nat gen let join g st = (g st) st (* corner cases *) let graft_corners gen corners () = let cors = ref corners in fun st -> match !cors with [] -> gen st | e::l -> cors := l; e let int_pos_corners = [0;1;2;max_int] let int_corners = int_pos_corners @ [min_int] let nng_corners () = graft_corners nat int_pos_corners () (* sized, fix *) let sized_size s f st = f (s st) st let sized f = sized_size nat f let fix f = let rec f' n st = f f' n st in f' (* nat splitting *) let pos_split2 n st = if (n < 2) then invalid_arg "pos_split2"; let n1 = int_range 1 (n - 1) st in (n1, n - n1) let nat_split2 n st = if (n < 0) then invalid_arg "nat_split2"; let n1 = int_range 0 n st in (n1, n - n1) let pos_split ~size:k n st = if (n < 0) then invalid_arg "pos_split"; if 0 = k && 0 = n then [||] else begin if not (0 < k && k <= n) then invalid_arg "pos_split"; (* To split n into n{0}+n{1}+..+n{k-1}, we draw distinct "boundaries" b{-1}..b{k-1}, with b{-1}=0 and b{k-1} = n and the k-1 intermediate boundaries b{0}..b{k-2} chosen randomly distinct in [1;n-1]. Then each n{i} is defined as b{i}-b{i-1}. *) let b = range_subset ~size:(k-1) 1 (n - 1) st in if k = 1 then [|n|] else Array.init k (fun i -> if i = 0 then b.(0) else if i = k-1 then n - b.(i-1) else b.(i) - b.(i-1) ) end let nat_split ~size:k n st = if not (0 <= k && 0 <= n) then invalid_arg "nat_split"; pos_split ~size:k (n+k) st |> Array.map (fun v -> v - 1) let generate ?(rand=Random.State.make_self_init()) ~n g = list_repeat n g rand let generate1 ?(rand=Random.State.make_self_init()) g = g rand let delay f st = f () st let (let+) = (>|=) let (and+) = pair let (let*) = (>>=) let (and*) = pair end module Print = struct type 'a t = 'a -> string let unit _ = "()" let int = string_of_int let bool = string_of_bool let float = string_of_float let string s = s let char c = String.make 1 c let option f = function | None -> "None" | Some x -> "Some (" ^ f x ^ ")" let pair a b (x,y) = Printf.sprintf "(%s, %s)" (a x) (b y) let triple a b c (x,y,z) = Printf.sprintf "(%s, %s, %s)" (a x) (b y) (c z) let quad a b c d (x,y,z,w) = Printf.sprintf "(%s, %s, %s, %s)" (a x) (b y) (c z) (d w) let list pp l = let b = Buffer.create 25 in Buffer.add_char b '['; List.iteri (fun i x -> if i > 0 then Buffer.add_string b "; "; Buffer.add_string b (pp x)) l; Buffer.add_char b ']'; Buffer.contents b let array pp a = let b = Buffer.create 25 in Buffer.add_string b "[|"; Array.iteri (fun i x -> if i > 0 then Buffer.add_string b "; "; Buffer.add_string b (pp x)) a; Buffer.add_string b "|]"; Buffer.contents b let comap f p x = p (f x) end module Iter = struct type 'a t = ('a -> unit) -> unit let empty _ = () let return x yield = yield x let (<*>) a b yield = a (fun f -> b (fun x -> yield (f x))) let (>>=) a f yield = a (fun x -> f x yield) let map f a yield = a (fun x -> yield (f x)) let map2 f a b yield = a (fun x -> b (fun y -> yield (f x y))) let (>|=) a f = map f a let append a b yield = a yield; b yield let append_l l yield = List.iter (fun s->s yield) l let flatten s yield = s (fun sub -> sub yield) let filter f s yield = s (fun x -> if f x then yield x) let (<+>) = append let of_list l yield = List.iter yield l let of_array a yield = Array.iter yield a let pair a b yield = a (fun x -> b(fun y -> yield (x,y))) let triple a b c yield = a (fun x -> b (fun y -> c (fun z -> yield (x,y,z)))) let quad a b c d yield = a (fun x -> b (fun y -> c (fun z -> d (fun w -> yield (x,y,z,w))))) exception IterExit let find_map p iter = let r = ref None in (try iter (fun x -> match p x with Some _ as y -> r := y; raise IterExit | None -> ()) with IterExit -> () ); !r let find p iter = find_map (fun x->if p x then Some x else None) iter let (let+) = (>|=) let (and+) = pair let (let*) = (>>=) let (and*) = pair end module Shrink = struct type 'a t = 'a -> 'a Iter.t let nil _ = Iter.empty let unit = nil (* balanced shrinker for integers (non-exhaustive) *) let int x yield = let y = ref x in (* try some divisors *) while !y < -2 || !y >2 do y := !y / 2; yield (x - !y); done; (* fast path *) if x>0 then yield (x-1); if x<0 then yield (x+1); () let int32 x yield = let open Int32 in let y = ref x in (* try some divisors *) while !y < -2l || !y > 2l do y := div !y 2l; yield (sub x !y); done; (* fast path *) if x>0l then yield (pred x); if x<0l then yield (succ x); () let int64 x yield = let open Int64 in let y = ref x in (* try some divisors *) while !y < -2L || !y > 2L do y := div !y 2L; yield (sub x !y); done; (* fast path *) if x>0L then yield (pred x); if x<0L then yield (succ x); () (* aggressive shrinker for integers, get from 0 to x, by dichotomy or just enumerating smaller values *) let int_aggressive x yield = let y = ref x in while !y < -2 || !y >2 do y := !y / 2; yield (x - !y); done; (* fast path *) if x>0 then for i=x-1 downto 0 do yield i done; if x<0 then for i=x+1 to 0 do yield i done let filter f shrink x = Iter.filter f (shrink x) let char c yield = if Char.code c > 0 then yield (Char.chr (Char.code c-1)) let option s x = match x with | None -> Iter.empty | Some x -> Iter.(return None <+> map (fun y->Some y) (s x)) let string s yield = for i =0 to String.length s-1 do let s' = Bytes.init (String.length s-1) (fun j -> if j 0 do for i=0 to n - !chunk_size do (* remove elements in [i .. i+!chunk_size] *) let a' = Array.init (n - !chunk_size) (fun j -> if j< i then a.(j) else a.(j + !chunk_size)) in yield a' done; chunk_size := !chunk_size / 2; done; match shrink with | None -> () | Some f -> (* try to shrink each element of the array *) for i = 0 to Array.length a - 1 do f a.(i) (fun x -> let b = Array.copy a in b.(i) <- x; yield b ) done let list_spine l yield = let n = List.length l in let chunk_size = ref ((n+1)/2) in (* push the [n] first elements of [l] into [q], return the rest of the list *) let rec fill_queue n l q = match n,l with | 0, _ -> l | _, x::xs -> Queue.push x q; fill_queue (n-1) xs q | _, _ -> assert false in (* remove elements from the list, by chunks of size [chunk_size] (bigger chunks first) *) while !chunk_size > 0 do let q = Queue.create () in let l' = fill_queue !chunk_size l q in (* remove [chunk_size] elements in queue *) let rec pos_loop rev_prefix suffix = yield (List.rev_append rev_prefix suffix); match suffix with | [] -> () | x::xs -> Queue.push x q; let y = Queue.pop q in (pos_loop [@tailcall]) (y::rev_prefix) xs in pos_loop [] l'; chunk_size := !chunk_size / 2; done let list_elems shrink l yield = (* try to shrink each element of the list *) let rec elem_loop rev_prefix suffix = match suffix with | [] -> () | x::xs -> shrink x (fun x' -> yield (List.rev_append rev_prefix (x'::xs))); elem_loop (x::rev_prefix) xs in elem_loop [] l let list ?shrink l yield = list_spine l yield; match shrink with | None -> () | Some shrink -> list_elems shrink l yield let pair a b (x,y) yield = a x (fun x' -> yield (x',y)); b y (fun y' -> yield (x,y')) let triple a b c (x,y,z) yield = a x (fun x' -> yield (x',y,z)); b y (fun y' -> yield (x,y',z)); c z (fun z' -> yield (x,y,z')) let quad a b c d (x,y,z,w) yield = a x (fun x' -> yield (x',y,z,w)); b y (fun y' -> yield (x,y',z,w)); c z (fun z' -> yield (x,y,z',w)); d w (fun w' -> yield (x,y,z,w')) end (** {2 Observe Values} *) module Observable = struct (** An observable is a (random) predicate on ['a] *) type -'a t = { print: 'a Print.t; eq: ('a -> 'a -> bool); hash: ('a -> int); } let hash o x = o.hash x let equal o x y = o.eq x y let print o x = o.print x let make ?(eq=(=)) ?(hash=Hashtbl.hash) print = {print; eq; hash; } module H = struct let combine a b = Hashtbl.seeded_hash a b let combine_f f s x = Hashtbl.seeded_hash s (f x) let int i = i land max_int let bool b = if b then 1 else 2 let char x = Char.code x let string (x:string) = Hashtbl.hash x let opt f = function | None -> 42 | Some x -> combine 43 (f x) let list f l = List.fold_left (combine_f f) 0x42 l let array f l = Array.fold_left (combine_f f) 0x42 l let pair f g (x,y) = combine (f x) (g y) end module Eq = struct type 'a t = 'a -> 'a -> bool let int : int t = (=) let string : string t = (=) let bool : bool t = (=) let float : float t = (=) let unit () () = true let char : char t = (=) let rec list f l1 l2 = match l1, l2 with | [], [] -> true | [], _ | _, [] -> false | x1::l1', x2::l2' -> f x1 x2 && list f l1' l2' let array eq a b = let rec aux i = if i = Array.length a then true else eq a.(i) b.(i) && aux (i+1) in Array.length a = Array.length b && aux 0 let option f o1 o2 = match o1, o2 with | None, None -> true | Some _, None | None, Some _ -> false | Some x, Some y -> f x y let pair f g (x1,y1)(x2,y2) = f x1 x2 && g y1 y2 end let unit : unit t = make ~hash:(fun _ -> 1) ~eq:Eq.unit Print.unit let bool : bool t = make ~hash:H.bool ~eq:Eq.bool Print.bool let int : int t = make ~hash:H.int ~eq:Eq.int Print.int let float : float t = make ~eq:Eq.float Print.float let string = make ~hash:H.string ~eq:Eq.string Print.string let char = make ~hash:H.char ~eq:Eq.char Print.char let option p = make ~hash:(H.opt p.hash) ~eq:(Eq.option p.eq) (Print.option p.print) let array p = make ~hash:(H.array p.hash) ~eq:(Eq.array p.eq) (Print.array p.print) let list p = make ~hash:(H.list p.hash) ~eq:(Eq.list p.eq) (Print.list p.print) let map f p = make ~hash:(fun x -> p.hash (f x)) ~eq:(fun x y -> p.eq (f x)(f y)) (fun x -> p.print (f x)) let pair a b = make ~hash:(H.pair a.hash b.hash) ~eq:(Eq.pair a.eq b.eq) (Print.pair a.print b.print) let triple a b c = map (fun (x,y,z) -> x,(y,z)) (pair a (pair b c)) let quad a b c d = map (fun (x,y,z,u) -> x,(y,z,u)) (pair a (triple b c d)) end type 'a stat = string * ('a -> int) (** A statistic on a distribution of values of type ['a] *) type 'a arbitrary = { gen: 'a Gen.t; print: ('a -> string) option; (** print values *) small: ('a -> int) option; (** size of example *) shrink: ('a -> 'a Iter.t) option; (** shrink to smaller examples *) collect: ('a -> string) option; (** map value to tag, and group by tag *) stats: 'a stat list; (** statistics to collect and print *) } let make ?print ?small ?shrink ?collect ?(stats=[]) gen = { gen; print; small; shrink; collect; stats; } let set_small f o = {o with small=Some f} let set_print f o = {o with print=Some f} let set_shrink f o = {o with shrink=Some f} let set_collect f o = {o with collect=Some f} let set_stats s o = {o with stats=s} let add_stat s o = {o with stats=s :: o.stats} let set_gen g o = {o with gen=g} let add_shrink_invariant f o = match o.shrink with | None -> o | Some shr -> {o with shrink=Some (Shrink.filter f shr)} let get_gen o = o.gen let gen = get_gen let get_print o = o.print let small1 _ = 1 let make_scalar ?print ?collect gen = make ~shrink:Shrink.nil ~small:small1 ?print ?collect gen let make_int ?collect gen = make ~shrink:Shrink.int ~small:small1 ~print:Print.int ?collect gen let adapt_ o gen = make ?print:o.print ?small:o.small ?shrink:o.shrink ?collect:o.collect gen let choose l = match l with | [] -> raise (Invalid_argument "quickcheck.choose") | l -> let a = Array.of_list l in adapt_ a.(0) (fun st -> let arb = a.(RS.int st (Array.length a)) in arb.gen st) let unit : unit arbitrary = make ~small:small1 ~shrink:Shrink.nil ~print:(fun _ -> "()") Gen.unit let bool = make_scalar ~print:string_of_bool Gen.bool let float = make_scalar ~print:string_of_float Gen.float let pos_float = make_scalar ~print:string_of_float Gen.pfloat let neg_float = make_scalar ~print:string_of_float Gen.nfloat let float_bound_inclusive bound = make_scalar ~print:string_of_float (Gen.float_bound_inclusive bound) let float_bound_exclusive bound = make_scalar ~print:string_of_float (Gen.float_bound_exclusive bound) let float_range low high = make_scalar ~print:string_of_float (Gen.float_range low high) let int = make_int Gen.int let int_bound n = make_int (Gen.int_bound n) let int_range a b = make_int (Gen.int_range a b) let (--) = int_range let pos_int = make_int Gen.pint let small_int = make_int Gen.small_int let small_nat = make_int Gen.small_nat let small_signed_int = make_int Gen.small_signed_int let small_int_corners () = make_int (Gen.nng_corners ()) let neg_int = make_int Gen.neg_int let int32 = make ~print:(fun i -> Int32.to_string i ^ "l") ~small:small1 ~shrink:Shrink.int32 Gen.ui32 let int64 = make ~print:(fun i -> Int64.to_string i ^ "L") ~small:small1 ~shrink:Shrink.int64 Gen.ui64 let char = make_scalar ~print:(sprintf "%C") Gen.char let printable_char = make_scalar ~print:(sprintf "%C") Gen.printable let numeral_char = make_scalar ~print:(sprintf "%C") Gen.numeral let string_gen_of_size size gen = make ~shrink:Shrink.string ~small:String.length ~print:(sprintf "%S") (Gen.string_size ~gen size) let string_gen gen = make ~shrink:Shrink.string ~small:String.length ~print:(sprintf "%S") (Gen.string ~gen) let string = string_gen Gen.char let string_of_size size = string_gen_of_size size Gen.char let small_string = string_gen_of_size Gen.small_nat Gen.char let printable_string = string_gen Gen.printable let printable_string_of_size size = string_gen_of_size size Gen.printable let small_printable_string = string_gen_of_size Gen.small_nat Gen.printable let numeral_string = string_gen Gen.numeral let numeral_string_of_size size = string_gen_of_size size Gen.numeral let list_sum_ f l = List.fold_left (fun acc x-> f x+acc) 0 l let mk_list a gen = (* small sums sub-sizes if present, otherwise just length *) let small = _opt_map_or a.small ~f:list_sum_ ~d:List.length in let print = _opt_map a.print ~f:Print.list in make ~small ~shrink:(Shrink.list ?shrink:a.shrink) ?print gen let list a = mk_list a (Gen.list a.gen) let list_of_size size a = mk_list a (Gen.list_size size a.gen) let small_list a = mk_list a (Gen.small_list a.gen) let array_sum_ f a = Array.fold_left (fun acc x -> f x+acc) 0 a let array a = let small = _opt_map_or ~d:Array.length ~f:array_sum_ a.small in make ~small ~shrink:(Shrink.array ?shrink:a.shrink) ?print:(_opt_map ~f:Print.array a.print) (Gen.array a.gen) let array_of_size size a = let small = _opt_map_or ~d:Array.length ~f:array_sum_ a.small in make ~small ~shrink:(Shrink.array ?shrink:a.shrink) ?print:(_opt_map ~f:Print.array a.print) (Gen.array_size size a.gen) let pair a b = make ?small:(_opt_map_2 ~f:(fun f g (x,y) -> f x+g y) a.small b.small) ?print:(_opt_map_2 ~f:Print.pair a.print b.print) ~shrink:(Shrink.pair (_opt_or a.shrink Shrink.nil) (_opt_or b.shrink Shrink.nil)) (Gen.pair a.gen b.gen) let triple a b c = make ?small:(_opt_map_3 ~f:(fun f g h (x,y,z) -> f x+g y+h z) a.small b.small c.small) ?print:(_opt_map_3 ~f:Print.triple a.print b.print c.print) ~shrink:(Shrink.triple (_opt_or a.shrink Shrink.nil) (_opt_or b.shrink Shrink.nil) (_opt_or c.shrink Shrink.nil)) (Gen.triple a.gen b.gen c.gen) let quad a b c d = make ?small:(_opt_map_4 ~f:(fun f g h i (x,y,z,w) -> f x+g y+h z+i w) a.small b.small c.small d.small) ?print:(_opt_map_4 ~f:Print.quad a.print b.print c.print d.print) ~shrink:(Shrink.quad (_opt_or a.shrink Shrink.nil) (_opt_or b.shrink Shrink.nil) (_opt_or c.shrink Shrink.nil) (_opt_or d.shrink Shrink.nil)) (Gen.quad a.gen b.gen c.gen d.gen) let option ?ratio a = let g = Gen.opt ?ratio a.gen and shrink = _opt_map a.shrink ~f:Shrink.option and small = _opt_map_or a.small ~d:(function None -> 0 | Some _ -> 1) ~f:(fun f o -> match o with None -> 0 | Some x -> f x) in make ~small ?shrink ?print:(_opt_map ~f:Print.option a.print) g let map ?rev f a = make ?print:(_opt_map_2 rev a.print ~f:(fun r p x -> p (r x))) ?small:(_opt_map_2 rev a.small ~f:(fun r s x -> s (r x))) ?shrink:(_opt_map_2 rev a.shrink ~f:(fun r g x -> Iter.(g (r x) >|= f))) ?collect:(_opt_map_2 rev a.collect ~f:(fun r f x -> f (r x))) (fun st -> f (a.gen st)) let fun1_unsafe : 'a arbitrary -> 'b arbitrary -> ('a -> 'b) arbitrary = fun a1 a2 -> let magic_object = Obj.magic (object end) in let gen : ('a -> 'b) Gen.t = fun st -> let h = Hashtbl.create 10 in fun x -> if x == magic_object then Obj.magic h else try Hashtbl.find h x with Not_found -> let b = a2.gen st in Hashtbl.add h x b; b in let pp : (('a -> 'b) -> string) option = _opt_map_2 a1.print a2.print ~f:(fun p1 p2 f -> let h : ('a, 'b) Hashtbl.t = Obj.magic (f magic_object) in let b = Buffer.create 20 in Hashtbl.iter (fun key value -> Printf.bprintf b "%s -> %s; " (p1 key) (p2 value)) h; "{" ^ Buffer.contents b ^ "}" ) in make ?print:pp gen let fun2_unsafe gp1 gp2 gp3 = fun1_unsafe gp1 (fun1_unsafe gp2 gp3) module Poly_tbl : sig type ('a, 'b) t val create: 'a Observable.t -> 'b arbitrary -> int -> ('a, 'b) t Gen.t val get : ('a, 'b) t -> 'a -> 'b option val size : ('b -> int) -> (_, 'b) t -> int val shrink1 : ('a, 'b) t Shrink.t val shrink2 : 'b Shrink.t -> ('a, 'b) t Shrink.t val print : (_,_) t Print.t end = struct type ('a, 'b) t = { get : 'a -> 'b option; p_size: ('b->int) -> int; p_shrink1: ('a, 'b) t Iter.t; p_shrink2: 'b Shrink.t -> ('a, 'b) t Iter.t; p_print: unit -> string; } let create (type k)(type v) k v size st : (k,v) t = let module T = Hashtbl.Make(struct type t = k let equal = k.Observable.eq let hash = k.Observable.hash end) in let tbl_to_list tbl = T.fold (fun k v l -> (k,v)::l) tbl [] and tbl_of_list l = let tbl = T.create (max (List.length l) 8) in List.iter (fun (k,v) -> T.add tbl k v) l; tbl in (* make a table @param extend if true, extend table on the fly *) let rec make ~extend tbl = { get=(fun x -> try Some (T.find tbl x) with Not_found -> if extend then ( let v = v.gen st in T.add tbl x v; Some v ) else None); p_print=(fun () -> match v.print with | None -> "" | Some pp_v -> let b = Buffer.create 64 in T.iter (fun key value -> Printf.bprintf b "%s -> %s; " (k.Observable.print key) (pp_v value)) tbl; Buffer.contents b); p_shrink1=(fun yield -> Shrink.list (tbl_to_list tbl) (fun l -> yield (make ~extend:false (tbl_of_list l))) ); p_shrink2=(fun shrink_val yield -> (* shrink bindings one by one *) T.iter (fun x y -> shrink_val y (fun y' -> let tbl' = T.copy tbl in T.replace tbl' x y'; yield (make ~extend:false tbl'))) tbl); p_size=(fun size_v -> T.fold (fun _ v n -> n + size_v v) tbl 0); } in make ~extend:true (T.create size) let get t x = t.get x let shrink1 t = t.p_shrink1 let shrink2 p t = t.p_shrink2 p let print t = t.p_print () let size p t = t.p_size p end (** Internal representation of functions *) type ('a, 'b) fun_repr_tbl = { fun_tbl: ('a, 'b) Poly_tbl.t; fun_arb: 'b arbitrary; fun_default: 'b; } type 'f fun_repr = | Fun_tbl : ('a, 'ret) fun_repr_tbl -> ('a -> 'ret) fun_repr | Fun_map : ('f1 -> 'f2) * 'f1 fun_repr -> 'f2 fun_repr type _ fun_ = | Fun : 'f fun_repr * 'f -> 'f fun_ (** Reifying functions *) module Fn = struct type 'a t = 'a fun_ let apply (Fun (_,f)) = f let make_ (r:_ fun_repr) : _ fun_ = let rec call : type f. f fun_repr -> f = fun r -> match r with | Fun_tbl r -> begin fun x -> match Poly_tbl.get r.fun_tbl x with | None -> r.fun_default | Some y -> y end | Fun_map (g, r') -> g (call r') in Fun (r, call r) let mk_repr tbl arb def = Fun_tbl { fun_tbl=tbl; fun_arb=arb; fun_default=def; } let map_repr f repr = Fun_map (f,repr) let map_fun f (Fun (repr,_)) = make_ (map_repr f repr) let shrink_rep (r: _ fun_repr): _ Iter.t = let open Iter in let rec aux : type f. f fun_repr Shrink.t = function | Fun_tbl {fun_arb=a; fun_tbl=tbl; fun_default=def} -> let sh_v = match a.shrink with None -> Shrink.nil | Some s->s in (Poly_tbl.shrink1 tbl >|= fun tbl' -> mk_repr tbl' a def) <+> (sh_v def >|= fun def' -> mk_repr tbl a def') <+> (Poly_tbl.shrink2 sh_v tbl >|= fun tbl' -> mk_repr tbl' a def) | Fun_map (g, r') -> aux r' >|= map_repr g in aux r let shrink (Fun (rep,_)) = let open Iter in shrink_rep rep >|= make_ let rec size_rep : type f. f fun_repr -> int = function | Fun_map (_, r') -> size_rep r' | Fun_tbl r -> let size_v x = match r.fun_arb.small with None -> 0 | Some f -> f x in Poly_tbl.size size_v r.fun_tbl + size_v r.fun_default let size (Fun (rep,_)) = size_rep rep let print_rep r = let buf = Buffer.create 32 in let rec aux : type f. Buffer.t -> f fun_repr -> unit = fun buf r -> match r with | Fun_map (_, r') -> aux buf r' | Fun_tbl r -> Buffer.add_string buf (Poly_tbl.print r.fun_tbl); Printf.bprintf buf "_ -> %s" (match r.fun_arb.print with | None -> "" | Some s -> s r.fun_default ); in Printf.bprintf buf "{"; aux buf r; Printf.bprintf buf "}"; Buffer.contents buf let print (Fun (rep,_)) = print_rep rep let gen_rep (a:_ Observable.t) (b:_ arbitrary): _ fun_repr Gen.t = fun st -> mk_repr (Poly_tbl.create a b 8 st) b (b.gen st) let gen a b = Gen.map make_ (gen_rep a b) end let fun1 o ret = make ~shrink:Fn.shrink ~print:Fn.print ~small:Fn.size (Fn.gen o ret) module Tuple = struct (** heterogeneous list (generic tuple) used to uncurry functions *) type 'a t = | Nil : unit t | Cons : 'a * 'b t -> ('a * 'b) t let nil = Nil let cons x tail = Cons (x,tail) type 'a obs = | O_nil : unit obs | O_cons : 'a Observable.t * 'b obs -> ('a * 'b) obs let o_nil = O_nil let o_cons x tail = O_cons (x,tail) let rec hash : type a. a obs -> a t -> int = fun o t -> match o, t with | O_nil, Nil -> 42 | O_cons (o,tail_o), Cons (x, tail) -> Observable.H.combine (Observable.hash o x) (hash tail_o tail) let rec equal : type a. a obs -> a t -> a t -> bool = fun o a b -> match o, a, b with | O_nil, Nil, Nil -> true | O_cons (o, tail_o), Cons (x1, tail1), Cons (x2,tail2) -> Observable.equal o x1 x2 && equal tail_o tail1 tail2 let print o tup = let rec aux : type a. a obs -> Buffer.t -> a t -> unit = fun o buf t -> match o, t with | O_nil, Nil -> Printf.bprintf buf "()" | O_cons (o, O_nil), Cons (x,Nil) -> Printf.bprintf buf "%s" (Observable.print o x) | O_cons (o, tail_o), Cons (x,tail) -> Printf.bprintf buf "%s, %a" (Observable.print o x) (aux tail_o) tail in let buf = Buffer.create 64 in Buffer.add_string buf "("; aux o buf tup; Buffer.add_string buf ")"; Buffer.contents buf let observable (o:'a obs) : 'a t Observable.t = Observable.make ~eq:(equal o) ~hash:(hash o) (print o) let gen (o:'a obs) (ret:'b arbitrary) : ('a t -> 'b) fun_ Gen.t = Fn.gen (observable o) ret module Infix = struct let (@::) x tail = cons x tail let (@->) o tail = o_cons o tail end include Infix end let fun_nary (o:_ Tuple.obs) ret : _ arbitrary = make ~shrink:Fn.shrink ~print:Fn.print ~small:Fn.size (Tuple.gen o ret) let fun2 o1 o2 ret = let open Tuple in map ~rev:(Fn.map_fun (fun g (Cons (x, Cons (y,Nil))) -> g x y)) (Fn.map_fun (fun g x y -> g (x @:: y @:: nil))) (fun_nary (o1 @-> o2 @-> o_nil) ret) let fun3 o1 o2 o3 ret = let open Tuple in map ~rev:(Fn.map_fun (fun g (Cons (x, Cons (y, Cons (z,Nil)))) -> g x y z)) (Fn.map_fun (fun g x y z -> g (x @:: y @:: z @:: nil))) (fun_nary (o1 @-> o2 @-> o3 @-> o_nil) ret) let fun4 o1 o2 o3 o4 ret = let open Tuple in map ~rev:(Fn.map_fun (fun g (Cons (x, Cons (y, Cons (z,Cons (w,Nil))))) -> g x y z w)) (Fn.map_fun (fun g x y z w -> g (x @:: y @:: z @:: w @:: nil))) (fun_nary (o1 @-> o2 @-> o3 @-> o4 @-> o_nil) ret) (* Generator combinators *) (** given a list, returns generator that picks at random from list *) let oneofl ?print ?collect xs = make ?print ?collect (Gen.oneofl xs) let oneofa ?print ?collect xs = make ?print ?collect (Gen.oneofa xs) (** Given a list of generators, returns generator that randomly uses one of the generators from the list *) let oneof l = let gens = List.map (fun a->a.gen) l in let first = List.hd l in let print = first.print and small = first.small and collect = first.collect and shrink = first.shrink in make ?print ?small ?collect ?shrink (Gen.oneof gens) (** Generator that always returns given value *) let always ?print x = let gen _st = x in make ?print gen (** like oneof, but with weights *) let frequency ?print ?small ?shrink ?collect l = let first = snd (List.hd l) in let small = _opt_sum small first.small in let print = _opt_sum print first.print in let shrink = _opt_sum shrink first.shrink in let collect = _opt_sum collect first.collect in let gens = List.map (fun (x,y) -> x, y.gen) l in make ?print ?small ?shrink ?collect (Gen.frequency gens) (** Given list of [(frequency,value)] pairs, returns value with probability proportional to given frequency *) let frequencyl ?print ?small l = make ?print ?small (Gen.frequencyl l) let frequencya ?print ?small l = make ?print ?small (Gen.frequencya l) let map_same_type f a = adapt_ a (fun st -> f (a.gen st)) let map_keep_input ?print ?small f a = make ?print:(match print, a.print with | Some f1, Some f2 -> Some (Print.pair f2 f1) | Some f, None -> Some (Print.comap snd f) | None, Some f -> Some (Print.comap fst f) | None, None -> None) ?small:(match small, a.small with | Some f, _ -> Some (fun (_,y) -> f y) | None, Some f -> Some (fun (x,_) -> f x) | None, None -> None) ?shrink:(match a.shrink with | None -> None | Some s -> let s' (x,_) = Iter.map (fun x->x, f x) (s x) in Some s') Gen.(map_keep_input f a.gen) module TestResult = struct type 'a counter_ex = 'a QCheck2.TestResult.counter_ex = { instance: 'a; (** The counter-example(s) *) shrink_steps: int; (** How many shrinking steps for this counterex *) msg_l: string list; (** messages. @since 0.7 *) } type 'a failed_state = 'a counter_ex list (** Result state. changed in 0.10 (move to inline records) *) type 'a state = 'a QCheck2.TestResult.state = | Success | Failed of { instances: 'a failed_state; (** Failed instance(s) *) } | Failed_other of {msg: string} | Error of { instance: 'a counter_ex; exn: exn; backtrace: string; } (** Error, backtrace, and instance that triggered it *) (* result returned by running a test *) type 'a t = 'a QCheck2.TestResult.t let get_count = QCheck2.TestResult.get_count let get_count_gen = QCheck2.TestResult.get_count_gen let get_state = QCheck2.TestResult.get_state let stats = QCheck2.TestResult.stats let collect = QCheck2.TestResult.collect let warnings = QCheck2.TestResult.warnings let is_success = QCheck2.TestResult.is_success end module Test = struct type res = QCheck2.Test.res = | Success | Failure | FalseAssumption | Error of exn * string type 'a event = 'a QCheck2.Test.event = | Generating | Collecting of 'a | Testing of 'a | Shrunk of int * 'a | Shrinking of int * int * 'a type 'a cell = 'a QCheck2.Test.cell type 'a handler = 'a QCheck2.Test.handler type 'a step = 'a QCheck2.Test.step type 'a callback = 'a QCheck2.Test.callback type t = QCheck2.Test.t include QCheck2.Test_exceptions let print_instance = QCheck2.Test.print_instance let print_c_ex = QCheck2.Test.print_c_ex let print_error = QCheck2.Test.print_error let print_fail = QCheck2.Test.print_fail let print_fail_other = QCheck2.Test.print_fail_other let print_test_fail = QCheck2.Test.print_test_fail let print_test_error = QCheck2.Test.print_test_error let set_name = QCheck2.Test.set_name let get_law = QCheck2.Test.get_law let get_name = QCheck2.Test.get_name let get_count = QCheck2.Test.get_count let get_long_factor = QCheck2.Test.get_long_factor let make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small:_removed_in_qcheck_2 ?name arb law = let {gen; shrink; print; collect; stats; _} = arb in QCheck2.Test.make_cell_from_QCheck1 ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ~gen ?shrink ?print ?collect ~stats law let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?name arb law = QCheck2.Test.Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?name arb law) let fail_report = QCheck2.Test.fail_report let fail_reportf = QCheck2.Test.fail_reportf let check_cell_exn = QCheck2.Test.check_cell_exn let check_exn = QCheck2.Test.check_exn let check_cell = QCheck2.Test.check_cell end let find_example ?(name="") ?count ~f g : _ Gen.t = (* the random generator of examples satisfying [f]. To do that we test the property [fun x -> not (f x)]; any counter-example *) let gen st = let cell = let arb = make g in Test.make_cell ~max_fail:1 ?count arb (fun x -> not (f x)) in let res = QCheck2.Test.check_cell ~rand:st cell in begin match QCheck2.TestResult.get_state res with | QCheck2.TestResult.Success -> raise (No_example_found name) | QCheck2.TestResult.Error _ -> raise (No_example_found name) | QCheck2.TestResult.Failed {instances=[]} -> assert false | QCheck2.TestResult.Failed {instances=failed::_} -> (* found counter-example! *) failed.QCheck2.TestResult.instance | QCheck2.TestResult.Failed_other {msg=_} -> raise (No_example_found name) end in gen let find_example_gen ?rand ?name ?count ~f g = let g = find_example ?name ?count ~f g in Gen.generate1 ?rand g qcheck-0.18.1/src/core/QCheck.mli000066400000000000000000001312411417677125000164330ustar00rootroot00000000000000(* QCheck: Random testing for OCaml copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard, Julien Debon, Valentin Chaboche all rights reserved. *) (** {1 Quickcheck inspired property-based testing} *) (** The library takes inspiration from Haskell's QuickCheck library. The rough idea is that the programmer describes invariants that values of a certain type need to satisfy ("properties"), as functions from this type to bool. She also needs to describe how to generate random values of the type, so that the property is tried and checked on a number of random instances. This explains the organization of this module: - {! 'a arbitrary} is used to describe how to generate random values, shrink them (make counter-examples as small as possible), print them, etc. Auxiliary modules such as {!Gen}, {!Print}, and {!Shrink} can be used along with {!make} to build one's own arbitrary instances. - {!Test} is used to describe a single test, that is, a property of type ['a -> bool] combined with an ['a arbitrary] that is used to generate the test cases for this property. Optional parameters allow to specify the random generator state, number of instances to generate and test, etc. Examples: - List.rev is involutive: {[ let test = QCheck.(Test.make ~count:1000 (list int) (fun l -> List.rev (List.rev l) = l));; QCheck.Test.check_exn test;; ]} - Not all lists are sorted (false property that will fail. The 15 smallest counter-example lists will be printed): {[ let test = QCheck.( Test.make ~count:10_000 ~max_fail:3 (list small_nat) (fun l -> l = List.sort compare l));; QCheck.Test.check_exn test;; ]} - generate 20 random trees using {! Gen.fix} : {[ type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let g = QCheck.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] )) Gen.generate ~n:20 g;; ]} More complex and powerful combinators can be found in Gabriel Scherer's {!Generator} module. Its documentation can be found {{:http://gasche.github.io/random-generator/doc/Generator.html } here}. *) val (==>) : bool -> bool -> bool (** [b1 ==> b2] is the logical implication [b1 => b2] ie [not b1 || b2] (except that it is strict and will interact better with {!Test.check_exn} and the likes, because they will know the precondition was not satisfied.). {b WARNING}: this function should only be used in a property (see {!Test.make}), because it raises a special exception in case of failure of the first argument, to distinguish between failed test and failed precondition. Because of OCaml's evaluation order, both [b1] and [b2] are always evaluated; if [b2] should only be evaluated when [b1] holds, see {!assume}. *) val assume : bool -> unit (** [assume cond] checks the precondition [cond], and does nothing if [cond=true]. If [cond=false], it interrupts the current test. {b WARNING} This function, like {!(==>)}, should only be used in a test, not outside. Example: {[ Test.make (list int) (fun l -> assume (l <> []); List.hd l :: List.tl l = l) ]} @since 0.5.1 *) val assume_fail : unit -> 'a (** [assume_fail ()] is like [assume false], but can take any type since we know it always fails (like [assert false]). This is useful to ignore some branches in [if] or [match]. Example: {[ Test.make (list int) (function | [] -> assume_fail () | _::_ as l -> List.hd l :: List.tl l = l) ]} @since 0.5.1 *) (** {2 Generate Random Values} *) module Gen : sig type 'a t = Random.State.t -> 'a (** A random generator for values of type 'a. *) type 'a sized = int -> Random.State.t -> 'a (** Random generator with a size bound. *) val return : 'a -> 'a t (** Create a constant generator. *) val pure : 'a -> 'a t (** Synonym for {!return} @since 0.8 *) val (>>=) : 'a t -> ('a -> 'b t) -> 'b t (** Monadic bind for writing dependent generators. First generates an ['a] and then passes it to the given function, to generate a ['b]. *) val (<*>) : ('a -> 'b) t -> 'a t -> 'b t (** Infix operator for composing a function generator and an argument generator into a result generator. *) val map : ('a -> 'b) -> 'a t -> 'b t (** [map f g] transforms a generator [g] by applying [f] to each generated element. *) val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t (** [map2 f g1 g2] transforms two generators [g1] and [g2] by applying [f] to each pair of generated elements. *) val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t (** [map3 f g1 g2 g3] transforms three generators [g1], [g2], and [g3] by applying [f] to each triple of generated elements. *) val map_keep_input : ('a -> 'b) -> 'a t -> ('a * 'b) t (** [map_keep_input f g] transforms a generator [g] by applying [f] to each generated element. Returns both the generated element from [g] and the output from [f]. *) val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** An infix synonym for {!map}. *) val (<$>) : ('a -> 'b) -> 'a t -> 'b t (** An infix synonym for {!map} @since 0.13 *) val oneof : 'a t list -> 'a t (** Constructs a generator that selects among a given list of generators. @raise Invalid_argument or Failure if list is empty *) val oneofl : 'a list -> 'a t (** Constructs a generator that selects among a given list of values. @raise Invalid_argument or Failure if list is empty *) val oneofa : 'a array -> 'a t (** Constructs a generator that selects among a given array of values. @raise Invalid_argument or Failure if list is empty *) val frequency : (int * 'a t) list -> 'a t (** Constructs a generator that selects among a given list of generators. Each of the given generators are chosen based on a positive integer weight. *) val frequencyl : (int * 'a) list -> 'a t (** Constructs a generator that selects among a given list of values. Each of the given values are chosen based on a positive integer weight. *) val frequencya : (int * 'a) array -> 'a t (** Constructs a generator that selects among a given array of values. Each of the array entries are chosen based on a positive integer weight. *) val shuffle_a : 'a array -> unit t (** Shuffles the array in place. *) val shuffle_l : 'a list -> 'a list t (** Creates a generator of shuffled lists. *) val shuffle_w_l : (int * 'a) list -> 'a list t (** Creates a generator of weighted shuffled lists. A given list is shuffled on each generation according to the weights of its elements. An element with a larger weight is more likely to be at the front of the list than an element with a smaller weight. If we want to pick random elements from the (head of) list but need to prioritize some elements over others, this generator can be useful. Example: given a weighted list [[1, "one"; 5, "five"; 10, "ten"]], the generator is more likely to generate [["ten"; "five"; "one"]] or [["five"; "ten"; "one"]] than [["one"; "ten"; "five"]] because "ten" and "five" have larger weights than "one". @since 0.11 *) val range_subset : size:int -> int -> int -> int array t (** [range_subset ~size:k low high] generates an array of length [k] of sorted distinct integers in the range [low..high] (included). Complexity O(k log k), drawing [k] random integers. @raise Invalid_argument outside the valid region [0 <= k <= high-low+1]. @since 0.18 *) val array_subset : int -> 'a array -> 'a array t (** [array_subset k arr] generates a sub-array of [k] elements at distinct positions in the input array [arr], in the same order. Complexity O(k log k), drawing [k] random integers. @raise Invalid_argument outside the valid region [0 <= size <= Array.length arr]. @since 0.18 *) val unit : unit t (** The unit generator. *) val bool : bool t (** The boolean generator. *) val float : float t (** Generates floating point numbers. *) val pfloat : float t (** Generates positive floating point numbers (0. included). *) val nfloat : float t (** Generates negative floating point numbers. (-0. included) *) val float_bound_inclusive : float -> float t (** [float_bound_inclusive bound] returns a random floating-point number between 0 and [bound] (inclusive). If [bound] is negative, the result is negative or zero. If [bound] is 0, the result is 0. @since 0.11 *) val float_bound_exclusive : float -> float t (** [float_bound_exclusive bound] returns a random floating-point number between 0 and [bound] (exclusive). If [bound] is negative, the result is negative or zero. @raise Invalid_argument if [bound] is zero. @since 0.11 *) val float_range : float -> float -> float t (** [float_range low high] generates floating-point numbers within [low] and [high] (inclusive) @raise Invalid_argument if [high < low] or if the range is larger than [max_float]. @since 0.11 *) val (--.) : float -> float -> float t (** Synonym for [float_range] @since 0.11 *) val nat : int t (** Generates small natural numbers. *) val big_nat : int t (** Generates natural numbers, possibly large. @since 0.10 *) val neg_int : int t (** Generates non-strictly negative integers (0 included). *) val pint : int t (** Generates non-strictly positive integers uniformly (0 included). *) val int : int t (** Generates integers uniformly. *) val small_nat : int t (** Small integers (< 100) @since 0.5.1 *) val small_int : int t (** Small UNSIGNED integers, for retrocompatibility. @deprecated use {!small_nat}. *) val small_signed_int : int t (** Small SIGNED integers, based on {!small_nat}. @since 0.5.2 *) val int_bound : int -> int t (** Uniform integer generator producing integers within [0... bound]. For [bound < 2^{30} - 1] uses [Random.State.int] for integer generation. @raise Invalid_argument if the argument is negative. *) val int_range : int -> int -> int t (** Uniform integer generator producing integers within [low,high]. @raise Invalid_argument if [low > high]. *) val graft_corners : 'a t -> 'a list -> unit -> 'a t (** [graft_corners gen l ()] makes a new generator that enumerates the corner cases in [l] and then behaves like [g]. @since 0.6 *) val int_pos_corners : int list (** Non-negative corner cases for int. @since 0.6 *) val int_corners : int list (** All corner cases for int. @since 0.6 *) val (--) : int -> int -> int t (** Synonym to {!int_range}. *) val ui32 : int32 t (** Generates (unsigned) [int32] values. *) val ui64 : int64 t (** Generates (unsigned) [int64] values. *) val list : 'a t -> 'a list t (** Builds a list generator from an element generator. List size is generated by {!nat}. *) val list_size : int t -> 'a t -> 'a list t (** Builds a list generator from a (non-negative) size generator and an element generator. *) val list_repeat : int -> 'a t -> 'a list t (** [list_repeat i g] builds a list generator from exactly [i] elements generated by [g]. *) val array : 'a t -> 'a array t (** Builds an array generator from an element generator. Array size is generated by {!nat}. *) val array_size : int t -> 'a t -> 'a array t (** Builds an array generator from a (non-negative) size generator and an element generator. *) val array_repeat : int -> 'a t -> 'a array t (** [array_repeat i g] builds an array generator from exactly [i] elements generated by [g]. *) val opt : ?ratio:float -> 'a t -> 'a option t (** An option generator, with optional ratio. @param ratio a float between [0.] and [1.] indicating the probability of a sample to be [Some _] rather than [None]. @since 0.18 ([?ratio] parameter) *) val pair : 'a t -> 'b t -> ('a * 'b) t (** Generates pairs. *) val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t (** Generates triples. *) val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t (** Generates quadruples. @since 0.5.1 *) val char : char t (** Generates characters upto character code 255. *) val printable : char t (** Generates printable characters. *) val numeral : char t (** Generates numeral characters. *) val char_range : char -> char -> char t (** Generates chars between the two bounds, inclusive. Example: [char_range 'a' 'z'] for all lower case ascii letters. @since 0.13 *) val string_size : ?gen:char t -> int t -> string t (** Builds a string generator from a (non-negative) size generator. Accepts an optional character generator (the default is {!char}). *) val string : ?gen:char t -> string t (** Builds a string generator. String size is generated by {!nat}. Accepts an optional character generator (the default is {!char}). See also {!string_of} and {!string_readable} for versions without optional parameters. *) val string_of : char t -> string t (** Builds a string generator using the given character generator. @since 0.11 *) val string_readable : string t (** Builds a string generator using the {!printable} character generator. @since 0.11 @deprecated use {!string_printable} *) [@@deprecated "see string_printable"] val string_printable : string t (** Builds a string generator using the {!printable} character generator. @since 0.18 *) val small_string : ?gen:char t -> string t (** Builds a string generator, length is {!small_nat} Accepts an optional character generator (the default is {!char}). *) val small_list : 'a t -> 'a list t (** Generates lists of small size (see {!small_nat}). @since 0.5.3 *) val flatten_l : 'a t list -> 'a list t (** Generate a list of elements from individual generators @since 0.13 *) val flatten_a : 'a t array -> 'a array t (** Generate an array of elements from individual generators @since 0.13 *) val flatten_opt : 'a t option -> 'a option t (** Generate an option from an optional generator @since 0.13 *) val flatten_res : ('a t, 'e) result -> ('a,'e) result t (** Generate a result from [Ok g], an error from [Error e] @since 0.13 *) val small_array : 'a t -> 'a array t (** Generates arrays of small size (see {!small_nat}). @since 0.10 *) val join : 'a t t -> 'a t (** Collapses a generator of generators to simply a generator. @since 0.5 *) val sized : 'a sized -> 'a t (** Creates a generator from a size-bounded generator by first generating a size using {!nat} and passing the result to the size-bounded generator. *) val sized_size : int t -> 'a sized -> 'a t (** Creates a generator from a size-bounded generator by first generating a size using the integer generator and passing the result to the size-bounded generator. @since 0.5 *) val fix : (('a -> 'b t) -> ('a -> 'b t)) -> 'a -> 'b t (** Parametrized fixpoint combinator for generating recursive values. The fixpoint is parametrized over an arbitrary state ('a), and the fixpoint computation may change the value of this state in the recursive calls. In particular, this can be used for size-bounded generators ('a is int). The passed size-parameter should decrease to ensure termination. *) (** Example: {[ type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let g = QCheck.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] )) ]} *) val nat_split2 : int -> (int * int) t (** [nat_split2 n] generates pairs [(n1, n2)] of natural numbers with [n1 + n2 = n]. This is useful to split sizes to combine sized generators. @since 0.18 *) val pos_split2 : int -> (int * int) t (** [pos_split2 n] generates pairs [(n1, n2)] of strictly positive (nonzero) natural numbers with [n1 + n2 = n]. @raise Invalid_argument unless [n >= 2]. This is useful to split sizes to combine sized generators. @since 0.18 *) val nat_split : size:int -> int -> int array t (** [nat_split ~size:k n] generates [k]-sized arrays [n1,n2,..nk] of natural numbers in [[0;n]] with [n1 + n2 + ... + nk = n]. This is useful to split sizes to combine sized generators. Complexity O(k log k). @since 0.18 *) val pos_split : size:int -> int -> int array t (** [pos_split ~size:k n] generates [k]-sized arrays [n1,n2,..nk] of strictly positive (non-zero) natural numbers with [n1 + n2 + ... + nk = n]. This is useful to split sizes to combine sized generators. Complexity O(k log k). @raise Invalid_argument unless [0 < k <= n] or [0 = k = n]. @since 0.18 *) val delay : (unit -> 'a t) -> 'a t (** Delay execution of some code until the generator is actually called. This can be used to manually implement recursion or control flow in a generator. @since 0.17 *) val generate : ?rand:Random.State.t -> n:int -> 'a t -> 'a list (** [generate ~n g] generates [n] instances of [g]. *) val generate1 : ?rand:Random.State.t -> 'a t -> 'a (** [generate1 g] generates one instance of [g]. *) val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t val ( and* ) : 'a t -> 'b t -> ('a * 'b) t end (** {2 Pretty printing} *) (** {2 Show Values} *) module Print : sig type 'a t = 'a -> string (** Printer for values of type ['a]. *) val unit : unit t (** @since 0.6 *) val int : int t (** Integer printer. *) val bool : bool t (** Boolean printer. *) val float : float t (** Floating point number printer. *) val char : char t (** Character printer. *) val string : string t (** String printer. *) val option : 'a t -> 'a option t (** Option printer. *) val pair : 'a t -> 'b t -> ('a*'b) t (** Pair printer. Expects printers for each component. *) val triple : 'a t -> 'b t -> 'c t -> ('a*'b*'c) t (** Triple (3-tuple) printer. Expects printers for each component. *) val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a*'b*'c*'d) t (** Quadruple (4-tuple) printer. Expects printers for each component. *) val list : 'a t -> 'a list t (** List printer. Expects a printer for the list element type. *) val array : 'a t -> 'a array t (** Array printer. Expects a printer for the array entry type. *) val comap : ('a -> 'b) -> 'b t -> 'a t (** [comap f p] maps [p], a printer of type ['b], to a printer of type ['a] by first converting a printed value using [f : 'a -> 'b]. *) end (** {2 Iterators} Compatible with the library "sequence". An iterator [i] is simply a function that accepts another function [f] (of type ['a -> unit]) and calls [f] on a sequence of elements [f x1; f x2; ...; f xn]. *) module Iter : sig type 'a t = ('a -> unit) -> unit val empty : 'a t val return : 'a -> 'a t val (<*>) : ('a -> 'b) t -> 'a t -> 'b t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val map : ('a -> 'b) -> 'a t -> 'b t val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val (>|=) : 'a t -> ('a -> 'b) -> 'b t val append : 'a t -> 'a t -> 'a t val (<+>) : 'a t -> 'a t -> 'a t (** Synonym to {!append}. *) val of_list : 'a list -> 'a t val of_array : 'a array -> 'a t val pair : 'a t -> 'b t -> ('a * 'b) t val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t val find : ('a -> bool) -> 'a t -> 'a option val filter : ('a -> bool) -> 'a t -> 'a t val append_l : 'a t list -> 'a t (** @since 0.8 *) val flatten : 'a t t -> 'a t (** @since 0.8 *) val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t val ( and* ) : 'a t -> 'b t -> ('a * 'b) t end (** {2 Shrink Values} Shrinking is used to reduce the size of a counter-example. It tries to make the counter-example smaller by decreasing it, or removing elements, until the property to test holds again; then it returns the smallest value that still made the test fail. *) module Shrink : sig type 'a t = 'a -> 'a Iter.t (** Given a counter-example, return an iterator on smaller versions of the counter-example. *) val nil : 'a t (** No shrink *) val unit : unit t (** @since 0.6 *) val char : char t (** @since 0.6 *) val int : int t val int32 : int32 t (** @since 0.14 *) val int64 : int64 t (** @since 0.14 *) val option : 'a t -> 'a option t val string : string t val filter : ('a -> bool) -> 'a t -> 'a t (** [filter f shrink] shrinks values the same as [shrink], but only keep smaller values that satisfy [f]. This way it's easy to preserve invariants that are enforced by generators, when shrinking values @since 0.8 *) val int_aggressive : int t (** Shrink integers by trying all smaller integers (can take a lot of time!) @since 0.7 *) val list : ?shrink:'a t -> 'a list t (** Try to shrink lists by removing one or more elements. @param shrink if provided, will be used to also try to reduce the elements of the list themselves (e.g. in an [int list] one can try to decrease the integers). *) val list_spine : 'a list t (** Try to shrink lists by removing one or more elements. @since 0.10 *) val list_elems : 'a t -> 'a list t (** Shrinks the elements of a list, without changing the list size. @since 0.10 *) val array : ?shrink:'a t -> 'a array t (** Shrink an array. @param shrink see {!list} *) val pair : 'a t -> 'b t -> ('a * 'b) t (** [pair a b] uses [a] to shrink the first element of tuples, then tries to shrink the second element using [b]. It is often better, when generating tuples, to put the "simplest" element first (atomic type rather than list, etc.) because it will be shrunk earlier. In particular, putting functions last might help. *) val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t (** Similar to {!pair} *) val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t (** Similar to {!pair} *) end (** {2 Observe Values} *) (** Observables are usable as arguments for random functions. The random function will observe its arguments in a way that is determined from the observable instance. Inspired from https://blogs.janestreet.com/quickcheck-for-core/ and Koen Claessen's "Shrinking and Showing functions". @since 0.6 *) module Observable : sig (** An observable for ['a], packing a printer and other things. *) type -'a t val equal : 'a t -> 'a -> 'a -> bool val hash : 'a t -> 'a -> int val print : 'a t -> 'a Print.t val unit : unit t val bool : bool t val int : int t val float : float t val string : string t val char : char t val make : ?eq:('a -> 'a -> bool) -> ?hash:('a -> int) -> 'a Print.t -> 'a t val map : ('a -> 'b) -> 'b t -> 'a t val option : 'a t -> 'a option t val list : 'a t -> 'a list t val array : 'a t -> 'a array t val pair : 'a t -> 'b t -> ('a * 'b) t val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t end (** {2 Arbitrary} A value of type ['a arbitrary] glues together a random generator, and optional functions for shrinking, printing, computing the size, etc. It is the "normal" way of describing how to generate values of a given type, to be then used in tests (see {!Test}). *) type 'a stat = string * ('a -> int) (** A statistic on a distribution of values of type ['a]. The function {b MUST} return a positive integer. *) type 'a arbitrary = private { gen: 'a Gen.t; print: ('a -> string) option; (** print values *) small: ('a -> int) option; (** size of example *) shrink: ('a Shrink.t) option; (** shrink to smaller examples *) collect: ('a -> string) option; (** map value to tag, and group by tag *) stats: 'a stat list; (** statistics to collect and print *) } (** A value of type ['a arbitrary] is an object with a method for generating random values of type ['a], and additional methods to compute the size of values, print them, and possibly shrink them into smaller counter-examples. {b NOTE} the collect field is unstable and might be removed, or moved into {!Test}. Made private since 0.8 *) val make : ?print:'a Print.t -> ?small:('a -> int) -> ?shrink:'a Shrink.t -> ?collect:('a -> string) -> ?stats:'a stat list -> 'a Gen.t -> 'a arbitrary (** Builder for arbitrary. Default is to only have a generator, but other arguments can be added. @param print printer for values (counter-examples) @param collect for statistics @param shrink to shrink counter-examples *) val set_print : 'a Print.t -> 'a arbitrary -> 'a arbitrary val set_small : ('a -> int) -> 'a arbitrary -> 'a arbitrary val set_shrink : 'a Shrink.t -> 'a arbitrary -> 'a arbitrary val set_collect : ('a -> string) -> 'a arbitrary -> 'a arbitrary val set_stats : 'a stat list -> 'a arbitrary -> 'a arbitrary (** @since 0.6 *) val add_shrink_invariant : ('a -> bool) -> 'a arbitrary -> 'a arbitrary (** Update shrinker by only keeping smaller values satisfying the given invariant. @since 0.8 *) val set_gen : 'a Gen.t -> 'a arbitrary -> 'a arbitrary (** Change the generator @since 0.7 *) val add_stat : 'a stat -> 'a arbitrary -> 'a arbitrary (** Add a statistic to the arbitrary instance. @since 0.6 *) val gen : 'a arbitrary -> 'a Gen.t (** Access the underlying random generator of this arbitrary object. @since 0.6 *) val get_gen : 'a arbitrary -> 'a Gen.t (** Access the underlying random generator of this arbitrary object. @since 0.6 *) val get_print : 'a arbitrary -> 'a Print.t option (** {2 Tests} A test is a universal property of type [foo -> bool] for some type [foo], with an object of type [foo arbitrary] used to generate, print, etc. values of type [foo]. See {!Test.make} to build a test, and {!Test.check_exn} to run one test simply. For more serious testing, it is better to create a testsuite and use {!QCheck_runner}. *) (** Result of running a test *) module TestResult : sig type 'a counter_ex = 'a QCheck2.TestResult.counter_ex = { instance: 'a; (** The counter-example(s) *) shrink_steps: int; (** How many shrinking steps for this counterex *) msg_l: string list; (** messages. @since 0.7 *) } type 'a failed_state = 'a counter_ex list (** Result state. changed in 0.10 (move to inline records, add Fail_other) *) type 'a state = 'a QCheck2.TestResult.state = | Success | Failed of { instances: 'a failed_state; (** Failed instance(s) *) } | Failed_other of {msg: string} | Error of { instance: 'a counter_ex; exn: exn; backtrace: string; } (** Error, backtrace, and instance that triggered it *) (* result returned by running a test *) type 'a t = 'a QCheck2.TestResult.t val get_count : _ t -> int (** Get the count of a cell. @since 0.5.3 *) val get_count_gen : _ t -> int val get_state : 'a t -> 'a state val collect : _ t -> (string,int) Hashtbl.t option (** Obtain statistics @since 0.6 *) val stats : 'a t -> ('a stat * (int,int) Hashtbl.t) list (** Obtain statistics @since 0.6 *) val warnings : _ t -> string list (** Obtain list of warnings @since 0.10 *) val is_success : _ t -> bool (** Returns true iff the state if [Success] @since 0.9 *) end (** Module related to individual tests. @since 0.18 most of it moved to {!QCheck2}, and the type ['a cell] was made a private implementation detail. *) module Test : sig type res = QCheck2.Test.res = | Success | Failure | FalseAssumption | Error of exn * string type 'a event = 'a QCheck2.Test.event = | Generating | Collecting of 'a | Testing of 'a | Shrunk of int * 'a | Shrinking of int * int * 'a type 'a cell = 'a QCheck2.Test.cell type 'a handler = 'a QCheck2.Test.handler type 'a step = 'a QCheck2.Test.step type 'a callback = 'a QCheck2.Test.callback type t = QCheck2.Test.t val fail_report : string -> 'a (** Fail the test with some additional message that will be reported. @since 0.7 *) val fail_reportf : ('a, Format.formatter, unit, 'b) format4 -> 'a (** Format version of {!fail_report} @since 0.7 *) val make_cell : ?if_assumptions_fail:([`Fatal | `Warning] * float) -> ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?small:('a -> int) -> ?name:string -> 'a arbitrary -> ('a -> bool) -> 'a cell (** [make_cell arb prop] builds a test that checks property [prop] on instances of the generator [arb]. @param name the name of the test. @param count number of test cases to run, counting only the test cases which satisfy preconditions. @param long_factor the factor by which to multiply count, max_gen and max_fail when running a long test (default: 1). @param max_gen maximum number of times the generation function is called in total to replace inputs that do not satisfy preconditions (should be >= count). @param max_fail maximum number of failures before we stop generating inputs. This is useful if shrinking takes too much time. @param small kept for compatibility reasons; if provided, replaces the field [arbitrary.small]. If there is no shrinking function but there is a [small] function, only the smallest failures will be printed. @param if_assumptions_fail the minimum fraction of tests that must satisfy the precondition for a success to be considered valid. The fraction should be between 0. and 1. A warning will be emitted otherwise if the flag is [`Warning], the test will be a failure if the flag is [`Fatal]. (since 0.10) *) val get_law : 'a cell -> ('a -> bool) (** @deprecated use {!QCheck2.Test.get_law} instead *) val get_name : _ cell -> string (** @deprecated use {!QCheck2.Test.get_name} instead *) val set_name : _ cell -> string -> unit (** @deprecated use {!QCheck2.Test.set_name} instead *) val get_count : _ cell -> int (** Get the count of a cell. @deprecated use {!QCheck2.Test.get_count} instead @since 0.5.3 *) val get_long_factor : _ cell -> int (** Get the long factor of a cell. @deprecated use {!QCheck2.Test.get_long_factor} instead @since 0.5.3 *) val make : ?if_assumptions_fail:([`Fatal | `Warning] * float) -> ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?small:('a -> int) -> ?name:string -> 'a arbitrary -> ('a -> bool) -> t (** [make arb prop] builds a test that checks property [prop] on instances of the generator [arb]. See {!make_cell} for a description of the parameters. *) include module type of QCheck2.Test_exceptions val print_instance : 'a cell -> 'a -> string val print_c_ex : 'a cell -> 'a TestResult.counter_ex -> string val print_fail : 'a cell -> string -> 'a TestResult.counter_ex list -> string val print_fail_other : string -> msg:string -> string val print_error : ?st:string -> 'a cell -> string -> 'a TestResult.counter_ex * exn -> string val print_test_fail : string -> string list -> string val print_test_error : string -> string -> exn -> string -> string val check_cell : ?long:bool -> ?call:'a callback -> ?step:'a step -> ?handler:'a handler -> ?rand:Random.State.t -> 'a cell -> 'a TestResult.t val check_cell_exn : ?long:bool -> ?call:'a callback -> ?step:'a step -> ?rand:Random.State.t -> 'a cell -> unit val check_exn : ?long:bool -> ?rand:Random.State.t -> t -> unit end (** {2 Sub-tests} *) (** The infrastructure used to find counter-examples to properties can also be used to find data satisfying a predicate, {i within a property being tested}. See https://github.com/c-cube/qcheck/issues/31 *) exception No_example_found of string val find_example : ?name:string -> ?count:int -> f:('a -> bool) -> 'a Gen.t -> 'a Gen.t (** [find_example ~f gen] uses [gen] to generate some values of type ['a], and checks them against [f]. If such a value is found, it is returned. Otherwise an exception is raised. {b NOTE} this should only be used from within a property in {!Test.make}. @param count number of attempts. @param name description of the example to find (used in the exception). @param f the property that the example must satisfy. @raise No_example_found if no example is found within [count] tries. @since 0.6 *) val find_example_gen : ?rand:Random.State.t -> ?name:string -> ?count:int -> f:('a -> bool) -> 'a Gen.t -> 'a (** Toplevel version of {!find_example}. [find_example_gen ~f arb ~n] is roughly the same as [Gen.generate1 (find_example ~f arb |> gen)]. @param rand the random state to use to generate inputs. @raise No_example_found if no example was found within [count] tries. @since 0.6 *) (** {2 Combinators for arbitrary} *) val choose : 'a arbitrary list -> 'a arbitrary (** Choose among the given list of generators. The list must not be empty; if it is Invalid_argument is raised. *) val unit : unit arbitrary (** Always generates [()], obviously. *) val bool : bool arbitrary (** Uniform boolean generator. *) val float : float arbitrary (** Generates regular floats (no nan and no infinities). *) (* FIXME: does not generate nan nor infinity I think. *) val pos_float : float arbitrary (** Positive float generator (no nan and no infinities). *) val neg_float : float arbitrary (** Negative float generator (no nan and no infinities). *) val float_bound_inclusive : float -> float arbitrary (** [float_bound_inclusive n] is uniform between [0] and [n] included. If [bound] is negative, the result is negative or zero. If [bound] is 0, the result is 0. @since 0.11 *) val float_bound_exclusive : float -> float arbitrary (** [float_bound_exclusive n] is uniform between [0] included and [n] excluded. If [bound] is negative, the result is negative or zero. @raise Invalid_argument if [bound] is zero. @since 0.11 *) val float_range : float -> float -> float arbitrary (** [float_range low high] is uniform between [low] included and [high] included. @raise Invalid_argument if [low > high] or if the range is larger than [max_float]. @since 0.11 *) val int : int arbitrary (** Int generator. Uniformly distributed. *) val int_bound : int -> int arbitrary (** [int_bound n] is uniform between [0] and [n] included. *) val int_range : int -> int -> int arbitrary (** [int_range a b] is uniform between [a] and [b] included. [b] must be larger than [a]. *) val small_nat : int arbitrary (** Small unsigned integers. @since 0.5.1 *) val small_int : int arbitrary (** Small unsigned integers. See {!Gen.small_int}. @deprecated use {!small_signed_int}. *) val small_signed_int : int arbitrary (** Small signed integers. @since 0.5.2 *) val (--) : int -> int -> int arbitrary (** Synonym to {!int_range}. *) val int32 : int32 arbitrary (** Int32 generator. Uniformly distributed. *) val int64 : int64 arbitrary (** Int64 generator. Uniformly distributed. *) val pos_int : int arbitrary (** Positive int generator (0 included). Uniformly distributed. See {!Gen.pint} *) val small_int_corners : unit -> int arbitrary (** As [small_int], but each newly created generator starts with a list of corner cases before falling back on random generation. *) val neg_int : int arbitrary (** Negative int generator (0 included, see {!Gen.neg_int}). The distribution is similar to that of [small_int], not of [pos_int]. *) val char : char arbitrary (** Uniformly distributed on all the chars (not just ascii or valid latin-1). *) val printable_char : char arbitrary (** Uniformly distributed over a subset of chars. *) (* FIXME: describe which subset. *) val numeral_char : char arbitrary (** Uniformly distributed over ['0'..'9']. *) val string_gen_of_size : int Gen.t -> char Gen.t -> string arbitrary val string_gen : char Gen.t -> string arbitrary (** Generates strings with a distribution of length of [small_nat]. *) val string : string arbitrary (** Generates strings with a distribution of length of [small_nat] and distribution of characters of [char]. *) val small_string : string arbitrary (** Same as {!string} but with a small length (ie {!Gen.small_nat} ). *) val small_list : 'a arbitrary -> 'a list arbitrary (** Generates lists of small size (see {!Gen.small_nat}). @since 0.5.3 *) val string_of_size : int Gen.t -> string arbitrary (** Generates strings with distribution of characters if [char]. *) val printable_string : string arbitrary (** Generates strings with a distribution of length of [small_nat] and distribution of characters of [printable_char]. *) val printable_string_of_size : int Gen.t -> string arbitrary (** Generates strings with distribution of characters of [printable_char]. *) val small_printable_string : string arbitrary val numeral_string : string arbitrary (** Generates strings with a distribution of length of [small_nat] and distribution of characters of [numeral_char]. *) val numeral_string_of_size : int Gen.t -> string arbitrary (** Generates strings with a distribution of characters of [numeral_char]. *) val list : 'a arbitrary -> 'a list arbitrary (** Generates lists with length generated by [small_nat]. *) val list_of_size : int Gen.t -> 'a arbitrary -> 'a list arbitrary (** Generates lists with length from the given distribution. *) val array : 'a arbitrary -> 'a array arbitrary (** Generates arrays with length generated by [small_nat]. *) val array_of_size : int Gen.t -> 'a arbitrary -> 'a array arbitrary (** Generates arrays with length from the given distribution. *) val pair : 'a arbitrary -> 'b arbitrary -> ('a * 'b) arbitrary (** Combines two generators into a generator of pairs. Order of elements can matter (w.r.t shrinking, see {!Shrink.pair}) *) val triple : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> ('a * 'b * 'c) arbitrary (** Combines three generators into a generator of 3-tuples. Order matters for shrinking, see {!Shrink.pair} and the likes *) val quad : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> ('a * 'b * 'c * 'd) arbitrary (** Combines four generators into a generator of 4-tuples. Order matters for shrinking, see {!Shrink.pair} and the likes *) val option : ?ratio:float -> 'a arbitrary -> 'a option arbitrary (** Choose between returning Some random value with optional ratio, or None. *) val fun1_unsafe : 'a arbitrary -> 'b arbitrary -> ('a -> 'b) arbitrary (** Generator of functions of arity 1. The functions are always pure and total functions: - when given the same argument (as decided by Pervasives.(=)), it returns the same value - it never does side effects, like printing or never raise exceptions etc. The functions generated are really printable. renamed from {!fun1} since 0.6 @deprecated use {!fun_} instead. @since 0.6 *) val fun2_unsafe : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> ('a -> 'b -> 'c) arbitrary (** Generator of functions of arity 2. The remark about [fun1] also apply here. renamed from {!fun2} since 0.6 @deprecated use {!fun_} instead since 0.6 *) type _ fun_repr (** Internal data for functions. A ['f fun_] is a function of type ['f], fundamentally. *) (** A function packed with the data required to print/shrink it. See {!Fn} to see how to apply, print, etc. such a function. One can also directly pattern match on it to obtain the executable function. For example: {[ QCheck.Test.make QCheck.(pair (fun1 Observable.int bool) (small_list int)) (fun (Fun (_,f), l) -> l=(List.rev_map f l |> List.rev l)) ]} *) type _ fun_ = | Fun : 'f fun_repr * 'f -> 'f fun_ (** Utils on functions @since 0.6 *) module Fn : sig type 'a t = 'a fun_ val print : _ t Print.t val shrink : _ t Shrink.t val apply : 'f t -> 'f end val fun1 : 'a Observable.t -> 'b arbitrary -> ('a -> 'b) fun_ arbitrary (** [fun1 o ret] makes random functions that take an argument observable via [o] and map to random values generated from [ret]. To write functions with multiple arguments, it's better to use {!Tuple} or {!Observable.pair} rather than applying {!fun_} several times (shrinking will be faster). @since 0.6 *) module Tuple : sig (** Heterogeneous tuple, used to pass any number of arguments to a function. *) type 'a t = | Nil : unit t | Cons : 'a * 'b t -> ('a * 'b) t val nil : unit t val cons : 'a -> 'b t -> ('a * 'b) t (** How to observe a {!'a t} *) type 'a obs val o_nil : unit obs val o_cons : 'a Observable.t -> 'b obs -> ('a * 'b) obs module Infix : sig val (@::) : 'a -> 'b t -> ('a * 'b) t (** Alias to {!cons}. *) val (@->) : 'a Observable.t -> 'b obs -> ('a * 'b) obs (** Alias to {!B_cons}. *) end include module type of Infix val observable : 'a obs -> 'a t Observable.t end val fun_nary : 'a Tuple.obs -> 'b arbitrary -> ('a Tuple.t -> 'b) fun_ arbitrary (** [fun_nary] makes random n-ary functions. Example: {[ let module O = Observable in fun_nary Tuple.(O.int @-> O.float @-> O.string @-> o_nil) bool) ]} @since 0.6 *) val fun2 : 'a Observable.t -> 'b Observable.t -> 'c arbitrary -> ('a -> 'b -> 'c) fun_ arbitrary (** @since 0.6 *) val fun3 : 'a Observable.t -> 'b Observable.t -> 'c Observable.t -> 'd arbitrary -> ('a -> 'b -> 'c -> 'd) fun_ arbitrary (** @since 0.6 *) val fun4 : 'a Observable.t -> 'b Observable.t -> 'c Observable.t -> 'd Observable.t -> 'e arbitrary -> ('a -> 'b -> 'c -> 'd -> 'e) fun_ arbitrary (** @since 0.6 *) val oneofl : ?print:'a Print.t -> ?collect:('a -> string) -> 'a list -> 'a arbitrary (** Pick an element randomly in the list. *) val oneofa : ?print:'a Print.t -> ?collect:('a -> string) -> 'a array -> 'a arbitrary (** Pick an element randomly in the array. *) val oneof : 'a arbitrary list -> 'a arbitrary (** Pick a generator among the list, randomly. @deprecated this function is badly specified and will not use shrinkers appropriately. Consider using {!Gen.oneof} and then {!make} to build a well behaved arbitrary instance. *) val always : ?print:'a Print.t -> 'a -> 'a arbitrary (** Always return the same element. *) val frequency : ?print:'a Print.t -> ?small:('a -> int) -> ?shrink:'a Shrink.t -> ?collect:('a -> string) -> (int * 'a arbitrary) list -> 'a arbitrary (** Similar to {!oneof} but with frequencies. *) val frequencyl : ?print:'a Print.t -> ?small:('a -> int) -> (int * 'a) list -> 'a arbitrary (** Same as {!oneofl}, but each element is paired with its frequency in the probability distribution (the higher, the more likely). *) val frequencya : ?print:'a Print.t -> ?small:('a -> int) -> (int * 'a) array -> 'a arbitrary (** Same as {!frequencyl}, but with an array. *) val map : ?rev:('b -> 'a) -> ('a -> 'b) -> 'a arbitrary -> 'b arbitrary (** [map f a] returns a new arbitrary instance that generates values using [a#gen] and then transforms them through [f]. @param rev if provided, maps values back to type ['a] so that the printer, shrinker, etc. of [a] can be used. We assume [f] is monotonic in this case (that is, smaller inputs are transformed into smaller outputs). *) val map_same_type : ('a -> 'a) -> 'a arbitrary -> 'a arbitrary (** Specialization of [map] when the transformation preserves the type, which makes shrinker, printer, etc. still relevant. *) val map_keep_input : ?print:'b Print.t -> ?small:('b -> int) -> ('a -> 'b) -> 'a arbitrary -> ('a * 'b) arbitrary (** [map_keep_input f a] generates random values from [a], and maps them into values of type ['b] using the function [f], but it also keeps the original value. For shrinking, it is assumed that [f] is monotonic and that smaller input values will map into smaller values. @param print optional printer for the [f]'s output. *) qcheck-0.18.1/src/core/QCheck2.ml000066400000000000000000001701201417677125000163430ustar00rootroot00000000000000(* QCheck: Random testing for OCaml copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard, Julien Debon, Valentin Chaboche all rights reserved. *) (** {1 Quickcheck inspired property-based testing} *) let poly_compare=compare module RS = Random.State let rec foldn ~f ~init:acc i = if i = 0 then acc else foldn ~f ~init:(f acc i) (i-1) let _opt_map_2 ~f a b = match a, b with | Some x, Some y -> Some (f x y) | _ -> None let _opt_map_3 ~f a b c = match a, b, c with | Some x, Some y, Some z -> Some (f x y z) | _ -> None let _opt_map_4 ~f a b c d = match a, b, c, d with | Some x, Some y, Some z, Some w -> Some (f x y z w) | _ -> None let _opt_sum a b = match a, b with | Some _, _ -> a | None, _ -> b let sum_int = List.fold_left (+) 0 exception Failed_precondition (* raised if precondition is false *) exception No_example_found of string (* raised if an example failed to be found *) let assume b = if not b then raise Failed_precondition let assume_fail () = raise Failed_precondition let (==>) b1 b2 = if b1 then b2 else raise Failed_precondition (** Enhancement of Stdlib [Seq] to backport some recent functions, and add a few useful others. *) module Seq = struct include Seq (* The following functions are copied from https://github.com/ocaml/ocaml/blob/trunk/stdlib/seq.ml to support older OCaml versions. *) let rec unfold f u () = match f u with | None -> Nil | Some (x, u') -> Cons (x, unfold f u') let rec append seq1 seq2 () = match seq1() with | Nil -> seq2() | Cons (x, next) -> Cons (x, append next seq2) let cons x next () = Cons (x, next) (* End of copy of old functions. *) let is_empty (seq : _ t) : bool = match seq () with | Nil -> true | _ -> false (** Take at most [n] values. *) let rec take (n : int) (seq : _ t) : _ t = fun () -> match (n, seq ()) with | (0, _) | (_, Nil) -> Nil | (n, Cons (a, rest)) -> Cons (a, take (n - 1) rest) let hd (l : 'a t) : 'a option = match l () with | Nil -> None | Cons (hd, _) -> Some hd (** Useful to improve [Seq] code perf when chaining functions *) let apply (l : 'a t) : 'a node = l () end module Shrink = struct module type Number = sig type t val equal : t -> t -> bool val div : t -> t -> t val add : t -> t -> t val sub : t -> t -> t val of_int : int -> t end let number_towards (type a) (module Number : Number with type t = a) ~(destination : a) (x : a) : a Seq.t = fun () -> Seq.unfold (fun current_shrink -> if Number.equal current_shrink x then None else ( (* Halve the operands before subtracting them so they don't overflow. Consider [number_towards min_int max_int] *) let half_diff = Number.sub (Number.div x (Number.of_int 2)) (Number.div current_shrink (Number.of_int 2)) in if half_diff = Number.of_int 0 (* [current_shrink] is the last valid shrink candidate, put [x] as next step to make sure we stop *) then Some (current_shrink, x) else Some (current_shrink, Number.add current_shrink half_diff) )) destination () let int_towards destination x = fun () -> let module Int : Number with type t = int = struct include Int let of_int = Fun.id end in number_towards (module Int) ~destination x () let int32_towards destination x = fun () -> number_towards (module Int32) ~destination x () let int64_towards destination x = fun () -> number_towards (module Int64) ~destination x () (** Arbitrarily limit to 15 elements as dividing a [float] by 2 doesn't converge quickly towards the destination. *) let float_towards destination x = fun () -> number_towards (module Float) ~destination x |> Seq.take 15 |> Seq.apply let int_aggressive_towards (destination : int) (n : int) : int Seq.t = fun () -> Seq.unfold (fun current -> if current = n then None else if current < n then let next = succ current in Some (next, next) else let next = pred current in Some (next, next) ) destination () let int_aggressive n = fun () -> int_aggressive_towards 0 n () end module Tree = struct type 'a t = Tree of 'a * ('a t) Seq.t let root (Tree (root, _) : 'a t) : 'a = root let children (Tree (_, children) : 'a t) : ('a t) Seq.t = children let rec pp ?(depth : int option) (inner_pp : Format.formatter -> 'a -> unit) (ppf : Format.formatter) (t : 'a t) : unit = let Tree (x, xs) = t in let wrapper_box ppf inner = Format.fprintf ppf "@[Tree(@,%a@]@,)" inner () in let inner ppf () = Format.fprintf ppf "@[Node(@,%a@]@,),@ @[Shrinks(" inner_pp x; if Option.fold depth ~none:false ~some:(fun depth -> depth <= 0) then ( Format.fprintf ppf "@])") else if Seq.is_empty xs then Format.fprintf ppf "@])" else ( Format.fprintf ppf "@,%a@]@,)" (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ") (pp ?depth:(Option.map pred depth) inner_pp)) (List.of_seq xs); ) in wrapper_box ppf inner let rec map (f : 'a -> 'b) (a : 'a t) : 'b t = let Tree (x, xs) = a in let y = f x in let ys = fun () -> Seq.map (fun smaller_x -> map f smaller_x) xs () in Tree (y, ys) (** Note that parameter order is reversed. *) let (>|=) a f = map f a let rec ap (f : ('a -> 'b) t) (a : 'a t) : 'b t = let Tree (x0, xs) = a in let Tree (f0, fs) = f in let y = f0 x0 in let ys = fun () -> Seq.append (Seq.map (fun f' -> ap f' a) fs) (Seq.map (fun x' -> ap f x') xs) () in Tree (y, ys) let (<*>) = ap let liftA2 (f : 'a -> 'b -> 'c) (a : 'a t) (b : 'b t) : 'c t = (a >|= f) <*> b let rec bind (a : 'a t) (f : 'a -> 'b t) : 'b t = let Tree (x, xs) = a in let Tree (y, ys_of_x) = f x in let ys_of_xs = fun () -> Seq.map (fun smaller_x -> bind smaller_x f) xs () in let ys = fun () -> Seq.append ys_of_xs ys_of_x () in Tree (y, ys) let (>>=) = bind let pure x = Tree (x, Seq.empty) let rec make_primitive (shrink : 'a -> 'a Seq.t) (x : 'a) : 'a t = let shrink_trees = fun () -> shrink x |> Seq.map (make_primitive shrink) |> Seq.apply in Tree (x, shrink_trees) let rec opt (a : 'a t) : 'a option t = let Tree (x, xs) = a in let shrinks = fun () -> Seq.cons (pure None) (Seq.map opt xs) () in Tree (Some x, shrinks) let rec sequence_list (l : 'a t list) : 'a list t = match l with | [] -> pure [] | hd :: tl -> liftA2 List.cons hd (sequence_list tl) let rec add_shrink_invariant (p : 'a -> bool) (a : 'a t) : 'a t = let Tree (x, xs) = a in 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 Tree (x, xs') (** [applicative_take n trees] returns a tree of lists with at most the [n] first elements of the input list. *) let rec applicative_take (n : int) (l : 'a t list) : 'a list t = match (n, l) with | (0, _) | (_, []) -> pure [] | (n, (tree :: trees)) -> liftA2 List.cons tree (applicative_take (pred n) trees) end module Gen = struct type 'a t = RS.t -> 'a Tree.t type 'a sized = int -> RS.t -> 'a Tree.t let map f x = fun st -> Tree.map f (x st) (** Note that parameter order is reversed. *) let (>|=) x f = map f x let (<$>) = map let pure (a : 'a) : 'a t = fun _ -> Tree.pure a let ap (f : ('a -> 'b) t) (x : 'a t) : 'b t = fun st -> Tree.ap (f st) (x st) let (<*>) = ap let liftA2 (f : 'a -> 'b -> 'c) (a : 'a t) (b : 'b t) : 'c t = (a >|= f) <*> b let liftA3 (f : 'a -> 'b -> 'c -> 'd) (a : 'a t) (b : 'b t) (c : 'c t) : 'd t = (a >|= f) <*> b <*> c let map2 = liftA2 let map3 = liftA3 let return = pure let bind (gen : 'a t) (f : 'a -> ('b t)) : 'b t = fun st -> Tree.bind (gen st) (fun a -> f a st) let (>>=) = bind let sequence_list (l : 'a t list) : 'a list t = fun st -> List.map (fun gen -> gen st) l |> Tree.sequence_list let make_primitive ~(gen : RS.t -> 'a) ~(shrink : 'a -> 'a Seq.t) : 'a t = fun st -> Tree.make_primitive shrink (gen st) let parse_origin (loc : string) (pp : Format.formatter -> 'a -> unit) ~(origin : 'a) ~(low : 'a) ~(high : 'a) : 'a = if origin < low then invalid_arg Format.(asprintf "%s: origin value %a is lower than low value %a" loc pp origin pp low) else if origin > high then invalid_arg Format.(asprintf "%s: origin value %a is greater than high value %a" loc pp origin pp high) else origin let small_nat : int t = fun st -> let p = RS.float st 1. in let x = if p < 0.75 then RS.int st 10 else RS.int st 100 in let shrink a = fun () -> Shrink.int_towards 0 a () in Tree.make_primitive shrink x (** Natural number generator *) let nat : int t = fun st -> let p = RS.float st 1. in let x = if p < 0.5 then RS.int st 10 else if p < 0.75 then RS.int st 100 else if p < 0.95 then RS.int st 1_000 else RS.int st 10_000 in let shrink a = fun () -> Shrink.int_towards 0 a () in Tree.make_primitive shrink x let big_nat : int t = fun st -> let p = RS.float st 1. in if p < 0.75 then nat st else let shrink a = fun () -> Shrink.int_towards 0 a () in Tree.make_primitive shrink (RS.int st 1_000_000) let unit : unit t = fun _st -> Tree.pure () let bool : bool t = fun st -> let false_gen = Tree.pure false in if RS.bool st then Tree.Tree (true, Seq.return false_gen) else false_gen let float : float t = fun st -> let x = exp (RS.float st 15. *. (if RS.bool st then 1. else -1.)) *. (if RS.bool st then 1. else -1.) in let shrink a = fun () -> Shrink.float_towards 0. a () in Tree.make_primitive shrink x let pfloat : float t = float >|= abs_float let nfloat : float t = pfloat >|= Float.neg let float_bound_inclusive ?(origin : float = 0.) (bound : float) : float t = fun st -> let (low, high) = Float.min_max_num 0. bound in let shrink a = fun () -> let origin = parse_origin "Gen.float_bound_inclusive" Format.pp_print_float ~origin ~low ~high in Shrink.float_towards origin a () in let x = RS.float st bound in Tree.make_primitive shrink x let float_bound_exclusive ?(origin : float = 0.) (bound : float) : float t = if bound = 0. then invalid_arg "Gen.float_bound_exclusive"; fun st -> let (low, high) = Float.min_max_num 0. bound in let shrink a = fun () -> let origin = parse_origin "Gen.float_bound_exclusive" Format.pp_print_float ~origin ~low ~high in Shrink.float_towards origin a () in let bound = if bound > 0. then bound -. epsilon_float else bound +. epsilon_float in let x = RS.float st bound in Tree.make_primitive shrink x let pick_origin_within_range ~low ~high ~goal = if low > goal then low else if high < goal then high else goal let float_range ?(origin : float option) (low : float) (high : float) : float t = if high < low then invalid_arg "Gen.float_range: high < low" else if high -. low > max_float then invalid_arg "Gen.float_range: high -. low > max_float"; let origin = parse_origin "Gen.float_range" Format.pp_print_float ~origin:(Option.value ~default:(pick_origin_within_range ~low ~high ~goal:0.) origin) ~low ~high in (float_bound_inclusive ~origin (high -. low)) >|= (fun x -> low +. x) let (--.) low high = float_range ?origin:None low high let neg_int : int t = nat >|= Int.neg (** [opt gen] shrinks towards [None] then towards shrinks of [gen]. *) let opt ?(ratio : float = 0.85) (gen : 'a t) : 'a option t = fun st -> let p = RS.float st 1. in if p < (1. -. ratio) then Tree.pure None else Tree.opt (gen st) (* Uniform positive random int generator. We can't use {!RS.int} because the upper bound must be positive and is excluded, so {!Int.max_int} would never be reached. We have to manipulate bits directly. Note that the leftmost bit is used for negative numbers, so it must be [0]. {!RS.bits} only generates 30 bits, which is exactly enough on 32-bits architectures (i.e. {!Sys.int_size} = 31, i.e. 30 bits for positive numbers) but not on 64-bits ones. That's why for 64-bits, 3 30-bits segments are generated and shifted to craft a 62-bits number (i.e. {!Sys.int_size} = 63). The leftmost segment is masked to keep only the last 2 bits. The current implementation hard-codes 30/32/62/64 values, but technically we should rely on {!Sys.int_size} to find the number of bits. Note that we could also further generalize this function to merge it with [random_binary_string]. Technically this function is a special case of [random_binary_string] where the size is {!Sys.int_size}. *) let pint_raw : RS.t -> int = if Sys.word_size = 32 then fun st -> RS.bits st else (* word size = 64 *) fun st -> (* Technically we could write [3] but this is clearer *) let two_bits_mask = 0b11 in (* Top 2 bits *) let left = ((RS.bits st land two_bits_mask) lsl 60) in (* Middle 30 bits *) let middle = (RS.bits st lsl 30) in (* Bottom 30 bits *) let right = RS.bits st in left lor middle lor right let pint ?(origin : int = 0) : int t = fun st -> let x = pint_raw st in let shrink a = fun () -> let origin = parse_origin "Gen.pint" Format.pp_print_int ~origin ~low:0 ~high:max_int in Shrink.int_towards origin a () in Tree.make_primitive shrink x let number_towards = Shrink.number_towards let int_towards = Shrink.int_towards let int64_towards = Shrink.int64_towards let int32_towards = Shrink.int32_towards let float_towards = Shrink.float_towards let int : int t = bool >>= fun b -> if b then pint ~origin:0 >|= (fun n -> - n - 1) else pint ~origin:0 let int_bound (n : int) : int t = if n < 0 then invalid_arg "Gen.int_bound"; fun st -> if n <= (1 lsl 30) - 2 then Tree.make_primitive (fun a () -> Shrink.int_towards 0 a ()) (RS.int st (n + 1)) else Tree.map (fun r -> r mod (n + 1)) (pint st) (** To support ranges wider than [Int.max_int], the general idea is to find the center, and generate a random half-difference number as well as whether we add or subtract that number from the center. *) let int_range ?(origin : int option) (low : int) (high : int) : int t = if high < low then invalid_arg "Gen.int_range: high < low"; fun st -> let Tree.Tree(n, _shrinks) = if low >= 0 || high < 0 then ( (* range smaller than max_int *) Tree.map (fun n -> low + n) (int_bound (high - low) st) ) else ( (* range potentially bigger than max_int: we split on 0 and choose the interval with regard to their size ratio *) let f_low = float_of_int low in let f_high = float_of_int high in let ratio = (-.f_low) /. (1. +. f_high -. f_low) in if RS.float st 1. <= ratio then Tree.map (fun n -> -n - 1) (int_bound (- (low + 1)) st) else int_bound high st ) in let shrink a = fun () -> let origin = match origin with | None -> pick_origin_within_range ~low ~high ~goal:0 | Some origin -> if origin < low then invalid_arg "Gen.int_range: origin < low" else if origin > high then invalid_arg "Gen.int_range: origin > high" else origin in Shrink.int_towards origin a () in Tree.make_primitive shrink n let (--) low high = int_range ?origin:None low high let oneof (l : 'a t list) : 'a t = int_range 0 (List.length l - 1) >>= List.nth l let oneofl (l : 'a list) : 'a t = int_range 0 (List.length l - 1) >|= List.nth l let oneofa (a : 'a array) : 'a t = int_range 0 (Array.length a - 1) >|= Array.get a (* NOTE: we keep this alias to not break code that uses [small_int] for sizes of strings, arrays, etc. *) let small_int = small_nat let small_signed_int : int t = fun st -> if RS.bool st then small_nat st else (small_nat >|= Int.neg) st (** Shrink towards the first element of the list *) let frequency (l : (int * 'a t) list) : 'a t = if l = [] then failwith "QCheck2.frequency called with an empty list"; let sums = sum_int (List.map fst l) in if sums < 1 then failwith "QCheck2.frequency called with weight sum < 1"; int_bound (sums - 1) >>= fun i -> let rec aux acc = function | ((x, g) :: xs) -> if i < acc + x then g else aux (acc + x) xs | _ -> assert false in aux 0 l let frequencyl (l : (int * 'a) list) : 'a t = List.map (fun (weight, value) -> (weight, pure value)) l |> frequency let frequencya a = frequencyl (Array.to_list a) let char_range ?(origin : char option) (a : char) (b : char) : char t = (int_range ~origin:(Char.code (Option.value ~default:a origin)) (Char.code a) (Char.code b)) >|= Char.chr let random_binary_string (length : int) (st : RS.t) : string = (* 0b011101... *) let s = Bytes.create (length + 2) in Bytes.set s 0 '0'; Bytes.set s 1 'b'; for i = 0 to length - 1 do Bytes.set s (i+2) (if RS.bool st then '0' else '1') done; Bytes.unsafe_to_string s let int32 : int32 t = fun st -> let x = random_binary_string 32 st |> Int32.of_string in let shrink a = fun () -> Shrink.int32_towards 0l a () in Tree.make_primitive shrink x let ui32 : int32 t = map Int32.abs int32 let int64 : int64 t = fun st -> let x = random_binary_string 64 st |> Int64.of_string in let shrink a = fun () -> Shrink.int64_towards 0L a () in Tree.make_primitive shrink x let ui64 : int64 t = map Int64.abs int64 (* A tail-recursive implementation over Tree.t *) let list_size (size : int t) (gen : 'a t) : 'a list t = fun st -> Tree.bind (size st) @@ fun size -> let rec loop n acc = if n <= 0 then acc else (loop [@tailcall]) (n - 1) (Tree.liftA2 List.cons (gen st) acc) in loop size (Tree.pure []) let list (gen : 'a t) : 'a list t = list_size nat gen let list_repeat (n : int) (gen : 'a t) : 'a list t = list_size (pure n) gen let array_size (size : int t) (gen : 'a t) : 'a array t = (list_size size gen) >|= Array.of_list let array (gen : 'a t) : 'a array t = list gen >|= Array.of_list let array_repeat (n : int) (gen : 'a t) : 'a array t = list_repeat n gen >|= Array.of_list let rec flatten_l (l : 'a t list) : 'a list t = match l with | [] -> pure [] | gen :: gens -> liftA2 List.cons gen (flatten_l gens) let flatten_a (a : 'a t array) : 'a array t = Array.to_list a |> flatten_l >|= Array.of_list let flatten_opt (o : 'a t option) : 'a option t = match o with | None -> pure None | Some gen -> opt gen let flatten_res (res : ('a t, 'e) result) : ('a, 'e) result t = match res with | Ok gen -> gen >|= Result.ok | Error e -> pure (Error e) let shuffle_a (a : 'a array) : 'a array t = fun st -> let a = Array.copy a in for i = Array.length a - 1 downto 1 do let j = RS.int st (i + 1) in let tmp = a.(i) in a.(i) <- a.(j); a.(j) <- tmp; done; Tree.pure a let shuffle_l (l : 'a list) : 'a list t = Array.of_list l |> shuffle_a >|= Array.to_list let shuffle_w_l (l : ((int * 'a) list)) : 'a list t = fun st -> let sample (w, v) = let Tree.Tree (p, _) = float_bound_inclusive 1. st in let fl_w = float_of_int w in (p ** (1. /. fl_w), v) in let samples = List.rev_map sample l in samples |> List.sort (fun (w1, _) (w2, _) -> poly_compare w1 w2) |> List.rev_map snd |> Tree.pure let pair (g1 : 'a t) (g2 : 'b t) : ('a * 'b) t = liftA2 (fun a b -> (a, b)) g1 g2 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 let quad (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) : ('a * 'b * 'c * 'd) t = (fun a b c d -> (a, b, c, d)) <$> g1 <*> g2 <*> g3 <*> g4 (** 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. *) let char : char t = fun st -> let c = RS.int st 256 in let shrink a = fun () -> Shrink.int_towards (int_of_char 'a') a |> Seq.apply in Tree.map char_of_int (Tree.make_primitive shrink c) (** The first characters are the usual lower case alphabetical letters to help shrinking. *) let printable_chars : char list = (* Left and right inclusive *) let range min max = List.init (max - min) (fun i -> char_of_int (i + min)) in let a = 97 in let z = 122 in let lower_alphabet = range a z in (* ' ' *) let first_printable_char = 32 in let before_lower_alphabet = range first_printable_char (a - 1) in (* '~' *) let last_printable_char = 126 in let after_lower_alphabet = range (z + 1) last_printable_char in let newline = ['\n'] in (* Put alphabet first for shrinking *) List.flatten [lower_alphabet; before_lower_alphabet; after_lower_alphabet; newline] let printable : char t = int_range ~origin:0 0 (List.length printable_chars - 1) >|= List.nth printable_chars let numeral : char t = let zero = 48 in let nine = 57 in int_range ~origin:zero zero nine >|= char_of_int let bytes_size ?(gen = char) (size : int t) : bytes t = fun st -> let open Tree in size st >>= fun size -> (* Adding char shrinks to a mutable list is expensive: ~20-30% cost increase *) (* Adding char shrinks to a mutable lazy list is less expensive: ~15% cost increase *) let char_trees_rev = ref [] in let bytes = Bytes.init size (fun _ -> let char_tree = gen st in char_trees_rev := char_tree :: !char_trees_rev ; (* Performance: return the root right now, the heavy processing of shrinks can wait until/if there is a need to shrink *) root char_tree) in let shrink = fun () -> let char_trees = List.rev !char_trees_rev in let char_list_tree = sequence_list char_trees in let bytes_tree = char_list_tree >|= (fun char_list -> let bytes = Bytes.create size in List.iteri (Bytes.set bytes) char_list ; bytes) in (* Technically [bytes_tree] is the whole tree, but for perf reasons we eagerly created the root above *) children bytes_tree () in Tree (bytes, shrink) let string_size ?(gen = char) (size : int t) : string t = bytes_size ~gen size >|= Bytes.unsafe_to_string let string : string t = string_size nat let string_of gen = string_size ~gen nat let string_printable = string_size ~gen:printable nat let small_string ?gen st = string_size ?gen small_nat st let small_list gen = list_size small_nat gen let small_array gen = array_size small_nat gen let join (gen : 'a t t) : 'a t = gen >>= Fun.id (* corner cases *) let graft_corners (gen : 'a t) (corners : 'a list) () : 'a t = let cors = ref corners in fun st -> match !cors with [] -> gen st | e::l -> cors := l; Tree.pure e let int_pos_corners = [0; 1; 2; max_int] let int_corners = int_pos_corners @ [min_int] let small_int_corners () : int t = graft_corners nat int_pos_corners () (* sized, fix *) let sized_size (size : int t) (gen : 'a sized) : 'a t = size >>= gen let sized (gen : 'a sized) : 'a t = sized_size nat gen let fix f = let rec f' n st = f f' n st in f' let generate ?(rand=RS.make_self_init()) ~(n : int) (gen : 'a t) : 'a list = list_repeat n gen rand |> Tree.root let generate1 ?(rand=RS.make_self_init()) (gen : 'a t) : 'a = gen rand |> Tree.root let generate_tree ?(rand=RS.make_self_init()) (gen : 'a t) : 'a Tree.t = gen rand let delay (f : unit -> 'a t) : 'a t = fun st -> f () st let add_shrink_invariant (p : 'a -> bool) (gen : 'a t) : 'a t = fun st -> gen st |> Tree.add_shrink_invariant p let (let+) = (>|=) let (and+) = pair let (let*) = (>>=) let (and*) = pair end module Print = struct type 'a t = 'a -> string let unit _ = "()" let int = string_of_int let bool = string_of_bool let float = string_of_float let string s = Printf.sprintf "%S" s let char c = Printf.sprintf "%C" c let option f = function | None -> "None" | Some x -> "Some (" ^ f x ^ ")" let pair a b (x,y) = Printf.sprintf "(%s, %s)" (a x) (b y) let triple a b c (x,y,z) = Printf.sprintf "(%s, %s, %s)" (a x) (b y) (c z) let quad a b c d (x,y,z,w) = Printf.sprintf "(%s, %s, %s, %s)" (a x) (b y) (c z) (d w) let list pp l = let b = Buffer.create 25 in Buffer.add_char b '['; List.iteri (fun i x -> if i > 0 then Buffer.add_string b "; "; Buffer.add_string b (pp x)) l; Buffer.add_char b ']'; Buffer.contents b let array pp a = let b = Buffer.create 25 in Buffer.add_string b "[|"; Array.iteri (fun i x -> if i > 0 then Buffer.add_string b "; "; Buffer.add_string b (pp x)) a; Buffer.add_string b "|]"; Buffer.contents b let contramap f p x = p (f x) let comap = contramap end (** {2 Observe Values} *) module Observable = struct (** An observable is a (random) predicate on ['a] *) type -'a t = { print: 'a Print.t; eq: ('a -> 'a -> bool); hash: ('a -> int); } let hash o x = o.hash x let equal o x y = o.eq x y let print o x = o.print x let make ?(eq=(=)) ?(hash=Hashtbl.hash) print = {print; eq; hash; } module H = struct let combine a b = Hashtbl.seeded_hash a b let combine_f f s x = Hashtbl.seeded_hash s (f x) let int i = i land max_int let bool b = if b then 1 else 2 let char x = Char.code x let string (x:string) = Hashtbl.hash x let opt f = function | None -> 42 | Some x -> combine 43 (f x) let list f l = List.fold_left (combine_f f) 0x42 l let array f l = Array.fold_left (combine_f f) 0x42 l let pair f g (x,y) = combine (f x) (g y) end module Eq = struct type 'a t = 'a -> 'a -> bool let int : int t = (=) let string : string t = (=) let bool : bool t = (=) let float : float t = (=) let unit () () = true let char : char t = (=) let rec list f l1 l2 = match l1, l2 with | [], [] -> true | [], _ | _, [] -> false | x1::l1', x2::l2' -> f x1 x2 && list f l1' l2' let array eq a b = let rec aux i = if i = Array.length a then true else eq a.(i) b.(i) && aux (i+1) in Array.length a = Array.length b && aux 0 let option f o1 o2 = match o1, o2 with | None, None -> true | Some _, None | None, Some _ -> false | Some x, Some y -> f x y let pair f g (x1,y1)(x2,y2) = f x1 x2 && g y1 y2 end let unit : unit t = make ~hash:(fun _ -> 1) ~eq:Eq.unit Print.unit let bool : bool t = make ~hash:H.bool ~eq:Eq.bool Print.bool let int : int t = make ~hash:H.int ~eq:Eq.int Print.int let float : float t = make ~eq:Eq.float Print.float let string = make ~hash:H.string ~eq:Eq.string Print.string let char = make ~hash:H.char ~eq:Eq.char Print.char let option p = make ~hash:(H.opt p.hash) ~eq:(Eq.option p.eq) (Print.option p.print) let array p = make ~hash:(H.array p.hash) ~eq:(Eq.array p.eq) (Print.array p.print) let list p = make ~hash:(H.list p.hash) ~eq:(Eq.list p.eq) (Print.list p.print) let contramap f p = make ~hash:(fun x -> p.hash (f x)) ~eq:(fun x y -> p.eq (f x)(f y)) (fun x -> p.print (f x)) let map = contramap let pair a b = make ~hash:(H.pair a.hash b.hash) ~eq:(Eq.pair a.eq b.eq) (Print.pair a.print b.print) let triple a b c = contramap (fun (x,y,z) -> x,(y,z)) (pair a (pair b c)) let quad a b c d = contramap (fun (x,y,z,u) -> x,(y,z,u)) (pair a (triple b c d)) end type 'a stat = string * ('a -> int) (** A statistic on a distribution of values of type ['a] *) (** Internal module taking care of storing generated function bindings. In essence, a generated function of type ['a -> 'b] is a map (table) where keys are input values of type ['a] and values are output values of type ['b], plus a default value of type ['b]. This module provides the "map of input/output" part. *) module Poly_tbl : sig type ('key, 'value) t val create: 'key Observable.t -> ?v_print:'value Print.t -> 'value Gen.t -> int -> ('key, 'value) t Gen.t val get : ('key, 'value) t -> 'key -> 'value option val size : ('value -> int) -> ('key, 'value) t -> int val print : ('key, 'value) t Print.t end = struct type ('key, 'value) t = { 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). *) p_size: ('value -> int) -> int; p_print: unit -> string; p_tree_bindings_rev : ('key * 'value Tree.t) list ref; } 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 = fun st -> let module T = Hashtbl.Make(struct type t = k let equal = k_obs.Observable.eq let hash = k_obs.Observable.hash end) in (* make a table @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). *) let make ~extend tbl = let initial_tree_bindings_rev = T.to_seq tbl |> List.of_seq |> List.rev_map (fun (k, v) -> k, Tree.pure v) in let p_tree_bindings_rev = ref initial_tree_bindings_rev in let get = (fun key -> try Some (T.find tbl key) with Not_found -> if extend then ( (* Generate a new value and "record" the binding for potential future display/shrinking *) let value_tree = v_gen st in p_tree_bindings_rev := (key, value_tree) :: !p_tree_bindings_rev; let v = Tree.root value_tree in T.add tbl key v; Some v ) else None) in let p_print = (fun () -> let pp_v = Option.value ~default:(fun _ -> "") v_print in let b = Buffer.create 64 in let to_b = Format.formatter_of_buffer b in T.iter (fun key value -> Format.fprintf to_b "%s -> %s; " (k_obs.Observable.print key) (pp_v value)) tbl; Format.pp_print_flush to_b (); Buffer.contents b) in let p_size=(fun size_v -> T.fold (fun _ v n -> n + size_v v) tbl 0) in {get; p_print; p_size; p_tree_bindings_rev} in let root_tbl = T.create size in (* During initial running of the test, record bindings, hence [~extend:true]. *) let root = make ~extend:true root_tbl in (* Build the (lazy!) shrink tree of tables here *) let shrinks : (k, v) t Tree.t Seq.t = fun () -> (* This only gets evaluated *after* the test was run for [tbl], meaning it is correctly populated with bindings recorded during the test already *) let current_bindings : (k * v Tree.t) list = List.rev !(root.p_tree_bindings_rev) in let take_at_most_tree : int Tree.t = Tree.make_primitive (Shrink.int_towards 0) (List.length current_bindings) in let current_tree_bindings : (k * v) Tree.t list = List.map (fun (k, tree) -> Tree.map (fun v -> (k, v)) tree) current_bindings in 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 (* During shrinking, we don't want to record/add bindings, so [~extend:false]. *) 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 (* [shrunk_poly_tbl_tree] is a bit misleading: its root *should* be the same as [root] but because of the required laziness induced by the mutation of bindings, we don't use it, only graft its children to the original [root]. *) Tree.children shrunk_poly_tbl_tree () in Tree.Tree (root, shrinks) let get t x = t.get x let print t = t.p_print () let size p t = t.p_size p end (** Internal representation of functions, used for shrinking and printing (in case of error). *) type ('a, 'b) fun_repr_tbl = { fun_tbl: ('a, 'b) Poly_tbl.t; (** Input-output bindings *) fun_gen: 'b Gen.t; (** How to generate output values *) fun_print: 'b Print.t option; (** How to print output values *) fun_default: 'b; (** Default value for all inputs not explicitly mapped in {!fun_tbl} *) } type 'f fun_repr = | Fun_tbl : ('a, 'ret) fun_repr_tbl -> ('a -> 'ret) fun_repr (** Input-output list of bindings *) | Fun_map : ('f1 -> 'f2) * 'f1 fun_repr -> 'f2 fun_repr (** Mapped from another function (typically used for currying) *) (** A QCheck function, as in Koen Claessen's paper "Shrinking and showing functions". Such a function is a pair of the function representation (used for shrinking and printing the function) and a "real" function, which can be seen as an input-output map + a default value for all other inputs. - Test developers will only use the "real" function inside their tests (and ignore the function representation). - During shrinking/printing, QCheck will ignore the "real" function and only use its representation. *) type 'f fun_ = Fun of 'f fun_repr * 'f (** Reifying functions *) module Fn = struct let apply (Fun (_repr, real_function)) = real_function (** [function_of_repr repr] creates the "real" function (that will be used in tests) from its representation. *) let rec function_of_repr : type f. f fun_repr -> f = function | Fun_tbl {fun_tbl; fun_default; _} -> (fun x -> match Poly_tbl.get fun_tbl x with | None -> fun_default | Some y -> y) | Fun_map (g, sub_repr) -> g (function_of_repr sub_repr) let make_ (r : 'a fun_repr) : 'a fun_ = Fun (r, function_of_repr r) let mk_repr tbl gen ?print def = Fun_tbl { fun_tbl=tbl; fun_gen=gen; fun_print=print; fun_default=def; } let map_repr f repr = Fun_map (f, repr) let map_fun f (Fun (repr, _real_function)) = make_ (map_repr f repr) (** [print_rep repr] returns a string representation of [repr]. *) let print_repr r = let buf = Buffer.create 32 in let rec aux : type f. Buffer.t -> f fun_repr -> unit = fun buf r -> match r with | Fun_map (_, sub_repr) -> aux buf sub_repr | Fun_tbl r -> Buffer.add_string buf (Poly_tbl.print r.fun_tbl); Printf.bprintf buf "_ -> %s" (match r.fun_print with | None -> "" | Some print -> print r.fun_default); in Printf.bprintf buf "{"; aux buf r; Printf.bprintf buf "}"; Buffer.contents buf let print (Fun (repr, _real_function)) = print_repr repr (** [gen_rep obs gen] creates a function generator. Input values are observed with [obs] and output values are generated with [gen]. *) let gen_rep (obs : 'a Observable.t) ?(print : 'b Print.t option) (gen : 'b Gen.t) : ('a -> 'b) fun_repr Gen.t = 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) let gen (obs : 'a Observable.t) ?(print : 'b Print.t option) (gen : 'b Gen.t) : ('a -> 'b) fun_ Gen.t = Gen.map make_ (gen_rep obs gen ?print) end let fun1 obs ?print gen = Fn.gen obs ?print gen module Tuple = struct (** heterogeneous list (generic tuple) used to uncurry functions *) type 'a t = | Nil : unit t | Cons : 'a * 'b t -> ('a * 'b) t let nil = Nil let cons x tail = Cons (x,tail) type 'a obs = | O_nil : unit obs | O_cons : 'a Observable.t * 'b obs -> ('a * 'b) obs let o_nil = O_nil let o_cons x tail = O_cons (x,tail) let rec hash : type a. a obs -> a t -> int = fun o t -> match o, t with | O_nil, Nil -> 42 | O_cons (o,tail_o), Cons (x, tail) -> Observable.H.combine (Observable.hash o x) (hash tail_o tail) let rec equal : type a. a obs -> a t -> a t -> bool = fun o a b -> match o, a, b with | O_nil, Nil, Nil -> true | O_cons (o, tail_o), Cons (x1, tail1), Cons (x2,tail2) -> Observable.equal o x1 x2 && equal tail_o tail1 tail2 let print o tup = let rec aux : type a. a obs -> Buffer.t -> a t -> unit = fun o buf t -> match o, t with | O_nil, Nil -> Printf.bprintf buf "()" | O_cons (o, O_nil), Cons (x,Nil) -> Printf.bprintf buf "%s" (Observable.print o x) | O_cons (o, tail_o), Cons (x,tail) -> Printf.bprintf buf "%s, %a" (Observable.print o x) (aux tail_o) tail in let buf = Buffer.create 64 in Buffer.add_string buf "("; aux o buf tup; Buffer.add_string buf ")"; Buffer.contents buf let observable (o:'a obs) : 'a t Observable.t = Observable.make ~eq:(equal o) ~hash:(hash o) (print o) let gen (o:'a obs) ?(print:'b Print.t option) (ret:'b Gen.t) : ('a t -> 'b) fun_ Gen.t = Fn.gen (observable o) ?print ret module Infix = struct let (@::) x tail = cons x tail let (@->) o tail = o_cons o tail end include Infix end let fun_nary (o:_ Tuple.obs) ?print ret : _ Gen.t = Tuple.gen o ?print ret let fun2 o1 o2 ?print ret = Gen.map (Fn.map_fun (fun g x y -> g Tuple.(x @:: y @:: nil))) (fun_nary Tuple.(o1 @-> o2 @-> o_nil) ?print ret) let fun3 o1 o2 o3 ?print ret = Gen.map (Fn.map_fun (fun g x y z -> g Tuple.(x @:: y @:: z @:: nil))) (fun_nary Tuple.(o1 @-> o2 @-> o3 @-> o_nil) ?print ret) let fun4 o1 o2 o3 o4 ?print ret = Gen.map (Fn.map_fun (fun g x y z w -> g Tuple.(x @:: y @:: z @:: w @:: nil))) (fun_nary Tuple.(o1 @-> o2 @-> o3 @-> o4 @-> o_nil) ?print ret) module TestResult = struct type 'a counter_ex = { instance: 'a; (** The counter-example(s) *) shrink_steps: int; (** How many shrinking steps for this counterex *) msg_l: string list; (** messages. @since 0.7 *) } (** Result state. changed in 0.10 (move to inline records) *) type 'a state = | Success | Failed of { instances: 'a counter_ex list; (** Failed instance(s) *) } | Failed_other of {msg: string} | Error of { instance: 'a counter_ex; exn: exn; backtrace: string; } (** Error, backtrace, and instance that triggered it *) (* result returned by running a test *) type 'a t = { mutable state : 'a state; mutable count: int; (* number of tests *) mutable count_gen: int; (* number of generated cases *) collect_tbl: (string, int) Hashtbl.t lazy_t; stats_tbl: ('a stat * (int, int) Hashtbl.t) list; mutable warnings: string list; mutable instances: 'a list; (** List of instances used for this test, in no particular order. @since 0.9 *) } let get_state {state; _} = state let get_count {count; _} = count let get_count_gen {count_gen; _} = count_gen (* indicate failure on the given [instance] *) let fail ~msg_l ~steps:shrink_steps res instance = let c_ex = {instance; shrink_steps; msg_l; } in match res.state with | Success -> res.state <- Failed {instances=[ c_ex ]} | Error _ | Failed_other _ -> () | Failed {instances=[]} -> assert false | Failed {instances=l} -> res.state <- Failed {instances=c_ex :: l} let error ~msg_l ~steps res instance exn backtrace = res.state <- Error {instance={instance; shrink_steps=steps; msg_l; }; exn; backtrace} let get_collect r = if Lazy.is_val r.collect_tbl then Some (Lazy.force r.collect_tbl) else None let collect = get_collect let get_stats r = r.stats_tbl let stats = get_stats let get_warnings r = r.warnings let warnings = get_warnings let get_instances r = r.instances let is_success r = match r.state with | Success -> true | Failed _ | Error _ | Failed_other _ -> false end module Test_exceptions = struct exception Test_fail of string * string list exception Test_error of string * string * exn * string end module Test = struct type 'a cell = { count : int; (* number of tests to do *) long_factor : int; (* multiplicative factor for long test count *) max_gen : int; (* max number of instances to generate (>= count) *) max_fail : int; (* max number of failures *) law : 'a -> bool; (* the law to check *) gen : 'a Gen.t; (* how to generate/shrink instances *) print : 'a Print.t option; (* how to print values *) collect : ('a -> string) option; (* collect values by tag, useful to display distribution of generated *) stats : 'a stat list; (* distribution of values of type 'a *) qcheck1_shrink : ('a -> ('a -> unit) -> unit) option; (* QCheck1-backward-compatible shrinking *) if_assumptions_fail: [`Fatal | `Warning] * float; mutable name : string; (* name of the law *) } type t = | Test : 'a cell -> t let get_name {name; _} = name let set_name c name = c.name <- name let get_law {law; _} = law let get_gen {gen; _} = gen let get_print_opt {print; _} = print let get_collect_opt {collect; _} = collect let get_stats {stats; _} = stats let get_count {count; _ } = count let get_long_factor {long_factor; _} = long_factor let default_count = 100 let global_count count = let count = match (count, Sys.getenv_opt "QCHECK_COUNT") with | (Some x, _) -> x | (_, Some x) -> int_of_string x | (None, None) -> default_count in if count < 0 then invalid_arg ("count must be > 0 but value is " ^ string_of_int count) else count let fresh_name = let r = ref 0 in (fun () -> incr r; Printf.sprintf "anon_test_%d" !r) let default_if_assumptions_fail = `Warning, 0.05 let make_cell ?(if_assumptions_fail=default_if_assumptions_fail) ?(count) ?(long_factor=1) ?max_gen ?(max_fail=1) ?(name=fresh_name()) ?print ?collect ?(stats=[]) gen law = let count = global_count count in let max_gen = match max_gen with None -> count + 200 | Some x->x in { law; gen; collect; print; stats; max_gen; max_fail; name; count; long_factor; if_assumptions_fail; qcheck1_shrink = None; } let make_cell_from_QCheck1 ?(if_assumptions_fail=default_if_assumptions_fail) ?(count) ?(long_factor=1) ?max_gen ?(max_fail=1) ?(name=fresh_name()) ~gen ?shrink ?print ?collect ~stats law = let count = global_count count in (* Make a "fake" QCheck2 arbitrary with no shrinking *) let fake_gen = Gen.make_primitive ~gen ~shrink:(fun _ -> Seq.empty) in let max_gen = match max_gen with None -> count + 200 | Some x->x in { law; gen = fake_gen; print; collect; stats; max_gen; max_fail; name; count; long_factor; if_assumptions_fail; qcheck1_shrink = shrink; } let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ?print ?collect ?stats gen law = Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ?print ?collect ?stats gen law) let test_get_count (Test cell) = get_count cell (** {6 Running the test} *) module R = TestResult (* Result of an instance run *) type res = | Success | Failure | FalseAssumption | Error of exn * string (* Step function, called after each instance test *) type 'a step = string -> 'a cell -> 'a -> res -> unit let step_nil_ _ _ _ _ = () (* Events of a test *) type 'a event = | Generating | Collecting of 'a | Testing of 'a | Shrunk of int * 'a | Shrinking of int * int * 'a type 'a handler = string -> 'a cell -> 'a event -> unit let handler_nil_ _ _ _ = () (* state required by {!check} to execute *) type 'a state = { test: 'a cell; step: 'a step; handler : 'a handler; rand: RS.t; mutable res: 'a TestResult.t; mutable cur_count: int; (** number of iterations remaining to do *) mutable cur_max_gen: int; (** maximum number of generations allowed *) mutable cur_max_fail: int; (** maximum number of counter-examples allowed *) } let is_done state = state.cur_count <= 0 || state.cur_max_gen <= 0 let decr_count state = state.res.R.count <- state.res.R.count + 1; state.cur_count <- state.cur_count - 1 let new_input_tree state = state.res.R.count_gen <- state.res.R.count_gen + 1; state.cur_max_gen <- state.cur_max_gen - 1; state.test.gen state.rand (* statistics on inputs *) let collect st i = match st.test.collect with | None -> () | Some f -> let key = f i in let (lazy tbl) = st.res.R.collect_tbl in let n = try Hashtbl.find tbl key with Not_found -> 0 in Hashtbl.replace tbl key (n+1) let update_stats st i = List.iter (fun ((_,f), tbl) -> let key = f i in let n = try Hashtbl.find tbl key with Not_found -> 0 in Hashtbl.replace tbl key (n+1)) st.res.R.stats_tbl type res_or_exn = | Shrink_fail | Shrink_exn of exn (* triggered by user to fail with a message *) exception User_fail of string let fail_report m = raise (User_fail m) let fail_reportf m = let buf = Buffer.create 64 in Format.kfprintf (fun out -> Format.fprintf out "@?"; fail_report (Buffer.contents buf)) (Format.formatter_of_buffer buf) m type 'a run_res = | Run_ok | Run_fail of string list let run_law law x = try if law x then Run_ok else Run_fail [] with User_fail msg -> Run_fail [msg] (* QCheck1-compatibility code *) exception Iter_exit let iter_find_map p iter = let r = ref None in (try iter (fun x -> match p x with Some _ as y -> r := y; raise Iter_exit | None -> ()) with Iter_exit -> () ); !r (* try to shrink counter-ex [i] into a smaller one. Returns shrinked value and number of steps *) let shrink st (i_tree : 'a Tree.t) (r : res_or_exn) m : 'a * res_or_exn * string list * int = let is_err = match r with | Shrink_exn _ -> true | _ -> false in let rec shrink_ st i_tree r m ~steps = let Tree.Tree (i, shrinks) = i_tree in st.handler st.test.name st.test (Shrunk (steps, i)); let count = ref 0 in let i' = match st.test.qcheck1_shrink with | Some f -> (* QCheck1-compatibility, copied almost verbatim from QCheck.ml old code *) iter_find_map (fun x -> (* let Tree.Tree (x, _) = x_tree in *) try incr count; st.handler st.test.name st.test (Shrinking (steps, !count, x)); begin match run_law st.test.law x with | Run_fail m when not is_err -> Some (Tree.pure x, Shrink_fail, m) | _ -> None end with | Failed_precondition | No_example_found _ -> None | e when is_err -> Some (Tree.pure x, Shrink_exn e, []) (* fail test (by error) *) ) (f i) | None -> (* QCheck2 (or QCheck1 with a shrinkless tree): use the shrink tree *) Seq.filter_map (fun x_tree -> let Tree.Tree (x, _) = x_tree in try incr count; st.handler st.test.name st.test (Shrinking (steps, !count, x)); begin match run_law st.test.law x with | Run_fail m when not is_err -> Some (x_tree, Shrink_fail, m) | _ -> None end with | Failed_precondition | No_example_found _ -> None | e when is_err -> Some (x_tree, Shrink_exn e, []) (* fail test (by error) *) ) shrinks |> Seq.hd in match i' with | None -> i, r, m, steps | Some (i_tree',r',m') -> shrink_ st i_tree' r' m' ~steps:(steps + 1) (* shrink further *) in shrink_ ~steps:0 st i_tree r m type 'a check_result = | CR_continue | CR_yield of 'a TestResult.t (* test raised [e] on [input]; try to shrink then fail *) let handle_exn state input e bt : _ check_result = (* first, shrink TODO: shall we shrink differently (i.e. expected only an error)? *) let input, r, msg_l, steps = shrink state input (Shrink_exn e) [] in (* recover exception of shrunk input *) let e = match r with | Shrink_fail -> e | Shrink_exn e' -> e' in state.step state.test.name state.test input (Error (e, bt)); R.error state.res ~steps ~msg_l input e bt; CR_yield state.res (* test failed on [input], which means the law is wrong. Continue if we should. *) let handle_fail state input msg_l : _ check_result = (* first, shrink *) let input, _, msg_l, steps = shrink state input Shrink_fail msg_l in (* fail *) decr_count state; state.step state.test.name state.test input Failure; state.cur_max_fail <- state.cur_max_fail - 1; R.fail state.res ~steps ~msg_l input; CR_yield state.res (* [check_state state] applies [state.test] repeatedly ([iter] times) on output of [test.rand], and if [state.test] ever returns false, then the input that caused the failure is returned in [Failed]. If [func input] raises [Failed_precondition] then the input is discarded, unless max_gen is 0. *) let rec check_state state : _ R.t = if is_done state then state.res else ( state.handler state.test.name state.test Generating; match new_input_tree state with | i_tree -> check_state_input state i_tree | exception e -> (* turn it into an error *) let bt = Printexc.get_backtrace() in let msg = Printf.sprintf "ERROR: uncaught exception in generator for test %s after %d steps:\nException: %s\nBacktrace: %s" state.test.name state.test.count (Printexc.to_string e) bt in state.res.R.state <- R.Failed_other {msg}; state.res ) and check_state_input state input_tree = let Tree.Tree (input, _) = input_tree in state.handler state.test.name state.test (Collecting input); state.res.R.instances <- input :: state.res.R.instances; collect state input; update_stats state input; let res = try state.handler state.test.name state.test (Testing input); begin match run_law state.test.law input with | Run_ok -> (* one test ok *) decr_count state; state.step state.test.name state.test input Success; CR_continue | Run_fail msg_l -> handle_fail state input_tree msg_l end with | Failed_precondition | No_example_found _ -> state.step state.test.name state.test input FalseAssumption; CR_continue | e -> let bt = Printexc.get_backtrace () in handle_exn state input_tree e bt in match res with | CR_continue -> check_state state | CR_yield x -> x type 'a callback = string -> 'a cell -> 'a TestResult.t -> unit let callback_nil_ : _ callback = fun _ _ _ -> () (* check that there are sufficiently many tests which passed, to avoid the case where they all passed by failed precondition *) let check_if_assumptions target_count cell res : unit = let percentage_of_count = float_of_int res.R.count /. float_of_int target_count in let assm_flag, assm_frac = cell.if_assumptions_fail in if R.is_success res && percentage_of_count < assm_frac then ( let msg = format_of_string "%s: \ only %.1f%% tests (of %d) passed precondition for %S\n\n\ NOTE: it is likely that the precondition is too strong, or that \ the generator is buggy.\n%!" in match assm_flag with | `Warning -> let msg = Printf.sprintf msg "WARNING" (percentage_of_count *. 100.) cell.count cell.name in res.R.warnings <- msg :: res.R.warnings | `Fatal -> (* turn it into an error *) let msg = Printf.sprintf msg "ERROR" (percentage_of_count *. 100.) cell.count cell.name in res.R.state <- R.Failed_other {msg} ) (* main checking function *) let check_cell ?(long=false) ?(call=callback_nil_) ?(step=step_nil_) ?(handler=handler_nil_) ?(rand=RS.make [| 0 |]) cell = let factor = if long then cell.long_factor else 1 in let target_count = factor*cell.count in let state = { test=cell; rand; step; handler; cur_count=target_count; cur_max_gen=factor*cell.max_gen; cur_max_fail=factor*cell.max_fail; res = {R. state=R.Success; count=0; count_gen=0; collect_tbl=lazy (Hashtbl.create 10); instances=[]; warnings=[]; stats_tbl= List.map (fun stat -> stat, Hashtbl.create 10) cell.stats; }; } in let res = check_state state in check_if_assumptions target_count cell res; call cell.name cell res; res include Test_exceptions (* print instance using [arb] *) let print_instance arb i = match arb.print with | None -> "" | Some pp -> pp i let print_c_ex arb c : string = let buf = Buffer.create 64 in begin if c.R.shrink_steps > 0 then Printf.bprintf buf "%s (after %d shrink steps)" (print_instance arb c.R.instance) c.R.shrink_steps else Buffer.add_string buf (print_instance arb c.R.instance) end; List.iter (fun msg -> Buffer.add_char buf '\n'; Buffer.add_string buf msg; Buffer.add_char buf '\n') c.R.msg_l; Buffer.contents buf let pp_print_test_fail name out l = let rec pp_list out = function | [] -> () | [x] -> Format.fprintf out "%s@," x | x :: y -> Format.fprintf out "%s@,%a" x pp_list y in Format.fprintf out "@[test `%s`@ failed on ≥ %d cases:@ @[%a@]@]" name (List.length l) pp_list l let asprintf fmt = let buf = Buffer.create 128 in let out = Format.formatter_of_buffer buf in Format.kfprintf (fun _ -> Buffer.contents buf) out fmt let print_test_fail name l = asprintf "@[%a@]@?" (pp_print_test_fail name) l let print_test_error name i e stack = Format.sprintf "@[test `%s`@ raised exception `%s`@ on `%s`@,%s@]" name (Printexc.to_string e) i stack let print_collect c = let out = Buffer.create 64 in Hashtbl.iter (fun case num -> Printf.bprintf out "%s: %d cases\n" case num) c; Buffer.contents out let stat_max_lines = 20 (* maximum number of lines for a histogram *) let print_stat ((name,_), tbl) = let avg = ref 0. in let num = ref 0 in let min_idx, max_idx = Hashtbl.fold (fun i res (m1,m2) -> avg := !avg +. float_of_int (i * res); num := !num + res; min i m1, max i m2) tbl (max_int,min_int) in (* compute average *) if !num > 0 then ( avg := !avg /. float_of_int !num ); (* compute std-dev: sqroot of sum of squared distance-to-average https://en.wikipedia.org/wiki/Standard_deviation *) let stddev = Hashtbl.fold (fun i res m -> m +. (float_of_int i -. !avg) ** 2. *. float_of_int res) tbl 0. |> (fun s -> if !num>0 then s /. float_of_int !num else s) |> sqrt in (* compute median *) let median = ref 0 in let median_num = ref 0 in (* how many values have we seen yet? once >= !n/2 we set median *) (Hashtbl.fold (fun i cnt acc -> (i,cnt)::acc) tbl []) |> List.sort (fun (i,_) (j,_) -> poly_compare i j) |> List.iter (fun (i,cnt) -> if !median_num < !num/2 then ( median_num := !median_num + cnt; (* just went above median! *) if !median_num >= !num/2 then median := i)); (* group by buckets, if there are too many entries: *) (* first compute histogram and bucket size *) let min_idx64, max_idx64 = Int64.(of_int min_idx, of_int max_idx) in let hist_size, bucket_size = let sample_width = Int64.sub max_idx64 min_idx64 in if sample_width > Int64.of_int stat_max_lines then stat_max_lines, int_of_float (ceil (Int64.to_float sample_width /. float_of_int stat_max_lines)) else max_idx-min_idx, 1 in let hist_size = if Int64.(add min_idx64 (mul (of_int bucket_size) (of_int hist_size))) <= max_idx64 then 1+hist_size else hist_size in (* accumulate bucket counts *) let max_val = ref 0 in (* max value after grouping by buckets *) let bucket_count = Array.init hist_size (fun _ -> 0) in Hashtbl.iter (fun j count -> let bucket = Int64.(to_int (div (sub (of_int j) min_idx64) (of_int bucket_size))) in let new_count = bucket_count.(bucket) + count in bucket_count.(bucket) <- new_count; max_val := max !max_val new_count) tbl; (* print entries of the table, sorted by increasing index *) let out = Buffer.create 128 in Printf.bprintf out "stats %s:\n" name; Printf.bprintf out " num: %d, avg: %.2f, stddev: %.2f, median %d, min %d, max %d\n" !num !avg stddev !median min_idx max_idx; let indwidth = let str_width i = String.length (Printf.sprintf "%d" i) in List.map str_width [min_idx; max_idx; min_idx + bucket_size * hist_size] |> List.fold_left max min_int in let labwidth = if bucket_size=1 then indwidth else 2+2*indwidth in for i = 0 to hist_size - 1 do let i' = min_idx + i * bucket_size in let blabel = if bucket_size=1 then Printf.sprintf "%*d" indwidth i' else let bucket_bound = i'+bucket_size-1 in Printf.sprintf "%*d..%*d" indwidth i' indwidth (if bucket_bound < i' then max_int else bucket_bound) in let bcount = bucket_count.(i) in (* NOTE: keep in sync *) let bar_len = bcount * 55 / !max_val in Printf.bprintf out " %*s: %-56s %10d\n" labwidth blabel (String.make bar_len '#') bcount done; Buffer.contents out let () = Printexc.register_printer (function | Test_fail (name,l) -> Some (print_test_fail name l) | Test_error (name,i,e,st) -> Some (print_test_error name i e st) | User_fail s -> Some ("qcheck: user fail:\n" ^ s) | _ -> None) let print_fail arb name l = print_test_fail name (List.map (print_c_ex arb) l) let print_fail_other name ~msg = print_test_fail name [msg] let print_error ?(st="") arb name (i,e) = print_test_error name (print_c_ex arb i) e st let check_result cell res = match res.R.state with | R.Success -> () | R.Error {instance; exn; backtrace} -> raise (Test_error (cell.name, print_c_ex cell instance, exn, backtrace)) | R.Failed {instances=l} -> let l = List.map (print_c_ex cell) l in raise (Test_fail (cell.name, l)) | R.Failed_other {msg} -> raise (Test_fail (cell.name, [msg])) let check_cell_exn ?long ?call ?step ?rand cell = let res = check_cell ?long ?call ?step ?rand cell in check_result cell res let check_exn ?long ?rand (Test cell) = check_cell_exn ?long ?rand cell end let find_example ?(name : string = "") ?(count : int option) ~(f : 'a -> bool) (gen : 'a Gen.t) : 'a Gen.t = (* the random generator of examples satisfying [f]. To do that we test the property [fun x -> not (f x)]; any counter-example *) let gen st = let cell = Test.make_cell ~max_fail:1 ?count gen (fun x -> not (f x)) in let res = Test.check_cell ~rand:st cell in begin match res.TestResult.state with | TestResult.Success -> raise (No_example_found name) | TestResult.Error _ -> raise (No_example_found name) | TestResult.Failed {instances=[]} -> assert false | TestResult.Failed {instances=failed::_} -> (* found counter-example! *) Tree.pure failed.TestResult.instance | TestResult.Failed_other {msg=_} -> raise (No_example_found name) end in gen let find_example_gen ?(rand : RS.t option) ?(name : string option) ?(count : int option) ~(f : 'a -> bool) (gen : 'a Gen.t) : 'a = let g = find_example ?name ?count ~f gen in Gen.generate1 ?rand g qcheck-0.18.1/src/core/QCheck2.mli000066400000000000000000001674521417677125000165320ustar00rootroot00000000000000(* QCheck: Random testing for OCaml copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard, Julien Debon, Valentin Chaboche all rights reserved. *) (* Keep the following title alone in its documentation block as it is specially treated by Odoc: it doesn't appear in the Contents menu on the left. The next documentation block with all the actual content will appear. *) (** {1 QuickCheck-inspired property-based testing} *) (** {1 Introduction} This library takes inspiration from Haskell's QuickCheck library. The rough idea is that the programmer describes invariants that values of a certain type need to satisfy ("properties"), as functions from this type to bool. They also need to describe how to generate random values of the type, so that the property is tried and checked on a number of random instances. This explains the organization of this module: - {!Gen} is used to describe how to generate random values. Auxiliary module {!Print} can be used along with {!Test.make} to build one's own generator instances. - {!Test} is used to describe a single test, that is, a property of type ['a -> bool] combined with an ['a Gen.t] that is used to generate the test cases for this property. Optional parameters allow to specify the random generator state, number of instances to generate and test, etc. 💡 If you are migrating from QCheck, check the {{!section:migration_qcheck2} migration guide} below. {1 Examples} - "{!List.rev} is involutive" (the test passes so [check_exn] returns [()]): {[ let test = QCheck2.(Test.make ~count:1000 ~print:Print.(list int) Gen.(list int) (fun l -> List.rev (List.rev l) = l));; QCheck2.Test.check_exn test;; ]} - "All lists are sorted" (false property that will fail): {ul {- QCheck tests this property on random lists and finds a counter-example} {- QCheck then looks for the smallest counter-example possible (here [[1; 0]]) to help you find the problem (called "shrinking")} } {[ let test = QCheck2.( Test.make ~name:"All lists are sorted" ~count:10_000 ~print:Print.(list int) Gen.(list small_nat) (fun l -> l = List.sort compare l));; QCheck2.Test.check_exn test;; Exception: test `All lists are sorted` failed on ≥ 1 cases: [1; 0] (after 5 shrink steps) ]} - Generate 20 random trees using {! Gen.fix} : {[ type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let tree_gen = QCheck2.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] ));; QCheck2.Gen.generate ~n:20 tree_gen;; ]} @since 0.18 *) (** A tree represents a generated value and its successive shrunk values. *) module Tree : sig (** Conceptually a pseudo-randomly generated value is packaged with its shrunk values. This coupling - called "integrated shrinking" - in a single type has a major benefit: most generators get shrinking "for free" by composing from smaller generators, and shrinking does not break invariants (e.g. shrinks of a positive number are always positive). *) type 'a t (** A tree of random generated values, where the root contains the value used for the test, and the sub-trees contain shrunk values (as trees, to be able to shrink several times a value) used if the test fails. *) val root : 'a t -> 'a (** [root tree] returns the root value of the tree of generated values [t]. *) val children : 'a t -> 'a t Seq.t (** [children tree] returns the direct sub-trees of the tree of generated values [t]. *) val pp : ?depth : int -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit (** [pp ?depth pp_a ppf tree] pretty-prints the tree of generated values [tree] using the pretty-print formatter [ppf]. Values of type ['a] will be printed using the given pretty-printer [pp_a]. As a tree [t] can be potentially huge when fully evaluated, you can control the maximum depth the printer goes with [depth]. - [None] means "everything" - [0] means "only the root" - [1] means "the root and its direct shrinks" - [2] means "the root, its direct shrinks, and the shrinks of its shrinks" - etc. *) end (** A generator is responsible for generating pseudo-random values and provide shrinks (smaller values) when a test fails. *) module Gen : sig (** This module provides some of the most important features of QCheck: - {{!section:primitive_generators} primitive generators} - {{!section:composing_generators} generator compositions} *) type 'a t (** A random generator for values of type ['a]. *) type 'a sized = int -> 'a t (** Random generator with a size bound. *) (** {3:primitive_generators Primitive generators} *) val unit : unit t (** The unit generator. Does not shrink. *) val bool : bool t (** The boolean generator. Shrinks towards [false]. *) val int : int t (** Generates integers uniformly. Shrinks towards [0]. *) val pint : ?origin : int -> int t (** Generates non-strictly positive integers uniformly ([0] included). Shrinks towards [origin] if specified, otherwise towards [0]. *) val small_nat : int t (** Small positive integers (< [100], [0] included). Non-uniform: smaller numbers are more likely than bigger numbers. Shrinks towards [0]. @since 0.5.1 *) val nat : int t (** Generates natural numbers (< [10_000]). Non-uniform: smaller numbers are more likely than bigger numbers. Shrinks towards [0]. *) val big_nat : int t (** Generates natural numbers, possibly large (< [1_000_000]). Non-uniform: smaller numbers are more likely than bigger numbers. Shrinks towards [0]. @since 0.10 *) val neg_int : int t (** Generates non-strictly negative integers ([0] included). Non-uniform: smaller numbers (in absolute value) are more likely than bigger numbers. Shrinks towards [0]. *) val small_int : int t (** Small UNSIGNED integers, for retrocompatibility. Shrinks towards [0]. @deprecated use {!small_nat}. *) val small_signed_int : int t (** Small SIGNED integers, based on {!small_nat}. Non-uniform: smaller numbers (in absolute value) are more likely than bigger numbers. Shrinks towards [0]. @since 0.5.2 *) val small_int_corners : unit -> int t (** As {!small_int}, but each newly created generator starts with a list of corner cases before falling back on random generation. *) val int32 : int32 t (** Generates uniform {!int32} values. Shrinks towards [0l]. *) val ui32 : int32 t (** Generates {!int32} values. Shrinks towards [0l]. @deprecated use {!val:int32} instead, the name is wrong, values {i are} signed. *) val int64 : int64 t (** Generates uniform {!int64} values. Shrinks towards [0L]. *) val ui64 : int64 t (** Generates {!int64} values. Shrinks towards [0L]. @deprecated use {!val:int64} instead, the name is wrong, values {i are} signed. *) val float : float t (** Generates floating point numbers. Shrinks towards [0.]. *) val pfloat : float t (** Generates positive floating point numbers ([0.] included). Shrinks towards [0.]. *) val nfloat : float t (** Generates negative floating point numbers. ([-0.] included). Shrinks towards [-0.]. *) val char : char t (** Generates characters in the [0..255] range. Shrinks towards ['a']. *) val printable : char t (** Generates printable characters. The exhaustive list of character codes is: - [32] to [126], inclusive - ['\n'] Shrinks towards ['a']. *) val numeral : char t (** Generates numeral characters ['0'..'9']. Shrinks towards ['0']. *) val string_size : ?gen:char t -> int t -> string t (** Builds a string generator from a (non-negative) size generator. Accepts an optional character generator (the default is {!char}). Shrinks on the number of characters first, then on the characters. *) val string : string t (** Builds a string generator. String size is generated by {!nat}. The default character generator is {!char}. See also {!string_of} and {!string_printable} for versions with custom char generator. Shrinks on the number of characters first, then on the characters. *) val string_of : char t -> string t (** Builds a string generator using the given character generator. Shrinks on the number of characters first, then on the characters. @since 0.11 *) val string_printable : string t (** Builds a string generator using the {!printable} character generator. Shrinks on the number of characters first, then on the characters. @since 0.11 *) val small_string : ?gen:char t -> string t (** Builds a string generator, length is {!small_nat}. Accepts an optional character generator (the default is {!char}). Shrinks on the number of characters first, then on the characters. *) val pure : 'a -> 'a t (** [pure a] creates a generator that always returns [a]. Does not shrink. @since 0.8 *) val return : 'a -> 'a t (** Synonym for {!pure} *) val make_primitive : gen : (Random.State.t -> 'a) -> shrink : ('a -> 'a Seq.t) -> 'a t (** [make_primitive ~gen ~shrink] creates a generator from a function [gen] that creates a random value (this function must only use the given {!Random.State.t} for randomness) and a function [shrink] that, given a value [a], returns a lazy list of "smaller" values (used when a test fails). This lower-level function is meant to build generators for "primitive" types that can neither be built with other primitive generators nor through composition, or to have more control on the shrinking steps. [shrink] must obey the following rules (for your own definition of "small"): - [shrink a = Seq.empty] when [a] is the smallest possible value - [shrink a] must return values strictly smaller than [a], ideally from smallest to largest (for faster shrinking) - [let rec loop a = match shrink a () with | Nil -> () | Cons (smaller_a, _) -> loop smaller_a] must end for all values [a] of type ['a] (i.e. there must not be an infinite number of shrinking steps). ⚠️ This is an unstable API as it partially exposes the implementation. In particular, the type of [Random.State.t] may very well change in a future version, e.g. if QCheck switches to another randomness library. *) val add_shrink_invariant : ('a -> bool) -> 'a t -> 'a t (** [add_shrink_invariant f gen] returns a generator similar to [gen] except all shrinks satisfy [f]. This way it's easy to preserve invariants that are enforced by generators, when shrinking values @since 0.8 @deprecated is this function still useful? I feel like it is either useless (invariants should already be part of the shrinking logic, not be added later) or a special, incomplete case of {!Gen.t} being an Alternative (not implemented yet). For now we keep it and wait for users feedback (hence deprecation to raise attention). *) (** {3 Ranges} *) val int_bound : int -> int t (** Uniform integer generator producing integers within [0..bound]. Shrinks towards [0]. @raise Invalid_argument if the argument is negative. *) val int_range : ?origin:int -> int -> int -> int t (** [int_range ?origin low high] is an uniform integer generator producing integers within [low..high] (inclusive). Shrinks towards [origin] if specified, otherwise towards [0] (but always stays within the range). Examples: - [int_range ~origin:6 (-5) 15] will shrink towards [6] - [int_range (-5) 15] will shrink towards [0] - [int_range 8 20] will shrink towards [8] (closest to [0] within range) - [int_range (-20) (-8)] will shrink towards [-8] (closest to [0] within range) @raise Invalid_argument if any of the following holds: - [low > high] - [origin < low] - [origin > high] *) val (--) : int -> int -> int t (** [a -- b] is an alias for [int_range a b]. See {!int_range} for more information. *) val float_bound_inclusive : ?origin : float -> float -> float t (** [float_bound_inclusive ?origin bound] returns a random floating-point number between [0.] and [bound] (inclusive). If [bound] is negative, the result is negative or zero. If [bound] is [0.], the result is [0.]. Shrinks towards [origin] if given, otherwise towards [0.]. @since 0.11 *) val float_bound_exclusive : ?origin : float -> float -> float t (** [float_bound_exclusive origin bound] returns a random floating-point number between [0.] and [bound] (exclusive). If [bound] is negative, the result is negative or zero. Shrinks towards [origin] if given, otherwise towards [0.]. @raise Invalid_argument if [bound] is [0.]. @since 0.11 *) val float_range : ?origin : float -> float -> float -> float t (** [float_range ?origin low high] generates floating-point numbers within [low] and [high] (inclusive). Shrinks towards [origin] if specified, otherwise towards [0.] (but always stays within the range). Examples: - [float_range ~origin:6.2 (-5.8) 15.1] will shrink towards [6.2] - [float_range (-5.8) 15.1] will shrink towards [0.] - [float_range 8.5 20.1] will shrink towards [8.5] (closest to [0.] within range) - [float_range (-20.1) (-8.5)] will shrink towards [-8.5] (closest to [0.] within range) @raise Invalid_argument if any of the following holds: - [low > high] - [high -. low > max_float] - [origin < low] - [origin > high] @since 0.11 *) val (--.) : float -> float -> float t (** [a --. b] is an alias for [float_range ~origin:a a b]. See {!float_range} for more information. @since 0.11 *) val char_range : ?origin:char -> char -> char -> char t (** [char_range ?origin low high] generates chars between [low] and [high], inclusive. Example: [char_range 'a' 'z'] for all lower case ASCII letters. Shrinks towards [origin] if specified, otherwise towards [low]. @raise Invalid_argument if [low > high]. @since 0.13 *) (** {3 Choosing elements} *) val oneof : 'a t list -> 'a t (** [oneof l] constructs a generator that selects among the given list of generators [l]. Shrinks towards the first generator of the list. @raise Invalid_argument or Failure if [l] is empty *) val oneofl : 'a list -> 'a t (** [oneofl l] constructs a generator that selects among the given list of values [l]. Shrinks towards the first element of the list. @raise Invalid_argument or Failure if [l] is empty *) val oneofa : 'a array -> 'a t (** [oneofa a] constructs a generator that selects among the given array of values [a]. Shrinks towards the first element of the array. @raise Invalid_argument or Failure if [l] is empty *) val frequency : (int * 'a t) list -> 'a t (** Constructs a generator that selects among a given list of generators. Each of the given generators are chosen based on a positive integer weight. Shrinks towards the first element of the list. *) val frequencyl : (int * 'a) list -> 'a t (** Constructs a generator that selects among a given list of values. Each of the given values are chosen based on a positive integer weight. Shrinks towards the first element of the list. *) val frequencya : (int * 'a) array -> 'a t (** Constructs a generator that selects among a given array of values. Each of the array entries are chosen based on a positive integer weight. Shrinks towards the first element of the array. *) (** {3 Shuffling elements} *) val shuffle_a : 'a array -> 'a array t (** Returns a copy of the array with its elements shuffled. *) val shuffle_l : 'a list -> 'a list t (** Creates a generator of shuffled lists. *) val shuffle_w_l : (int * 'a) list -> 'a list t (** Creates a generator of weighted shuffled lists. A given list is shuffled on each generation according to the weights of its elements. An element with a larger weight is more likely to be at the front of the list than an element with a smaller weight. If we want to pick random elements from the (head of) list but need to prioritize some elements over others, this generator can be useful. Example: given a weighted list [[1, "one"; 5, "five"; 10, "ten"]], the generator is more likely to generate [["ten"; "five"; "one"]] or [["five"; "ten"; "one"]] than [["one"; "ten"; "five"]] because "ten" and "five" have larger weights than "one". @since 0.11 *) (** {3 Corner cases} *) val graft_corners : 'a t -> 'a list -> unit -> 'a t (** [graft_corners gen l ()] makes a new generator that enumerates the corner cases in [l] and then behaves like [g]. Does not shrink if the test fails on a grafted value. Shrinks towards [gen] otherwise. @since 0.6 *) val int_pos_corners : int list (** Non-negative corner cases for int. @since 0.6 *) val int_corners : int list (** All corner cases for int. @since 0.6 *) (** {3 Lists, arrays and options} *) val list : 'a t -> 'a list t (** Builds a list generator from an element generator. List size is generated by {!nat}. Shrinks on the number of elements first, then on elements. *) val small_list : 'a t -> 'a list t (** Generates lists of small size (see {!small_nat}). Shrinks on the number of elements first, then on elements. @since 0.5.3 *) val list_size : int t -> 'a t -> 'a list t (** Builds a list generator from a (non-negative) size generator and an element generator. Shrinks on the number of elements first, then on elements. *) val list_repeat : int -> 'a t -> 'a list t (** [list_repeat i g] builds a list generator from exactly [i] elements generated by [g]. Shrinks on elements only. *) val array : 'a t -> 'a array t (** Builds an array generator from an element generator. Array size is generated by {!nat}. Shrinks on the number of elements first, then on elements. *) val array_size : int t -> 'a t -> 'a array t (** Builds an array generator from a (non-negative) size generator and an element generator. Shrinks on the number of elements first, then on elements. *) val small_array : 'a t -> 'a array t (** Generates arrays of small size (see {!small_nat}). Shrinks on the number of elements first, then on elements. @since 0.10 *) val array_repeat : int -> 'a t -> 'a array t (** [array_repeat i g] builds an array generator from exactly [i] elements generated by [g]. Shrinks on elements only. *) val opt : ?ratio:float -> 'a t -> 'a option t (** [opt gen] is an [option] generator that uses [gen] when generating [Some] values. Shrinks towards {!None} then towards shrinks of [gen]. @param ratio a float between [0.] and [1.] indicating the probability of a sample to be [Some _] rather than [None] (value is [0.85]). *) (** {3 Combining generators} *) val pair : 'a t -> 'b t -> ('a * 'b) t (** [pair gen1 gen2] generates pairs. Shrinks on [gen1] and then [gen2]. *) val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t (** [triple gen1 gen2 gen3] generates triples. Shrinks on [gen1], then [gen2] and then [gen3]. *) val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t (** [quad gen1 gen2 gen3 gen4] generates quadruples. Shrinks on [gen1], then [gen2], then [gen3] and then [gen4]. @since 0.5.1 *) (** {3 Convert a structure of generator to a generator of structure} *) val flatten_l : 'a t list -> 'a list t (** Generate a list of elements from individual generators. Shrinks on the elements of the list, in the list order. @since 0.13 *) val flatten_a : 'a t array -> 'a array t (** Generate an array of elements from individual generators. Shrinks on the elements of the array, in the array order. @since 0.13 *) val flatten_opt : 'a t option -> 'a option t (** Generate an option from an optional generator. Shrinks towards {!None} then shrinks on the value. @since 0.13 *) val flatten_res : ('a t, 'e) result -> ('a,'e) result t (** Generate a result from [Ok gen], an error from [Error e]. Shrinks on [gen] if [Ok gen]. Does not shrink if [Error e]. @since 0.13 *) val join : 'a t t -> 'a t (** Collapses a generator of generators to a generator. Shrinks on the generated generators. @since 0.5 *) (** {3 Influencing the size of generated values} *) val sized : 'a sized -> 'a t (** Creates a generator from a size-bounded generator by first generating a size using {!nat} and passing the result to the size-bounded generator. Shrinks on the size first, then on the generator. *) val sized_size : int t -> 'a sized -> 'a t (** Creates a generator from a size-bounded generator by first generating a size using the integer generator and passing the result to the size-bounded generator. Shrinks on the size first, then on the generator. @since 0.5 *) (** {3 Recursive data structures} *) val fix : (('a -> 'b t) -> 'a -> 'b t) -> 'a -> 'b t (** Parametrized fixpoint combinator for generating recursive values. The fixpoint is parametrized over an generator state ['a], and the fixpoint computation may change the value of this state in the recursive calls. In particular, this can be used for size-bounded generators (with ['a] as [int]). The passed size-parameter should decrease to ensure termination. *) (** Example: {[ type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let g = QCheck.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] )) ]} [fix f] shrinks on the generators returned by [f]. *) val delay : (unit -> 'a t) -> 'a t (** Delay execution of some code until the generator is actually called. This can be used to manually implement recursion or control flow in a generator. @since 0.17 *) (** {2:composing_generators Composing generators} QCheck generators compose well: it means one can easily craft generators for new values or types from existing generators. Part of the following documentation is greatly inspired by Gabriel Scherer's excellent {{:http://gasche.github.io/random-generator/doc/Generator.html } Generator} module documentation. {3 Functor} [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], given a simple function ['a -> 'b]. {[ let even_gen : int Gen.t = Gen.map (fun n -> n * 2) Gen.int let odd_gen : int Gen.t = Gen.map (fun n -> n * 2 + 1) Gen.int let lower_case_string_gen : string Gen.t = Gen.map String.lowercase Gen.string_printable type foo = Foo of string * int let foo_gen : foo Gen.t = Gen.map (fun (s, n) -> Foo (s, n)) Gen.(pair string_printable int) ]} {3 Applicative} [Gen.t] is applicative: it has a [map2] function to apply a function of 2 (or more) arguments to 2 (or more) generators. Another equivalent way to look at it is that it has an [ap] function to apply a generator of functions to a generator of values. While at first sight this may look almost useless, it actually permits a nice syntax (using the operator alias [<*>]) for functions of any number of arguments. {[ (* Notice that this looks suspiciously like the [foo] example above: this is no coincidence! [pair] is a special case of [map2] where the function wraps arguments in a tuple. *) type foo = Foo of string * int let foo_gen : foo Gen.t = Gen.map2 (fun s n -> Foo (s, n)) Gen.string_printable Gen.int let string_prefixed_with_keyword_gen : string Gen.t = Gen.map2 (fun prefix s -> prefix ^ s) (Gen.oneofl ["foo"; "bar"; "baz"]) Gen.string_printable ]} Applicatives are useful when you need several random values to build a new generator, {b and the values are unrelated}. A good rule of thumb is: if the values could be generated in parallel, then you can use an applicative function to combine those generators. Note that while [map2] and [map3] are provided, you can use functions with more than 3 arguments (and that is where the [<*>] operator alias really shines): {[ val complex_function : bool -> string -> int -> string -> int64 -> some_big_type (* Verbose version, using map3 and ap *) let big_type_gen : some_big_type Gen.t = Gen.( ap ( ap ( map3 complex_function bool string_printable int) string_printable) int64) (* Sleeker syntax, using operators aliases for map and ap *) let big_type_gen : some_big_type Gen.t = Gen.( complex_function <$> bool <*> string_printable <*> int <*> string_printable <*> int64) ]} {3 Monad} [Gen.t] is a monad: it has a [bind] function to return a {b generator} (not a value) based on {b another generated value}. As an example, imagine you want to create a generator of [(int, string) result] that is an [Ok] 90% of the time and an [Error] 10% of the time. You can generate a number between 0 and 9 and return a generator of [int] (wrapped in an [Ok] using [map]) if the generated number is lower than 9, otherwise return a generator of [string] (wrapped in an [Error] using [map]): {[ let int_string_result : (int, string) result Gen.t = Gen.( bind (int_range 0 9) (fun n -> if n < 9 then map Result.ok int else map Result.error string_printable)) (* Alternative syntax with operators *) let int_string_result : (int, string) result Gen.t = Gen.( int_range 0 9 >>= fun n -> if n < 9 then int >|= Result.ok else string_printable >|= Result.error) (* Another allternative syntax with OCaml 4.08+ binding operators *) let int_string_result : (int, string) result Gen.t = Gen.( let* n = int_range 0 9 in if n < 9 then int >|= Result.ok else string_printable >|= Result.error) ]} Note that this particular use case can be simplified by using [frequency]: {[ let int_string_result : (int, string) result Gen.t = Gen.( frequency [ (9, int >|= Result.ok); (1, string_printable >|= Result.error) ]) ]} *) val map : ('a -> 'b) -> 'a t -> 'b t (** [map f gen] transforms a generator [gen] by applying [f] to each generated element. Shrinks towards the shrinks of [gen] with [f] applied to them. *) val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** An infix synonym for {!map}. Note the order of arguments is reversed (usually more convenient for composing). *) val (<$>) : ('a -> 'b) -> 'a t -> 'b t (** An infix synonym for {!map} @since 0.13 *) val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t (** [map2 f gen1 gen2] transforms two generators [gen1] and [gen2] by applying [f] to each pair of generated elements. Shrinks on [gen1] and then [gen2]. *) val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t (** [map3 f gen1 gen2 gen3] transforms three generators [gen1], [gen2], and [gen3] by applying [f] to each triple of generated elements. Shrinks on [gen1], then [gen2], and then [gen3]. *) val ap : ('a -> 'b) t -> 'a t -> 'b t (** [ap fgen gen] composes a function generator and an argument generator into a result generator. Shrinks on [fgen] and then [gen]. *) val (<*>) : ('a -> 'b) t -> 'a t -> 'b t (** Synonym for {!ap} *) val bind : 'a t -> ('a -> 'b t) -> 'b t (** [bind gen f] first generates a value of type ['a] with [gen] and then passes it to [f] to generate a value of type ['b]. This is typically useful when a generator depends on the value generated by another generator. Shrinks on [gen] and then on the resulting generator. *) val (>>=) : 'a t -> ('a -> 'b t) -> 'b t (** Synonym for {!bind} *) val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t (** {{: https://ocaml.org/manual/bindingops.html} Binding operator} alias for {!map}. Example: {[ let+ n = int_range 0 10 in string_of_int n (* is equivalent to *) map (fun n -> string_of_int n) (int_range 0 10) ]} *) val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t (** {{: https://ocaml.org/manual/bindingops.html} Binding operator} alias for {!pair}. Example: {[ let+ n = int_range 0 10 and+ b = bool in if b then string_of_int n else "Not a number" (* is equivalent to *) map (fun (n, b) -> if b then string_of_int n else "Not a number") (pair (int_range 0 10) bool) ]} *) val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t (** {{: https://ocaml.org/manual/bindingops.html} Binding operator} alias for {!bind}. Example: {[ let* n = int_range 0 9 in if n < 9 then int >|= Result.ok else string_printable >|= Result.error (* is equivalent to *) bind (int_range 0 9) (fun n -> if n < 9 then map Result.ok int else map Result.error string_printable) ]} *) val ( and* ) : 'a t -> 'b t -> ('a * 'b) t (** {{: https://ocaml.org/manual/bindingops.html} Binding operator} alias for {!pair}. Example: {[ let* n = int_range 0 9 and* b = bool in if n < 9 then int >|= Result.ok else if b then pure (Error "Some specific error") else string_printable >|= Result.error (* is equivalent to *) bind (pair (int_range 0 9) bool) (fun (n, b) -> if n < 9 then map Result.ok int else if b then pure (Error "Some specific error") else map Result.error string_printable) ]} *) (** {2 Debug generators} These functions should not be used in tests: they are provided for convenience to debug/investigate what values and shrinks a generator produces. *) val generate : ?rand:Random.State.t -> n:int -> 'a t -> 'a list (** [generate ~n gen] generates [n] values using [gen] (shrinks are discarded). *) val generate1 : ?rand:Random.State.t -> 'a t -> 'a (** [generate1 gen] generates one instance of [gen] (shrinks are discarded). *) val generate_tree : ?rand:Random.State.t -> 'a t -> 'a Tree.t (** [generate_tree ?rand gen] generates a random value and its shrinks using [gen]. *) end (** Printing functions and helpers, used to print generated values on test failures. *) module Print : sig type 'a t = 'a -> string (** Printer for values of type ['a]. *) val unit : unit t (** [unit] is a printer of unit. @since 0.6 *) val int : int t (** [int] is a printer of integer. *) val bool : bool t (** [bool] is a printer of boolean. *) val float : float t (** [float] is a printer of float. *) val char : char t (** [char] is a printer of character. *) val string : string t (** [string] is a printer of string. *) val option : 'a t -> 'a option t (** [option p] is a printer of ['a option], using [p] if it is a [Some]. *) val pair : 'a t -> 'b t -> ('a*'b) t (** [pair p1 p2] is a printer of pair. *) val triple : 'a t -> 'b t -> 'c t -> ('a*'b*'c) t (** [triple p1 p2 p3] is a printer of triple. *) val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a*'b*'c*'d) t (** [quad p1 p2 p3 p4] is a printer of quadruple. *) val list : 'a t -> 'a list t (** [list p] is a printer of list, using [p] for each element. *) val array : 'a t -> 'a array t (** [array p] is a printer of array, using [p] for each element. *) val contramap : ('b -> 'a) -> 'a t -> 'b t (** [contramap f p] transforms printer [p] into another using [f]. Note the reverse order of types in [f] which may be conter-intuitive: indeed a function that {i prints} values of type ['b] can be obtained by transforming a value of type ['b] to ['a] using [f], and then by {i printing} this value of type ['a] using [p]. *) val comap : ('b -> 'a) -> 'a t -> 'b t (** @deprecated use {!contramap} instead. *) end (** Shrinking helper functions. *) module Shrink : sig (** Shrinking is used to reduce the size of a counter-example. It tries to make the counter-example smaller by decreasing it, or removing elements, until the property to test holds again; then it returns the smallest value that still made the test fail. This is meant to help developers find a simpler counter-example to ease investigation and find more easily the root cause (be it in the tested code or in the test). This module exposes helper functions that one can reuse in combination with {!Gen.make_primitive} to craft custom primitive generators (not by composing other generators). The vast majority of use cases will probably not need this module. *) (** Util module representing a number type, used for ad hoc polymorphism of some functions like {!number_towards}. *) module type Number = sig type t val equal : t -> t -> bool val div : t -> t -> t val add : t -> t -> t val sub : t -> t -> t val of_int : int -> t end val number_towards : (module Number with type t = 'a) -> destination : 'a -> 'a -> 'a Seq.t (** Shrink a number by edging towards a destination. The destination is always the first value for optimal shrinking. {[ let int64_towards_list destination x = List.of_seq @@ Gen.number_towards (module Int64) ~destination x in assert (int64_towards_list 0L 100L = [0L; 50L; 75L; 88L; 94L; 97L; 99L]); assert (int64_towards_list 500L 1000L = [500L; 750L; 875L; 938L; 969L; 985L; 993L; 997L; 999L]); assert (int64_towards_list (-50L) (-26L) = [-50L; -38L; -32L; -29L; -28L; -27L]) ]} This generic function is exposed to let users reuse this shrinking technique for their custom number types. More specialized, convenient functions are provided below, e.g. {!int_towards}. *) val int_towards : int -> int -> int Seq.t (** {!number_towards} specialized to {!int}. *) val int32_towards : int32 -> int32 -> int32 Seq.t (** {!number_towards} specialized to {!int32}. *) val int64_towards : int64 -> int64 -> int64 Seq.t (** {!number_towards} specialized to {!int64}. *) val float_towards : float -> float -> float Seq.t (** {!number_towards} specialized to {!float}. There are various ways to shrink a float: - try removing floating digits, i.e. towards integer values - try to get as close as possible to the destination, no matter the number of digits - a mix of both This implementation, as it relies on the generic {!number_towards} function, tries to get as close as possible to the destination, e.g. the last value of [Gen.float_towards 50 100] may be [99.9969482421875] (or a similar value). *) val int_aggressive_towards : int -> int -> int Seq.t (** [int_agressive_towards destination n] gives all integers from [destination] to [n] (excluded). {b Be careful about time and memory} as the resulting list can be huge *) val int_aggressive : int -> int Seq.t (** @deprecated Use [int_aggressive_towards 0] instead. @since 0.7 *) end (** An observable is a random function {i argument}. *) module Observable : sig (** While random functions don't need to generate {i values} of their arguments, they need the abilities to: - compare, using [equal] and [hash], so that the same argument always returns the same generated value - [print], in order to print the function implementation (bindings) in case of test failure Inspired by: - Jane Street {{: https://blogs.janestreet.com/quickcheck-for-core/} Quickcheck for Core} blog post - Koen Claessen's {{: https://www.youtube.com/watch?v=CH8UQJiv9Q4} Shrinking and Showing functions} paper @since 0.6 *) type -'a t (** An observable of ['a], packing a printer and other things. *) val make : ?eq:('a -> 'a -> bool) -> ?hash:('a -> int) -> 'a Print.t -> 'a t (** [make ?eq ?hash print] creates an observable of ['a]. If [eq] is [None], uses the standard polymorphic [(=)] function. If [hash] is [None], uses a default hashing function. *) val equal : 'a t -> 'a -> 'a -> bool (** [equal o] returns the equality function of [o]. *) val hash : 'a t -> 'a -> int (** [hash o] returns the hashing function of [o]. *) val print : 'a t -> 'a Print.t (** [print o] returns the printing function of [o]. *) val unit : unit t (** [unit] is an observable of [unit]. *) val bool : bool t (** [bool] is an observable of [bool]. *) val int : int t (** [int] is an observable of [int]. *) val float : float t (** [float] is an observable of [float]. *) val string : string t (** [string] is an observable of [string]. *) val char : char t (** [char] is an observable of [char]. *) val contramap : ('b -> 'a) -> 'a t -> 'b t (** [contramap f o] maps the function [f] on observable [o]. Note the reverse order of types in [f] which may be conter-intuitive: indeed a function that {i consumes} values of type ['b] can be obtained by transforming a value of type ['b] to ['a] using [f], and then by {i consuming} this value of type ['a] using [o]. *) val map : ('b -> 'a) -> 'a t -> 'b t (** @deprecated use {!contramap} instead. *) val option : 'a t -> 'a option t (** [option o] wraps the observable [o] of ['a] into an observable of ['a option]. *) val list : 'a t -> 'a list t (** [list o] wraps the observable [o] of ['a] into an observable of ['a list]. *) val array : 'a t -> 'a array t (** [array o] wraps the observable [o] of ['a] into an observable of ['a array]. *) val pair : 'a t -> 'b t -> ('a * 'b) t (** [pair o1 o2] is an observable of pairs of [('a * 'b)]. *) val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t (** [triple o1 o2 o3] is an observable of triples of [('a * 'b * 'c)]. *) val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t (** [quad o1 o2 o3 o4] is an observable of quadruples of [('a * 'b * 'c * 'd)]. *) end (** Utils on combining function arguments. *) module Tuple : sig (** Heterogeneous tuple, used to pass any number of arguments to a function. *) type 'a t = | Nil : unit t | Cons : 'a * 'b t -> ('a * 'b) t val nil : unit t (** [nil] is {!Nil}. *) val cons : 'a -> 'b t -> ('a * 'b) t (** [cons] is {!Cons}. *) type 'a obs (** How to observe a {!t}. See {!module:Observable} for more information on what "observe" means in the QCheck. *) val o_nil : unit obs (** [o_nil] is the {!obs} equivalent of {!nil}. *) val o_cons : 'a Observable.t -> 'b obs -> ('a * 'b) obs (** [o_cons] is the {!obs} equivalent of {!cons}. *) val observable : 'a obs -> 'a t Observable.t (** [observable obs] returns the underlying observable of [obs]. *) (** Infix {!module:Tuple} operators for convenience. *) module Infix : sig val (@::) : 'a -> 'b t -> ('a * 'b) t (** Alias for {!cons}. *) val (@->) : 'a Observable.t -> 'b obs -> ('a * 'b) obs (** Alias for {!o_cons}. *) end include module type of Infix end type 'f fun_repr (** Used by QCheck to shrink and print generated functions of type ['f] in case of test failure. You cannot and should not use it yourself. See {!fun_} for more information. *) (** A function packed with the data required to print/shrink it. The idiomatic way to use any [fun_] Gen.t is to directly pattern match on it to obtain the executable function. For example (note the [Fun (_, f)] part): {[ QCheck2.(Test.make Gen.(pair (fun1 Observable.int bool) (small_list int)) (fun (Fun (_, f), l) -> l = (List.rev_map f l |> List.rev l)) ]} In this example [f] is a generated function of type [int -> bool]. The ignored part [_] of [Fun (_, f)] is useless to you, but is used by QCheck during shrinking/printing in case of test failure. See also {!Fn} for utils to print and apply such a function. *) type 'f fun_ = Fun of 'f fun_repr * 'f val fun1 : 'a Observable.t -> ?print:('b Print.t) -> 'b Gen.t -> ('a -> 'b) fun_ Gen.t (** [fun1 obs gen] generates random functions that take an argument observable via [obs] and map to random values generated with [gen]. To write functions with multiple arguments, it's better to use {!Tuple} or {!Observable.pair} rather than applying {!fun_} several times (shrinking will be faster). @since 0.6 *) val fun2 : 'a Observable.t -> 'b Observable.t -> ?print:'c Print.t -> 'c Gen.t -> ('a -> 'b -> 'c) fun_ Gen.t (** Specialized version of {!fun_nary} for functions of 2 arguments, for convenience. @since 0.6 *) val fun3 : 'a Observable.t -> 'b Observable.t -> 'c Observable.t -> ?print:'d Print.t -> 'd Gen.t -> ('a -> 'b -> 'c -> 'd) fun_ Gen.t (** Specialized version of {!fun_nary} for functions of 3 arguments, for convenience. @since 0.6 *) val fun4 : 'a Observable.t -> 'b Observable.t -> 'c Observable.t -> 'd Observable.t -> ?print:'e Print.t -> 'e Gen.t -> ('a -> 'b -> 'c -> 'd -> 'e) fun_ Gen.t (** Specialized version of {!fun_nary} for functions of 4 arguments, for convenience. @since 0.6 *) val fun_nary : 'a Tuple.obs -> ?print:('b Print.t) -> 'b Gen.t -> ('a Tuple.t -> 'b) fun_ Gen.t (** [fun_nary tuple_obs gen] generates random n-ary functions. Arguments are observed using [tuple_obs] and return values are generated using [gen]. Example (the property is wrong as a random function may return [false], this is for the sake of demonstrating the syntax): {[ let module O = Observable in Test.make (fun_nary Tuple.(O.int @-> O.float @-> O.string @-> o_nil) bool) (fun (Fun (_, f)) -> f Tuple.(42 @:: 17.98 @:: "foobar" @:: nil)) ]} Note that this particular example can be simplified using {!fun3} directly: {[ let module O = Observable in Test.make (fun3 O.int O.float O.string bool) (fun (Fun (_, f)) -> f 42 17.98 "foobar") ]} @since 0.6 *) (** Utils on generated functions. @since 0.6 *) module Fn : sig val print : 'f fun_ Print.t (** [print f] prints the implementation of generated function [f]. The implementation always contains a default case, represented as [_]. Note that printing a function {i before} it was called in the test may not print the full implementation. *) val apply : 'f fun_ -> 'f (** [apply f] returns the underlying function to be used in tests. This is an alias for deconstructing as documented in {!fun_}. *) end (** {2 Assumptions} *) val assume : bool -> unit (** [assume cond] checks the precondition [cond], and does nothing if [cond=true]. If [cond=false], it interrupts the current test (but the test will not be failed). ⚠️ This function must only be used in a test, not outside. Example: {[ Test.make (list int) (fun l -> assume (l <> []); List.hd l :: List.tl l = l) ]} @since 0.5.1 *) val (==>) : bool -> bool -> bool (** [b1 ==> b2] is the logical implication [b1 => b2] ie [not b1 || b2] (except that it is strict and will interact better with {!Test.check_exn} and the likes, because they will know the precondition was not satisfied.). ⚠️ This function should only be used in a property (see {!Test.make}), because it raises a special exception in case of failure of the first argument, to distinguish between failed test and failed precondition. Because of OCaml's evaluation order, both [b1] and [b2] are always evaluated; if [b2] should only be evaluated when [b1] holds, see {!assume}. *) val assume_fail : unit -> 'a (** [assume_fail ()] is like [assume false], but can take any type since we know it always fails (like [assert false]). This is useful to ignore some branches in [if] or [match]. Example: {[ Test.make (list int) (function | [] -> assume_fail () | _::_ as l -> List.hd l :: List.tl l = l) ]} @since 0.5.1 *) (** {1 Tests} A test is a universal property of type [foo -> bool] for some type [foo], with an object of type [foo Gen.t] used to generate values of type [foo]. See {!Test.make} to build a test, and {!Test.check_exn} to run one test simply. For more serious testing, it is better to create a testsuite and use {!QCheck_runner}. *) type 'a stat = string * ('a -> int) (** A statistic on a distribution of values of type ['a]. The function {b MUST} return a positive integer. *) (** Result of running a test *) module TestResult : sig type 'a counter_ex = { instance: 'a; (** The counter-example *) shrink_steps: int; (** How many shrinking steps for this counter-example *) msg_l: string list; (** Messages of the test. Currently only populated by {!Test.fail_report} and {!Test.fail_reportf}. @since 0.7 *) } (** A counter-example when a test fails. *) (** Result state. changed in 0.10 (move to inline records, add Fail_other) *) type 'a state = | Success (** If the test passed. *) | Failed of { instances: 'a counter_ex list; (** Failed instance(s) *) } (** If the test failed "normally", i.e. a test returned [false]. *) | Failed_other of {msg: string} (** If the test failed for an unusual reason: - an exception was raised by a generator - too many assumptions failed and [Test.if_assumptions_fail] was set to [`Fatal] *) | Error of { instance: 'a counter_ex; (** Instance that triggered the exception in the test *) exn: exn; (** The raised exception *) backtrace: string; (** A best-effort backtrace of the exception *) } (** If the test failed "exceptionally" (an exception was raised by the test). *) (* Result returned by running a test. *) type 'a t val get_state : 'a t -> 'a state (** [get_state t] returns the final state after a test execution. *) val get_count : _ t -> int (** [get_count t] returns the number of tests executed. *) val get_count_gen : _ t -> int (** [get_count_gen t] returns the number of generated cases. *) val get_collect : _ t -> (string,int) Hashtbl.t option (** [get_collect t] returns the repartition of generated values. @since 0.18 *) val get_stats : 'a t -> ('a stat * (int,int) Hashtbl.t) list (** [get_stats t] returns the statistics captured by the test. @since 0.18 *) val get_warnings : _ t -> string list (** [get_warnings t] returns the list of warnings emitted during the test. @since 0.18 *) val get_instances : 'a t -> 'a list (** [get_instances t] returns the generated instances, with no guarantee on the order. @since 0.18 *) val is_success : _ t -> bool (** Returns true iff the state if [Success] @since 0.9 *) val stats : 'a t -> ('a stat * (int,int) Hashtbl.t) list (** Obtain statistics @since 0.6 @deprecated use {!get_stats} instead *) val warnings : _ t -> string list (** Obtain list of warnings @since 0.10 @deprecated use {!get_warnings} instead *) val collect : _ t -> (string,int) Hashtbl.t option (** Obtain statistics @since 0.6 @deprecated use {!get_collect} instead *) end module Test_exceptions : sig exception Test_fail of string * string list (** Exception raised when a test failed, with the list of counter-examples. [Test_fail (name, l)] means test [name] failed on elements of [l]. *) exception Test_error of string * string * exn * string (** Exception raised when a test raised an exception [e], with the sample that triggered the exception. [Test_error (name, i, e, st)] means [name] failed on [i] with exception [e], and [st] is the stacktrace (if enabled) or an empty string. *) end (** A test is a pair of an generator and a property thar all generated values must satisfy. *) module Test : sig (** The main features of this module are: - {!make} a test - fail the test if a property does not hold (using either the {{!fail_report} simple} form or the {{!fail_reportf} rich} form) - {!check_exn} a single test 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 QCheck tests to your favorite test framework: - {!QCheck_base_runner} for a QCheck-only runner (useful if you don't have or don't need another test framework) - {!QCheck_alcotest} to convert to Alcotest framework - {!QCheck_ounit} to convert to OUnit framework *) type 'a cell (** A single property test on a value of type ['a]. A {!Test.t} wraps a [cell] and hides its type parameter. *) val make_cell : ?if_assumptions_fail:([`Fatal | `Warning] * float) -> ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?name:string -> ?print:'a Print.t -> ?collect:('a -> string) -> ?stats:('a stat list) -> 'a Gen.t -> ('a -> bool) -> 'a cell (** [make_cell gen prop] builds a test that checks property [prop] on instances of the generator [gen]. @param name the name of the test. @param count number of test cases to run, counting only the test cases which satisfy preconditions. @param long_factor the factor by which to multiply count, max_gen and max_fail when running a long test (default: 1). @param max_gen maximum number of times the generation function is called in total to replace inputs that do not satisfy preconditions (should be >= count). @param max_fail maximum number of failures before we stop generating inputs. This is useful if shrinking takes too much time. @param if_assumptions_fail the minimum fraction of tests that must satisfy the precondition for a success to be considered valid. The fraction should be between 0. and 1. A warning will be emitted otherwise if the flag is [`Warning], the test will be a failure if the flag is [`Fatal]. (since 0.10) @param print used in {!Print} to display generated values failing the [prop] @param collect (* collect values by tag, useful to display distribution of generated *) @param stats on a distribution of values of type 'a *) val make_cell_from_QCheck1 : ?if_assumptions_fail:([`Fatal | `Warning] * float) -> ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?name:string -> gen:(Random.State.t -> 'a) -> ?shrink:('a -> ('a -> unit) -> unit) -> ?print:('a -> string) -> ?collect:('a -> string) -> stats:'a stat list -> ('a -> bool) -> 'a cell (** ⚠️ Do not use, this is exposed for internal reasons only. ⚠️ @deprecated Migrate to QCheck2 and use {!make_cell} instead. *) val get_law : 'a cell -> ('a -> bool) val get_name : _ cell -> string val get_gen : 'a cell -> 'a Gen.t val get_print_opt : 'a cell -> ('a Print.t) option val get_collect_opt : 'a cell -> ('a -> string) option val get_stats : 'a cell -> ('a stat list) val set_name : _ cell -> string -> unit val get_count : _ cell -> int (** Get the count of a cell. @since 0.5.3 *) val get_long_factor : _ cell -> int (** Get the long factor of a cell. @since 0.5.3 *) type t = Test : 'a cell -> t (** Same as ['a cell], but masking the type parameter. This allows to put tests on different types in the same list of tests. *) val make : ?if_assumptions_fail:([`Fatal | `Warning] * float) -> ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?name:string -> ?print:('a Print.t) -> ?collect:('a -> string) -> ?stats:('a stat list) -> 'a Gen.t -> ('a -> bool) -> t (** [make gen prop] builds a test that checks property [prop] on instances of the generator [gen]. See {!make_cell} for a description of the parameters. *) val test_get_count : t -> int val fail_report : string -> 'a (** Fail the test with some additional message that will be reported. @since 0.7 *) val fail_reportf : ('a, Format.formatter, unit, 'b) format4 -> 'a (** Format version of {!fail_report}. Example: {[ Test.fail_reportf "Value N = %i should be greater than M = %i for Foo = %a" n m pp_foo foo ]} @since 0.7 *) (** {3 Running the test} *) include module type of Test_exceptions val print_instance : 'a cell -> 'a -> string val print_c_ex : 'a cell -> 'a TestResult.counter_ex -> string val print_fail : 'a cell -> string -> 'a TestResult.counter_ex list -> string val print_fail_other : string -> msg:string -> string val print_error : ?st:string -> 'a cell -> string -> 'a TestResult.counter_ex * exn -> string val print_test_fail : string -> string list -> string val print_test_error : string -> string -> exn -> string -> string val print_collect : (string,int) Hashtbl.t -> string (** Print "collect" results. @since 0.6 *) val print_stat : ('a stat * (int,int) Hashtbl.t) -> string (** Print statistics. @since 0.6 *) val check_result : 'a cell -> 'a TestResult.t -> unit (** [check_result cell res] checks that [res] is [Ok _], and returns unit. Otherwise, it raises some exception. @raise Test_error if [res = Error _] @raise Test_error if [res = Failed _] *) type res = | Success | Failure | FalseAssumption | Error of exn * string type 'a event = | Generating | Collecting of 'a | Testing of 'a | Shrunk of int * 'a | Shrinking of int * int * 'a type 'a handler = string -> 'a cell -> 'a event -> unit (** Handler executed after each event during testing of an instance. *) type 'a step = string -> 'a cell -> 'a -> res -> unit (** Callback executed after each instance of a test has been run. The callback is given the instance tested, and the current results of the test. *) type 'a callback = string -> 'a cell -> 'a TestResult.t -> unit (** Callback executed after each test has been run. [f name cell res] means test [cell], named [name], gave [res]. *) val check_cell : ?long:bool -> ?call:'a callback -> ?step:'a step -> ?handler:'a handler -> ?rand:Random.State.t -> 'a cell -> 'a TestResult.t (** [check_cell ~long ~rand test] generates up to [count] random values of type ['a] using [Gen.t] and the random state [st]. The predicate [law] is called on them and if it returns [false] or raises an exception then we have a counter-example for the [law]. @param long if [true] then multiply the number of instances to generate by the cell's long_factor. @param call function called on each test case, with the result. @param step function called on each instance of the test case, with the result. @return the result of the test. *) val check_cell_exn : ?long:bool -> ?call:'a callback -> ?step:'a step -> ?rand:Random.State.t -> 'a cell -> unit (** Same as {!check_cell} but calls {!check_result} on the result. @raise Test_error if [res = Error _] @raise Test_error if [res = Failed _] *) val check_exn : ?long:bool -> ?rand:Random.State.t -> t -> unit (** Checks the property against some test cases, and calls {!check_result}, which might raise an exception in case of failure. @raise Test_error if [res = Error _] @raise Test_error if [res = Failed _] *) end (** {2 Sub-tests} *) (** The infrastructure used to find counter-examples to properties can also be used to find data satisfying a predicate, {i within a property being tested}. See https://github.com/c-cube/qcheck/issues/31 *) exception No_example_found of string (** Raised by {!find_example} and {!find_example_gen} if no example was found. *) val find_example : ?name:string -> ?count:int -> f:('a -> bool) -> 'a Gen.t -> 'a Gen.t (** [find_example ~f gen] uses [gen] to generate some values of type ['a], and checks them against [f]. If such a value is found, it is returned. Otherwise an exception is raised. ⚠️ This should only be used from within a property in {!Test.make}. @param name Description of the example to find (used in test results/errors). @param count Number of attempts. @param f The property that the generated values must satisfy. @raise No_example_found If no example is found within [count] tries. @since 0.6 *) val find_example_gen : ?rand:Random.State.t -> ?name:string -> ?count:int -> f:('a -> bool) -> 'a Gen.t -> 'a (** Toplevel version of {!find_example}. [find_example_gen ~f gen] is roughly the same as [Gen.generate1 @@ find_example ~f gen]. @param rand the random state to use to generate inputs. @raise No_example_found if no example was found within [count] tries. @since 0.6 *) (** {1:migration_qcheck2 Migration to QCheck2} QCheck2 is a major release and as such, there are (as few as possible) breaking changes, as well as functional changes you should be aware of. {2 Minimal changes} Most of your QCheck (v1) code should be able to compile and run the first time you upgrade your QCheck version to a QCheck2-compatible version. However you may need to do the following minimal changes: - {!QCheck.Test.make} return type was changed to {!QCheck2.Test.t} to be able to run both QCheck and QCheck2 tests together. This is transparent if you used type inference, but if you explicitly used {!QCheck.Test.t} you will need to change it to {!QCheck2.Test.t}. {2 Recommended changes} Now you want to actually start using the QCheck2 features (most importantly: free shrinking!). To get started, change all your {!QCheck} references to {!QCheck2} and follow the compiler errors. Below are the most common situations you may encounter: - as shrinking is now integrated, several function arguments like [~shrink] or [~rev] have been removed: you can remove such reverse functions, they will no longer be necessary. - accessor functions like {!QCheck.gen} have been renamed to consistent names like {!get_gen}. - {!QCheck.map_keep_input} has been removed: you can use {!map} directly. - {!Gen.t} is no longer public, it is now abstract: it is recommended to use {{!section:Gen.composing_generators} generator composition} to make generators. {!Gen.make_primitive} was added to create generators with finer control (in particular of shrinking). *) qcheck-0.18.1/src/core/dune000066400000000000000000000002521417677125000154450ustar00rootroot00000000000000 (library (name qcheck_core) (public_name qcheck-core) (wrapped false) (libraries unix bytes) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) ) qcheck-0.18.1/src/dune000066400000000000000000000004001417677125000145100ustar00rootroot00000000000000 (library (name qcheck) (public_name qcheck) (wrapped false) (modules QCheck_runner) (synopsis "compatibility library for qcheck") (libraries qcheck-core qcheck-core.runner qcheck-ounit)) (documentation (package qcheck) (mld_files index)) qcheck-0.18.1/src/index.mld000066400000000000000000000006511417677125000154470ustar00rootroot00000000000000 {1 QCheck compatibility package} This library is there to ensure compatibility with QCheck 0.8 and earlier. It has a unique module {!QCheck_runner} that merges the custom runners from [qcheck-core.runner] ({!QCheck_base_runner}) and the OUnit runners from [qcheck-ounit] ({!QCheck_ounit}) into a single module. By depending on [qcheck-core], this library also brings {!QCheck} in scope, so it can be used transparently. qcheck-0.18.1/src/ounit/000077500000000000000000000000001417677125000147765ustar00rootroot00000000000000qcheck-0.18.1/src/ounit/QCheck_ounit.ml000066400000000000000000000161721417677125000177130ustar00rootroot00000000000000 open OUnit open QCheck_base_runner let ps = print_string let va = Printf.sprintf let pf = Printf.printf let not_success = function RSuccess _ -> false | _ -> true let result_path = function | RSuccess path | RError (path, _) | RFailure (path, _) | RSkip (path, _) | RTodo (path, _) -> path let result_msg = function | RSuccess _ -> "Success" | RError (_, msg) | RFailure (_, msg) | RSkip (_, msg) | RTodo (_, msg) -> msg let result_flavour = function | RError _ -> `Red, "Error" | RFailure _ -> `Red, "Failure" | RSuccess _ -> `Green, "Success" | RSkip _ -> `Blue, "Skip" | RTodo _ -> `Yellow, "Todo" let string_of_path path = let path = List.filter (function Label _ -> true | _ -> false) path in String.concat ">" (List.rev_map string_of_node path) let separator1 = "\027[K" ^ (String.make 79 '\\') let separator2 = String.make 79 '/' let print_result_list ~colors = List.iter (fun result -> let c, res = result_flavour result in pf "%s\n%a: %s\n\n%s\n%s\n" separator1 (Color.pp_str_c ~colors c) res (string_of_path (result_path result)) (result_msg result) separator2) let conf_seed = OUnit2.Conf.make_int "seed" ~-1 "set random seed" let conf_verbose = OUnit2.Conf.make_bool "qcheck_verbose" true "enable verbose QCheck tests" let conf_long = OUnit2.Conf.make_bool "qcheck_long" false "enable long QCheck tests" let default_rand () = (* random seed, for repeatability of tests *) Random.State.make [| 89809344; 994326685; 290180182 |] let to_ounit2_test ?(rand =default_rand()) (QCheck2.Test.Test cell) = let module T = QCheck2.Test in let name = T.get_name cell in let open OUnit2 in name >: test_case ~length:OUnitTest.Long (fun ctxt -> let rand = match conf_seed ctxt with | -1 -> Random.State.copy rand | s -> (* user provided random seed *) Random.State.make [| s |] in let verbose = conf_verbose ctxt in let long = conf_long ctxt in let print = { Raw. info = (fun fmt -> logf ctxt `Info fmt); fail = (fun fmt -> Printf.ksprintf assert_failure fmt); err = (fun fmt -> logf ctxt `Error fmt); } in T.check_cell_exn cell ~long ~rand ~call:(Raw.callback ~colors:false ~verbose ~print_res:true ~print)) let to_ounit2_test_list ?rand lst = List.rev (List.rev_map (to_ounit2_test ?rand) lst) (* to convert a test to a [OUnit.test], we register a callback that will possibly print errors and counter-examples *) let to_ounit_test_cell ?(verbose=verbose()) ?(long=long_tests()) ?(rand=random_state()) cell = let module T = QCheck2.Test in let name = T.get_name cell in let run () = try T.check_cell_exn cell ~long ~rand ~call:(Raw.callback ~colors:false ~verbose ~print_res:verbose ~print:Raw.print_std); true with T.Test_fail _ -> false in name >:: (fun () -> assert_bool name (run ())) let to_ounit_test ?verbose ?long ?rand (QCheck2.Test.Test c) = to_ounit_test_cell ?verbose ?long ?rand c let (>:::) name l = name >::: (List.map (fun t -> to_ounit_test t) l) (* Function which runs the given function and returns the running time of the function, and the original result in a tuple *) let time_fun f x y = let begin_time = Unix.gettimeofday () in let res = f x y in (* evaluate this first *) Unix.gettimeofday () -. begin_time, res let run ?(argv=Sys.argv) test = let cli_args = Raw.parse_cli ~full_options:true argv in let colors = cli_args.Raw.cli_colors in (* print in colors *) let pp_color = Color.pp_str_c ~bold:true ~colors in let _counter = ref (0,0,0) in (* Success, Failure, Other *) let total_tests = test_case_count test in (* list of (test, execution time) *) let exec_times = ref [] in let update = function | RSuccess _ -> let (s,f,o) = !_counter in _counter := (succ s,f,o) | RFailure _ -> let (s,f,o) = !_counter in _counter := (s,succ f,o) | _ -> let (s,f,o) = !_counter in _counter := (s,f, succ o) in (* time each test *) let start = ref 0. and stop = ref 0. in (* display test as it starts and ends *) let display_test ?(ended=false) p = let (s,f,o) = !_counter in let cartouche = va " [%d%s%s / %d] " s (if f=0 then "" else va "+%d" f) (if o=0 then "" else va " %d!" o) total_tests and path = string_of_path p in let end_marker = if cli_args.Raw.cli_print_list then ( (* print a single line *) if ended then va " (after %.2fs)\n" (!stop -. !start) else "\n" ) else ( ps Color.reset_line; if ended then " *" else "" ) in let line = cartouche ^ path ^ end_marker in let remaining = 79 - String.length line in let cover = if remaining > 0 && not cli_args.Raw.cli_print_list then String.make remaining ' ' else "" in pf "%s%s%!" line cover; in let hdl_event = function | EStart p -> start := Unix.gettimeofday(); display_test p | EEnd p -> stop := Unix.gettimeofday(); display_test p ~ended:true; let exec_time = !stop -. !start in exec_times := (p, exec_time) :: !exec_times | EResult result -> update result in ps "Running tests..."; let running_time, results = time_fun perform_test hdl_event test in let (_s, f, o) = !_counter in let failures = List.filter not_success results in (* assert (List.length failures = f);*) ps Color.reset_line; print_result_list ~colors failures; assert (List.length results = total_tests); pf "Ran: %d tests in: %.2f seconds.%s\n" total_tests running_time (String.make 40 ' '); (* XXX: suboptimal, but should work fine *) if cli_args.Raw.cli_slow_test > 0 then ( pf "Display the %d slowest tests:\n" cli_args.Raw.cli_slow_test; let l = !exec_times in let l = List.sort (fun (_,t1)(_,t2) -> compare t2 t1) l in List.iteri (fun i (p,t) -> if i 0 then ( pf "%a SOME TESTS ARE NEITHER SUCCESSES NOR FAILURES!\n" (pp_color `Yellow) "WARNING!"; ); if failures <> [] then ( pf "%a\n" (pp_color `Red) "FAILURE"; ); (* create a meaningful return code for the process running the tests *) match f, o with | 0, 0 -> 0 | _ -> 1 (* TAP-compatible test runner, in case we want to use a test harness *) let run_tap test = let test_number = ref 0 in let handle_event = function | EStart _ | EEnd _ -> incr test_number | EResult (RSuccess p) -> pf "ok %d - %s\n%!" !test_number (string_of_path p) | EResult (RFailure (p,m)) -> pf "not ok %d - %s # %s\n%!" !test_number (string_of_path p) m | EResult (RError (p,m)) -> pf "not ok %d - %s # ERROR:%s\n%!" !test_number (string_of_path p) m | EResult (RSkip (p,m)) -> pf "not ok %d - %s # skip %s\n%!" !test_number (string_of_path p) m | EResult (RTodo (p,m)) -> pf "not ok %d - %s # todo %s\n%!" !test_number (string_of_path p) m in let total_tests = test_case_count test in pf "TAP version 13\n1..%d\n" total_tests; perform_test handle_event test qcheck-0.18.1/src/ounit/QCheck_ounit.mli000066400000000000000000000060571417677125000200650ustar00rootroot00000000000000 (** {1 Conversion of tests to OUnit Tests} @since 0.9 *) val to_ounit_test : ?verbose:bool -> ?long:bool -> ?rand:Random.State.t -> QCheck2.Test.t -> OUnit.test (** [to_ounit_test ~rand t] wraps [t] into a OUnit test @param verbose used to print information on stdout (default: [verbose()]) @param rand the random generator to use (default: [random_state ()]) *) val to_ounit_test_cell : ?verbose:bool -> ?long:bool -> ?rand:Random.State.t -> _ QCheck2.Test.cell -> OUnit.test (** Same as {!to_ounit_test} but with a polymorphic test cell *) val (>:::) : string -> QCheck2.Test.t list -> OUnit.test (** Same as [OUnit.(>:::)] but with a list of QCheck2 tests *) val to_ounit2_test : ?rand:Random.State.t -> QCheck2.Test.t -> OUnit2.test (** [to_ounit2_test ?rand t] wraps [t] into a OUnit2 test @param rand the random generator to use (default: a static seed for reproducibility), can be overridden with "-seed" on the command-line *) val to_ounit2_test_list : ?rand:Random.State.t -> QCheck2.Test.t list -> OUnit2.test list (** [to_ounit2_test_list ?rand t] like [to_ounit2_test] but for a list of tests *) (** {2 OUnit runners} QCheck provides some custom runners for OUnit tests. - {!run} is used by {{: https://github.com/vincent-hugot/qtest} qtest}. - {!run_tap} should be compatible with {{: https://en.wikipedia.org/wiki/Test_Anything_Protocol} TAP}. Note that {!OUnit.run_test_tt} or {!OUnit.run_test_tt_main} can be used as well, in particular when QCheck tests are mixed with normal unit tests. For OUnit2 you can use {!OUnit2.run_test_tt_main}. *) val run : ?argv:string array -> OUnit.test -> int (** [run test] runs the test, and returns an error code that is [0] if all tests passed, [1] otherwise. This is the default runner used by the comment-to-test generator. @param argv the command line arguments to parse parameters from (default [Sys.argv]) @raise Arg.Bad in case [argv] contains unknown arguments @raise Arg.Help in case [argv] contains "--help" This test runner displays execution in a compact way, making it good for suites that have lots of tests. Output example: {v random seed: 101121210 random seed: 101121210 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Error: tests>error_raise_exn test `error_raise_exn` raised exception `QCheck_ounit_test.Error` on `0 (after 62 shrink steps)` Raised at file "example/QCheck_ounit_test.ml", line 19, characters 20-25 Called from file "src/QCheck.ml", line 846, characters 13-33 /////////////////////////////////////////////////////////////////////////////// \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Failure: tests>fail_sort_id fail_sort_id /////////////////////////////////////////////////////////////////////////////// Ran: 4 tests in: 0.74 seconds. WARNING! SOME TESTS ARE NEITHER SUCCESSES NOR FAILURES! v} *) val run_tap : OUnit.test -> OUnit.test_results (** TAP-compatible test runner, in case we want to use a test harness. It prints one line per test. *) qcheck-0.18.1/src/ounit/dune000066400000000000000000000003221417677125000156510ustar00rootroot00000000000000 (library (name qcheck_ounit) (public_name qcheck-ounit) (wrapped false) (libraries unix bytes qcheck-core qcheck-core.runner ounit2) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) ) qcheck-0.18.1/src/runner/000077500000000000000000000000001417677125000151515ustar00rootroot00000000000000qcheck-0.18.1/src/runner/QCheck_base_runner.ml000066400000000000000000000355351417677125000212370ustar00rootroot00000000000000(* QCheck: Random testing for OCaml copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard all rights reserved. *) module Color = struct let fpf = Printf.fprintf type color = [ `Red | `Yellow | `Green | `Blue | `Normal | `Cyan ] let int_of_color_ : color -> int = function | `Normal -> 0 | `Red -> 1 | `Green -> 2 | `Yellow -> 3 | `Blue -> 4 | `Cyan -> 6 (* same as [pp], but in color [c] *) let in_color c pp out x = let n = int_of_color_ c in fpf out "\x1b[3%dm" n; pp out x; fpf out "\x1b[0m" (* same as [pp], but in bold color [c] *) let in_bold_color c pp out x = let n = int_of_color_ c in fpf out "\x1b[3%d;1m" n; pp out x; fpf out "\x1b[0m" let reset_line = "\x1b[2K\r" let pp_str_c ?(bold=true) ~colors c out s = if colors then if bold then in_bold_color c output_string out s else in_color c output_string out s else output_string out s end let seed = ref ~-1 let st = ref None let set_seed_ ~colors s = seed := s; if colors then Printf.printf "%srandom seed: %d\n%!" Color.reset_line s else Printf.printf "random seed: %d\n%!" s; let state = Random.State.make [| s |] in st := Some state; state (* time of last printed message. Useful for rate limiting in verbose mode *) let last_msg = ref 0. let time_between_msg = ref 0.1 let get_time_between_msg () = !time_between_msg let set_time_between_msg f = time_between_msg := f let set_seed s = ignore (set_seed_ ~colors:false s) let setup_random_state_ ~colors () = let s = if !seed = ~-1 then ( Random.self_init (); (* make new, truly random seed *) Random.int (1 lsl 29); ) else !seed in set_seed_ ~colors s (* initialize random generator from seed (if any) *) let random_state_ ~colors () = match !st with | Some st -> st | None -> setup_random_state_ ~colors () let random_state() = random_state_ ~colors:false () let verbose, set_verbose = let r = ref false in (fun () -> !r), (fun b -> r := b) let long_tests, set_long_tests = let r = ref false in (fun () -> !r), (fun b -> r := b) let debug_shrink, set_debug_shrink = let r = ref None in (fun () -> !r), (fun s -> r := Some (open_out s)) let debug_shrink_list, set_debug_shrink_list = let r = ref [] in (fun () -> !r), (fun b -> r := b :: !r) module Raw = struct type ('b,'c) printer = { info: 'a. ('a,'b,'c,unit) format4 -> 'a; fail: 'a. ('a,'b,'c,unit) format4 -> 'a; err: 'a. ('a,'b,'c,unit) format4 -> 'a; } type cli_args = { cli_verbose : bool; cli_long_tests : bool; cli_print_list : bool; cli_rand : Random.State.t; cli_slow_test : int; (* how many slow tests to display? *) cli_colors: bool; cli_debug_shrink : out_channel option; cli_debug_shrink_list : string list; } (* main callback for individual tests @param verbose if true, print statistics and details @param print_res if true, print the result on [out] *) let callback ~colors ~verbose ~print_res ~print name cell result = let module R = QCheck2.TestResult in let module T = QCheck2.Test in let reset_line = if colors then Color.reset_line else "\n" in if verbose then ( print.info "%slaw %s: %d relevant cases (%d total)\n" reset_line name (R.get_count result) (R.get_count_gen result); begin match QCheck2.TestResult.collect result with | None -> () | Some tbl -> print_string (QCheck2.Test.print_collect tbl) end; ); if print_res then ( (* even if [not verbose], print errors *) match R.get_state result with | R.Success -> () | R.Failed {instances=l} -> print.fail "%s%s\n" reset_line (T.print_fail cell name l); | R.Failed_other {msg} -> print.fail "%s%s\n" reset_line (T.print_fail_other name ~msg); | R.Error {instance; exn; backtrace} -> print.err "%s%s\n" reset_line (T.print_error ~st:backtrace cell name (instance,exn)); ) let print_std = { info = Printf.printf; fail = Printf.printf; err = Printf.printf } let parse_cli ~full_options argv = let print_list = ref false in let set_verbose () = set_verbose true in let set_long_tests () = set_long_tests true in let set_backtraces () = Printexc.record_backtrace true in let set_list () = print_list := true in let colors = ref true in let slow = ref 0 in let options = Arg.align ( [ "-v", Arg.Unit set_verbose, " " ; "--verbose", Arg.Unit set_verbose, " enable verbose tests" ; "--colors", Arg.Set colors, " colored output" ; "--no-colors", Arg.Clear colors, " disable colored output" ] @ (if full_options then [ "-l", Arg.Unit set_list, " " ; "--list", Arg.Unit set_list, " print list of tests (2 lines each)" ; "--slow", Arg.Set_int slow, " print the slowest tests" ] else [] ) @ [ "-s", Arg.Set_int seed, " " ; "--seed", Arg.Set_int seed, " set random seed (to repeat tests)" ; "--long", Arg.Unit set_long_tests, " run long tests" ; "-bt", Arg.Unit set_backtraces, " enable backtraces" ; "--debug-shrink", Arg.String set_debug_shrink, " enable shrinking debug to " ; "--debug-shrink-list", Arg.String set_debug_shrink_list, " filter test to debug shrinking on" ] ) in Arg.parse_argv argv options (fun _ ->()) "run qtest suite"; let cli_rand = setup_random_state_ ~colors:!colors () in { cli_verbose=verbose(); cli_long_tests=long_tests(); cli_rand; cli_print_list= !print_list; cli_slow_test= !slow; cli_colors= !colors; cli_debug_shrink = debug_shrink(); cli_debug_shrink_list = debug_shrink_list(); } end open Raw (* Counter for a test's instances *) type counter = { start : float; expected : int; mutable gen : int; mutable passed : int; mutable failed : int; mutable errored : int; } type res = | Res : 'a QCheck2.Test.cell * 'a QCheck2.TestResult.t -> res type handler = { handler : 'a. 'a QCheck2.Test.handler; } type handler_gen = colors:bool -> debug_shrink:(out_channel option) -> debug_shrink_list:(string list) -> size:int -> out:out_channel -> verbose:bool -> counter -> handler let pp_counter ~size out c = let t = Unix.gettimeofday () -. c.start in Printf.fprintf out "%*d %*d %*d %*d / %*d %7.1fs" size c.gen size c.errored size c.failed size c.passed size c.expected t let debug_shrinking_counter_example cell out x = match QCheck2.Test.get_print_opt cell with | None -> Printf.fprintf out "" | Some print -> Printf.fprintf out "%s" (print x) let debug_shrinking_choices_aux ~colors out name i cell x = Printf.fprintf out "\n~~~ %a %s\n\n" (Color.pp_str_c ~colors `Cyan) "Shrink" (String.make 69 '~'); Printf.fprintf out "Test %s successfully shrunk counter example (step %d) to:\n\n%a\n%!" name i (debug_shrinking_counter_example cell) x let debug_shrinking_choices ~colors ~debug_shrink ~debug_shrink_list name cell i x = match debug_shrink with | None -> () | Some out -> begin match debug_shrink_list with | [] -> debug_shrinking_choices_aux ~colors out name i cell x | l when List.mem name l -> debug_shrinking_choices_aux ~colors out name i cell x | _ -> () end let default_handler ~colors ~debug_shrink ~debug_shrink_list ~size ~out ~verbose c = let handler name cell r = let st = function | QCheck2.Test.Generating -> "generating" | QCheck2.Test.Collecting _ -> "collecting" | QCheck2.Test.Testing _ -> " testing" | QCheck2.Test.Shrunk (i, _) -> Printf.sprintf "shrinking: %4d" i | QCheck2.Test.Shrinking (i, j, _) -> Printf.sprintf "shrinking: %4d.%04d" i j in (* debug shrinking choices *) begin match r with | QCheck2.Test.Shrunk (i, x) -> debug_shrinking_choices ~colors ~debug_shrink ~debug_shrink_list name cell i x | _ -> () end; (* use timestamps for rate-limiting *) let now=Unix.gettimeofday() in if verbose && now -. !last_msg > get_time_between_msg () then ( last_msg := now; Printf.fprintf out "%s[ ] %a %s (%s)%!" (if colors then Color.reset_line else "\n") (pp_counter ~size) c name (st r) ) in { handler; } let step ~colors ~size ~out ~verbose c name _ _ r = let aux = function | QCheck2.Test.Success -> c.passed <- c.passed + 1 | QCheck2.Test.Failure -> c.failed <- c.failed + 1 | QCheck2.Test.FalseAssumption -> () | QCheck2.Test.Error _ -> c.errored <- c.errored + 1 in c.gen <- c.gen + 1; aux r; let now=Unix.gettimeofday() in if verbose && now -. !last_msg > get_time_between_msg () then ( last_msg := now; Printf.fprintf out "%s[ ] %a %s%!" (if colors then Color.reset_line else "\n") (pp_counter ~size) c name ) let callback ~size ~out ~verbose ~colors c name _ r = let pass = QCheck2.TestResult.is_success r in let color = if pass then `Green else `Red in if verbose then ( Printf.fprintf out "%s[%a] %a %s\n%!" (if colors then Color.reset_line else "\n") (Color.pp_str_c ~bold:true ~colors color) (if pass then "✓" else "✗") (pp_counter ~size) c name ) let print_inst cell x = match QCheck2.Test.get_print_opt cell with | Some f -> f x | None -> "" let expect long cell = let count = QCheck2.Test.get_count cell in if long then QCheck2.Test.get_long_factor cell * count else count let expect_size long cell = let rec aux n = if n < 10 then 1 else 1 + (aux (n / 10)) in aux (expect long cell) (* print user messages for a test *) let print_messages ~colors out cell l = if l<>[] then ( Printf.fprintf out "\n+++ %a %s\n\nMessages for test %s:\n\n%!" (Color.pp_str_c ~colors `Blue) "Messages" (String.make 68 '+') (QCheck2.Test.get_name cell); List.iter (Printf.fprintf out "%s\n%!") l ) let print_success ~colors out cell r = begin match QCheck2.TestResult.collect r with | None -> () | Some tbl -> Printf.fprintf out "\n+++ %a %s\n\nCollect results for test %s:\n\n%s%!" (Color.pp_str_c ~colors `Blue) "Collect" (String.make 68 '+') (QCheck2.Test.get_name cell) (QCheck2.Test.print_collect tbl) end; List.iter (fun msg -> Printf.fprintf out "\n!!! %a %s\n\nWarning for test %s:\n\n%s%!" (Color.pp_str_c ~colors `Yellow) "Warning" (String.make 68 '!') (QCheck2.Test.get_name cell) msg) (QCheck2.TestResult.warnings r); if QCheck2.TestResult.stats r <> [] then Printf.fprintf out "\n+++ %a %s\n%!" (Color.pp_str_c ~colors `Blue) ("Stats for " ^ QCheck2.Test.get_name cell) (String.make 56 '+'); List.iter (fun st -> Printf.fprintf out "\n%s%!" (QCheck2.Test.print_stat st)) (QCheck2.TestResult.stats r); () let print_fail ~colors out cell c_ex = Printf.fprintf out "\n--- %a %s\n\n" (Color.pp_str_c ~colors `Red) "Failure" (String.make 68 '-'); Printf.fprintf out "Test %s failed (%d shrink steps):\n\n%s\n%!" (QCheck2.Test.get_name cell) c_ex.QCheck2.TestResult.shrink_steps (print_inst cell c_ex.QCheck2.TestResult.instance); print_messages ~colors out cell c_ex.QCheck2.TestResult.msg_l let print_fail_other ~colors out cell msg = Printf.fprintf out "\n--- %a %s\n\n" (Color.pp_str_c ~colors `Red) "Failure" (String.make 68 '-'); Printf.fprintf out "Test %s failed:\n\n%s\n%!" (QCheck2.Test.get_name cell) msg let print_error ~colors out cell c_ex exn bt = Printf.fprintf out "\n=== %a %s\n\n" (Color.pp_str_c ~colors `Red) "Error" (String.make 70 '='); Printf.fprintf out "Test %s errored on (%d shrink steps):\n\n%s\n\nexception %s\n%s\n%!" (QCheck2.Test.get_name cell) c_ex.QCheck2.TestResult.shrink_steps (print_inst cell c_ex.QCheck2.TestResult.instance) (Printexc.to_string exn) bt; print_messages ~colors out cell c_ex.QCheck2.TestResult.msg_l let run_tests ?(handler=default_handler) ?(colors=true) ?(verbose=verbose()) ?(long=long_tests()) ?(debug_shrink=debug_shrink()) ?(debug_shrink_list=debug_shrink_list()) ?(out=stdout) ?rand l = let rand = match rand with Some x -> x | None -> random_state_ ~colors () in let module T = QCheck2.Test in let module R = QCheck2.TestResult in let pp_color = Color.pp_str_c ~bold:true ~colors in let size = List.fold_left (fun acc (T.Test cell) -> max acc (expect_size long cell)) 4 l in if verbose then Printf.fprintf out "%*s %*s %*s %*s / %*s time test name\n%!" (size + 4) "generated" size "error" size "fail" size "pass" size "total"; let aux_map (T.Test cell) = let rand = Random.State.copy rand in let expected = expect long cell in let start = Unix.gettimeofday () in let c = { start; expected; gen = 0; passed = 0; failed = 0; errored = 0; } in if verbose then Printf.fprintf out "%s[ ] %a %s%!" (if colors then Color.reset_line else "") (pp_counter ~size) c (T.get_name cell); let r = QCheck2.Test.check_cell ~long ~rand ~handler:(handler ~colors ~debug_shrink ~debug_shrink_list ~size ~out ~verbose c).handler ~step:(step ~colors ~size ~out ~verbose c) ~call:(callback ~size ~out ~verbose ~colors c) cell in Res (cell, r) in let res = List.map aux_map l in let aux_fold (total, fail, error, warns) (Res (cell, r)) = let warns = warns + List.length (R.get_warnings r) in let acc = match R.get_state r with | R.Success -> print_success ~colors out cell r; (total + 1, fail, error, warns) | R.Failed {instances=l} -> List.iter (print_fail ~colors out cell) l; (total + 1, fail + 1, error, warns) | R.Failed_other {msg} -> print_fail_other ~colors out cell msg; (total + 1, fail + 1, error, warns) | R.Error {instance=c_ex; exn; backtrace=bt} -> print_error ~colors out cell c_ex exn bt; (total + 1, fail, error + 1, warns) in acc in let total, fail, error, warns = List.fold_left aux_fold (0, 0, 0,0) res in Printf.fprintf out "%s\n" (String.make 80 '='); if warns > 0 then Printf.fprintf out "%d warning(s)\n" warns; if fail = 0 && error = 0 then ( Printf.fprintf out "%a (ran %d tests)\n%!" (pp_color `Green) "success" total; 0 ) else ( Printf.fprintf out "%a (%d tests failed, %d tests errored, ran %d tests)\n%!" (pp_color `Red) "failure" fail error total; 1 ) let run_tests_main ?(argv=Sys.argv) l = try let cli_args = parse_cli ~full_options:false argv in exit (run_tests l ~colors:cli_args.cli_colors ~verbose:cli_args.cli_verbose ~long:cli_args.cli_long_tests ~out:stdout ~rand:cli_args.cli_rand) with | Arg.Bad msg -> print_endline msg; exit 1 | Arg.Help msg -> print_endline msg; exit 0 qcheck-0.18.1/src/runner/QCheck_base_runner.mli000066400000000000000000000147351417677125000214070ustar00rootroot00000000000000(* QCheck: Random testing for OCaml copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard all rights reserved. *) (** {1 Runners for Tests} Once you built some tests using {!QCheck2.Test.make}, you need to run the tests. This module contains several {b runners}, which are designed to run every test and report the result. By default, you can use {!run_tests} in a test program as follows: {[ let testsuite = [ Test.make ...; Test.make ...; ] let () = let errcode = QCheck_base_runner.run_tests ~verbose:true testsuite in exit errcode ]} which will run the tests, and exit the program. The error code will be 0 if all tests pass, 1 otherwise. {!run_tests_main} can be used as a shortcut for that, also featuring command-line parsing (using {!Arg}) to activate verbose mode and others. *) (** {2 State} *) val random_state : unit -> Random.State.t (** Access the current random state *) val verbose : unit -> bool (** Is the default mode verbose or quiet? *) val long_tests : unit -> bool (** Is the default mode to run long tests or nor? *) val set_seed : int -> unit (** Change the {!random_state} by creating a new one, initialized with the given seed. *) val set_verbose : bool -> unit (** Change the value of [verbose ()] *) val set_long_tests : bool -> unit (** Change the value of [long_tests ()] *) val get_time_between_msg : unit -> float (** Get the minimum time to wait between printing messages. @since 0.9 *) val set_time_between_msg : float -> unit (** Set the minimum tiem between messages. @since 0.9 *) (** {2 Event handlers} *) type counter = private { start : float; expected : int; mutable gen : int; mutable passed : int; mutable failed : int; mutable errored : int; } (** The type of counter used to keep tracks of the events received for a given test cell. *) type handler = { handler : 'a. 'a QCheck2.Test.handler; } (** A type to represent polymorphic-enough handlers for test cells. *) type handler_gen = colors:bool -> debug_shrink:(out_channel option) -> debug_shrink_list:(string list) -> size:int -> out:out_channel -> verbose:bool -> counter -> handler (** An alias type to a generator of handlers for test cells. *) val default_handler : handler_gen (** The default handler used. *) (** {2 Run a Suite of Tests and Get Results} *) val run_tests : ?handler:handler_gen -> ?colors:bool -> ?verbose:bool -> ?long:bool -> ?debug_shrink:(out_channel option) -> ?debug_shrink_list:(string list) -> ?out:out_channel -> ?rand:Random.State.t -> QCheck2.Test.t list -> int (** Run a suite of tests, and print its results. This is an heritage from the "qcheck" library. @return an error code, [0] if all tests passed, [1] otherwise. @param colors if true (default), colorful output @param verbose if true, prints more information about test cases (default: [false]) @param long if true, runs the long versions of the tests (default: [false]) @param debug_shrink [debug_shrink:(Some ch)] writes a log of successful shrink attempts to channel [ch], for example [~debug_shrink:(Some (open_out "mylog.txt"))]. Use together with a non-empty list in [~debug_shrink_list]. @param debug_shrink_list the test names to log successful shrink attempts for, for example [~debug_shrink_list:["list_rev_is_involutive"]]. Requires [~debug_shrink] to be [Some ch]. @param out print output to the provided channel (default: [stdout]) @param rand start the test runner in the provided RNG state *) val run_tests_main : ?argv:string array -> QCheck2.Test.t list -> 'a (** Can be used as the main function of a test file. Exits with a non-0 code if the tests fail. It refers to {!run_tests} for actually running tests after CLI options have been parsed. The available options are: - "--verbose" (or "-v") for activating verbose tests - "--seed " (or "-s ") for repeating a previous run by setting the random seed - "--long" for running the long versions of the tests Below is an example of the output of the [run_tests] and [run_tests_main] function: {v random seed: 438308050 generated error; fail; pass / total - time -- test name [✓] (1000) 0 ; 0 ; 1000 / 1000 -- 0.5s -- list_rev_is_involutive [✗] ( 1) 0 ; 1 ; 0 / 10 -- 0.0s -- should_fail_sort_id [✗] ( 1) 1 ; 0 ; 0 / 10 -- 0.0s -- should_error_raise_exn [✓] (1000) 0 ; 0 ; 1000 / 1000 -- 0.0s -- collect_results --- Failure -------------------------------------------------------------------- Test should_fail_sort_id failed (11 shrink steps): [1; 0] === Error ====================================================================== Test should_error_raise_exn errored on (62 shrink steps): 0 exception QCheck_runner_test.Error Raised at file "example/QCheck_runner_test.ml", line 20, characters 20-25 Called from file "src/QCheck.ml", line 839, characters 13-33 +++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Collect results for test collect_results: 4: 207 cases 3: 190 cases 2: 219 cases 1: 196 cases 0: 188 cases ================================================================================ failure (1 tests failed, 1 tests errored, ran 4 tests) v} *) (** {2 Utils for colored output} *) module Color : sig type color = [ `Red | `Yellow | `Green | `Blue | `Normal | `Cyan ] val reset_line : string val pp_str_c : ?bold:bool -> colors:bool -> color -> out_channel -> string -> unit end (** {2 Internal Utils} We provide {b NO} stability guarantee for this module. Use at your own risks. *) module Raw : sig type ('b,'c) printer = { info: 'a. ('a,'b,'c,unit) format4 -> 'a; fail: 'a. ('a,'b,'c,unit) format4 -> 'a; err: 'a. ('a,'b,'c,unit) format4 -> 'a; } val print_std : (out_channel, unit) printer (* main callback for display *) val callback : colors:bool -> verbose:bool -> print_res:bool -> print:('a, 'b) printer -> string -> 'c QCheck2.Test.cell -> 'c QCheck2.TestResult.t -> unit type cli_args = { cli_verbose : bool; cli_long_tests : bool; cli_print_list : bool; cli_rand : Random.State.t; cli_slow_test : int; (* how many slow tests to display? *) cli_colors: bool; cli_debug_shrink : out_channel option; cli_debug_shrink_list : string list; } val parse_cli : full_options:bool -> string array -> cli_args end qcheck-0.18.1/src/runner/dune000066400000000000000000000002461417677125000160310ustar00rootroot00000000000000 (library (name qcheck_runner) (public_name qcheck-core.runner) (wrapped false) (libraries qcheck-core) (flags :standard -warn-error -a+8 -safe-string) ) qcheck-0.18.1/test/000077500000000000000000000000001417677125000140305ustar00rootroot00000000000000qcheck-0.18.1/test/core/000077500000000000000000000000001417677125000147605ustar00rootroot00000000000000qcheck-0.18.1/test/core/QCheck2_expect_test.ml000066400000000000000000000424461417677125000211530ustar00rootroot00000000000000(** QCheck2 tests **) (** Module representing a integer tree data structure, used in tests *) module IntTree = struct type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let rec depth = function | Leaf _ -> 1 | Node (x, y) -> 1 + max (depth x) (depth y) let rec print_tree = function | Leaf x -> Printf.sprintf "Leaf %d" x | Node (x, y) -> Printf.sprintf "Node (%s, %s)" (print_tree x) (print_tree y) let gen_tree = QCheck2.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] )) let rec rev_tree = function | Node (x, y) -> Node (rev_tree y, rev_tree x) | Leaf x -> Leaf x let rec contains_only_n tree n = match tree with | Leaf n' -> n = n' | Node (x, y) -> contains_only_n x n && contains_only_n y n end (* tests of overall functionality *) module Overall = struct open QCheck2 let passing = Test.make ~name:"list_rev_is_involutive" ~count:100 ~long_factor:100 ~print:Print.(list int) Gen.(list small_int) (fun l -> List.rev (List.rev l) = l) let failing = Test.make ~name:"should_fail_sort_id" ~count:10 ~print:Print.(list int) Gen.(small_list small_int) (fun l -> l = List.sort compare l) exception Error let error = Test.make ~name:"should_error_raise_exn" ~count:10 ~print:Print.int Gen.int (fun _ -> raise Error) let collect = Test.make ~name:"collect_results" ~count:100 ~long_factor:100 ~print:Print.int ~collect:string_of_int (Gen.int_bound 4) (fun _ -> true) let stats = Test.make ~name:"with_stats" ~count:100 ~long_factor:100 ~print:Print.int ~stats:[ "mod4", (fun i->i mod 4); "num", (fun i->i); ] (Gen.int_bound 120) (fun _ -> true) let bad_assume_warn = Test.make ~name:"WARN_unlikely_precond" ~count:2_000 ~print:Print.int Gen.int (fun x -> QCheck.assume (x mod 100 = 1); true) let bad_assume_fail = Test.make ~name:"FAIL_unlikely_precond" ~count:2_000 ~if_assumptions_fail:(`Fatal, 0.1) ~print:Print.int Gen.int (fun x -> QCheck.assume (x mod 100 = 1); true) end (* positive tests of the various generators *) module Generator = struct open QCheck2 (* example from issue #23 *) let char_dist_issue_23 = Test.make ~name:"char never produces '\\255'" ~count:1_000_000 ~print:Print.char Gen.char (fun c -> c <> '\255') let char_test = Test.make ~name:"char has right range'" ~count:1000 ~print:Print.char Gen.char (fun c -> '\000' <= c && c <= '\255') let nat_test = Test.make ~name:"nat has right range" ~count:1000 ~print:Print.int Gen.nat (fun n -> 0 <= n && n < 10000) let string_test = Test.make ~name:"string has right length and content" ~count:1000 ~print:Print.string Gen.string (fun s -> let len = String.length s in 0 <= len && len < 10000 && String.to_seq s |> Seq.fold_left (fun acc c -> acc && '\000' <= c && c <= '\255') true) let list_test = Test.make ~name:"list has right length" ~count:1000 ~print:Print.(list unit) Gen.(list unit) (fun l -> let len = List.length l in 0 <= len && len < 10_000) let list_repeat_test = Test.make ~name:"list_repeat has constant length" ~count:1000 ~print:Print.(pair int (list unit)) Gen.(small_nat >>= fun i -> list_repeat i unit >>= fun l -> return (i,l)) (fun (i,l) -> List.length l = i) let array_repeat_test = Test.make ~name:"array_repeat has constant length" ~count:1000 ~print:Print.(pair int (array unit)) Gen.(small_nat >>= fun i -> array_repeat i unit >>= fun l -> return (i,l)) (fun (i,l) -> Array.length l = i) let passing_tree_rev = Test.make ~count:1000 ~name:"tree_rev_is_involutive" IntTree.gen_tree (fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree) end (* negative tests that exercise shrinking behaviour *) module Shrink = struct open QCheck2 let rec fac n = match n with | 0 -> 1 | n -> n * fac (n - 1) (* example from issue #59 *) let test_fac_issue59 = Test.make ~name:"test fac issue59" (Gen.make_primitive ~gen:(fun st -> Gen.generate1 ~rand:st (Gen.small_int_corners ())) ~shrink:(fun _ -> Seq.empty)) (fun n -> try (fac n) mod n = 0 with (*| Stack_overflow -> false*) | Division_by_zero -> (n=0)) let big_bound_issue59 = Test.make ~name:"big bound issue59" ~print:Print.int (Gen.small_int_corners()) (fun i -> i < 209609) let long_shrink = let listgen = Gen.(list_size (int_range 1000 10000) int) in Test.make ~name:"long_shrink" ~print:Print.(pair (list int) (list int)) (Gen.pair listgen listgen) (fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys)) let ints_arent_0_mod_3 = Test.make ~name:"ints arent 0 mod 3" ~count:1000 ~print:Print.int Gen.int (fun i -> i mod 3 <> 0) let ints_are_0 = Test.make ~name:"ints are 0" ~count:1000 ~print:Print.int Gen.int (fun i -> Printf.printf "%i\n" i; i = 0) (* test from issue #59 *) let ints_smaller_209609 = Test.make ~name:"ints < 209609" ~print:Print.int (Gen.small_int_corners()) (fun i -> i < 209609) let nats_smaller_5001 = Test.make ~name:"nat < 5001" ~count:1000 ~print:Print.int Gen.nat (fun n -> n < 5001) let char_is_never_abcdef = Test.make ~name:"char is never produces 'abcdef'" ~count:1000 ~print:Print.char Gen.char (fun c -> not (List.mem c ['a';'b';'c';'d';'e';'f'])) let strings_are_empty = Test.make ~name:"strings are empty" ~count:1000 ~print:Print.string Gen.string (fun s -> s = "") let string_never_has_000_char = Test.make ~name:"string never has a \\000 char" ~count:1000 ~print:Print.string Gen.string (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\000') true) let string_never_has_255_char = Test.make ~name:"string never has a \\255 char" ~count:1000 ~print:Print.string Gen.string (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\255') true) (* tests from issue #64 *) let print_list xs = print_endline Print.(list int xs) let lists_are_empty_issue_64 = Test.make ~name:"lists are empty" ~print:Print.(list int) Gen.(list small_int) (fun xs -> print_list xs; xs = []) let list_shorter_10 = Test.make ~name:"lists shorter than 10" ~print:Print.(list int) Gen.(list small_int) (fun xs -> List.length xs < 10) let length_printer xs = Printf.sprintf "[...] list length: %i" (List.length xs) let size_gen = Gen.(oneof [small_nat; int_bound 750_000]) let list_shorter_432 = Test.make ~name:"lists shorter than 432" ~print:length_printer Gen.(list_size size_gen small_int) (fun xs -> List.length xs < 432) let list_shorter_4332 = Test.make ~name:"lists shorter than 4332" ~print:length_printer Gen.(list_size size_gen small_int) (fun xs -> List.length xs < 4332) let list_equal_dupl = Test.make ~name:"lists equal to duplication" ~print:Print.(list int) Gen.(list_size size_gen small_int) (fun xs -> try xs = xs @ xs with Stack_overflow -> false) let list_unique_elems = Test.make ~name:"lists have unique elems" ~print:Print.(list int) Gen.(list small_int) (fun xs -> let ys = List.sort_uniq Int.compare xs in print_list xs; List.length xs = List.length ys) let tree_contains_only_42 = Test.make ~name:"tree contains only 42" ~print:IntTree.print_tree IntTree.gen_tree (fun tree -> IntTree.contains_only_n tree 42) end (* tests function generator and shrinker *) module Function = struct open QCheck2 let fail_pred_map_commute = Test.make ~name:"fail_pred_map_commute" ~count:100 ~long_factor:100 ~print:Print.(triple (list int) Fn.print Fn.print) Gen.(triple (small_list small_int) (fun1 ~print:Print.int Observable.int int) (fun1 ~print:Print.bool Observable.int bool)) (fun (l,Fun (_,f),Fun (_,p)) -> List.filter p (List.map f l) = List.map f (List.filter p l)) let fail_pred_strings = Test.make ~name:"fail_pred_strings" ~count:100 ~print:Fn.print (fun1 Observable.string ~print:Print.bool Gen.bool) (fun (Fun (_,p)) -> not (p "some random string") || p "some other string") let int_gen = Gen.small_nat (* int *) (* Another example (false) property *) let prop_foldleft_foldright = Test.make ~name:"fold_left fold_right" ~count:1000 ~long_factor:20 ~print:Print.(triple int (list int) Fn.print) Gen.(triple int_gen (list int_gen) (fun2 ~print:Print.int Observable.int Observable.int int_gen)) (fun (z,xs,f) -> let l1 = List.fold_right (Fn.apply f) xs z in let l2 = List.fold_left (Fn.apply f) z xs in if l1=l2 then true else Test.fail_reportf "l=%s, fold_left=%s, fold_right=%s@." (Print.(list int) xs) (Print.int l1) (Print.int l2) ) (* Another example (false) property *) let prop_foldleft_foldright_uncurry = Test.make ~name:"fold_left fold_right uncurried" ~count:1000 ~long_factor:20 ~print:Print.(triple Fn.print int (list int)) Gen.(triple (fun1 ~print:Print.int Observable.(pair int int) int_gen) int_gen (list int_gen)) (fun (f,z,xs) -> List.fold_right (fun x y -> Fn.apply f (x,y)) xs z = List.fold_left (fun x y -> Fn.apply f (x,y)) z xs) (* Same as the above (false) property, but generating+shrinking functions last *) let prop_foldleft_foldright_uncurry_funlast = Test.make ~name:"fold_left fold_right uncurried fun last" ~count:1000 ~long_factor:20 ~print:Print.(triple int (list int) Fn.print) Gen.(triple int_gen (list int_gen) (fun1 ~print:Print.int Observable.(pair int int) int_gen)) (fun (z,xs,f) -> List.fold_right (fun x y -> Fn.apply f (x,y)) xs z = List.fold_left (fun x y -> Fn.apply f (x,y)) z xs) (* test from issue #64 *) let fold_left_test = Test.make ~name:"fold_left test, fun first" ~print:Print.(quad Fn.print string (list int) (list int)) Gen.(quad (* string -> int -> string *) (fun2 ~print:Print.string Observable.string Observable.int (small_string ~gen:char)) (small_string ~gen:char) (list small_int) (list small_int)) (fun (f,acc,is,js) -> let f = Fn.apply f in List.fold_left f acc (is @ js) = List.fold_left f (List.fold_left f acc is) is) (*Typo*) end (* tests of (inner) find_example(_gen) behaviour *) module FindExample = struct open QCheck2 let find_ex = Test.make ~name:"find_example" ~print:Print.int Gen.(2--50) (fun n -> let st = Random.State.make [| 0 |] in let f m = n < m && m < 2 * n in try let m = find_example_gen ~rand:st ~count:100_000 ~f Gen.(0 -- 1000) in f m with No_example_found _ -> false) let find_ex_uncaught_issue_99_1_fail = let rs = (find_example ~count:10 ~f:(fun _ -> false) Gen.int) in Test.make ~name:"FAIL_#99_1" rs (fun _ -> true) let find_ex_uncaught_issue_99_2_succeed = Test.make ~name:"should_succeed_#99_2" ~count:10 Gen.int (fun i -> i <= max_int) end (* tests of statistics and histogram display *) module Stats = struct open QCheck2 let bool_dist = Test.make ~name:"bool dist" ~count:500_000 ~collect:Bool.to_string Gen.bool (fun _ -> true) let char_dist = Test.make ~name:"char code dist" ~count:500_000 ~stats:[("char code", Char.code)] Gen.char (fun _ -> true) let string_len_tests = let len = ("len",String.length) in [ Test.make ~name:"string_size len dist" ~count:5_000 ~stats:[len] Gen.(string_size (int_range 5 10)) (fun _ -> true); Test.make ~name:"string len dist" ~count:5_000 ~stats:[len] Gen.string (fun _ -> true); Test.make ~name:"string_of len dist" ~count:5_000 ~stats:[len] Gen.(string_of (return 'a')) (fun _ -> true); Test.make ~name:"string_printable len dist" ~count:5_000 ~stats:[len] Gen.string_printable (fun _ -> true); Test.make ~name:"small_string len dist" ~count:5_000 ~stats:[len] Gen.(small_string ~gen:char)(*ugh*)(fun _ -> true); ] let list_len_tests = let len = ("len",List.length) in [ (* test from issue #30 *) Test.make ~name:"list len dist" ~count:5_000 ~stats:[len] Gen.(list int) (fun _ -> true); Test.make ~name:"small_list len dist" ~count:5_000 ~stats:[len] Gen.(small_list int) (fun _ -> true); Test.make ~name:"list_size len dist" ~count:5_000 ~stats:[len] Gen.(list_size (int_range 5 10) int) (fun _ -> true); Test.make ~name:"list_repeat len dist" ~count:5_000 ~stats:[len] Gen.(list_repeat 42 int) (fun _ -> true); ] let array_len_tests = let len = ("len",Array.length) in [ Test.make ~name:"array len dist" ~count:5_000 ~stats:[len] Gen.(array int) (fun _ -> true); Test.make ~name:"small_array len dist" ~count:5_000 ~stats:[len] Gen.(small_array int) (fun _ -> true); Test.make ~name:"array_size len dist" ~count:5_000 ~stats:[len] Gen.(array_size (int_range 5 10) int) (fun _ -> true); Test.make ~name:"array_repeat len dist" ~count:5_000 ~stats:[len] Gen.(array_repeat 42 int) (fun _ -> true); ] let int_dist_tests = let dist = ("dist",fun x -> x) in [ (* test from issue #40 *) Test.make ~name:"int_stats_neg" ~count:5000 ~stats:[dist] Gen.small_signed_int (fun _ -> true); (* distribution tests from PR #45 *) Test.make ~name:"small_signed_int dist" ~count:1000 ~stats:[dist] Gen.small_signed_int (fun _ -> true); Test.make ~name:"small_nat dist" ~count:1000 ~stats:[dist] Gen.small_nat (fun _ -> true); Test.make ~name:"nat dist" ~count:1000 ~stats:[dist] Gen.nat (fun _ -> true); Test.make ~name:"int_range (-43643) 435434 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-43643) 435434) (fun _ -> true); Test.make ~name:"int_range (-40000) 40000 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-40000) 40000) (fun _ -> true); Test.make ~name:"int_range (-4) 4 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-4) 4) (fun _ -> true); Test.make ~name:"int_range (-4) 17 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-4) 17) (fun _ -> true); Test.make ~name:"int dist" ~count:100000 ~stats:[dist] Gen.int (fun _ -> true); Test.make ~name:"oneof int dist" ~count:1000 ~stats:[dist] (Gen.oneofl[min_int;-1;0;1;max_int]) (fun _ -> true); ] let int_dist_empty_bucket = Test.make ~name:"int_dist_empty_bucket" ~count:1_000 ~stats:[("dist",fun x -> x)] Gen.(oneof [small_int_corners ();int]) (fun _ -> true) let tree_depth_test = let depth = ("depth", IntTree.depth) in Test.make ~name:"tree's depth" ~count:1000 ~stats:[depth] IntTree.gen_tree (fun _ -> true) end (* Calling runners *) let () = QCheck_base_runner.set_seed 1234 let _ = QCheck_base_runner.run_tests ~colors:false ([ Overall.passing; Overall.failing; Overall.error; Overall.collect; Overall.stats; Overall.bad_assume_warn; Overall.bad_assume_fail; Generator.char_dist_issue_23; Generator.char_test; Generator.nat_test; Generator.string_test; Generator.list_test; Generator.list_repeat_test; Generator.array_repeat_test; Generator.passing_tree_rev; (*Shrink.test_fac_issue59;*) Shrink.big_bound_issue59; Shrink.long_shrink; Shrink.ints_arent_0_mod_3; Shrink.ints_are_0; Shrink.ints_smaller_209609; Shrink.nats_smaller_5001; Shrink.char_is_never_abcdef; Shrink.strings_are_empty; Shrink.string_never_has_000_char; Shrink.string_never_has_255_char; Shrink.lists_are_empty_issue_64; Shrink.list_shorter_10; Shrink.list_shorter_432; Shrink.list_shorter_4332; Shrink.list_equal_dupl; Shrink.list_unique_elems; Shrink.tree_contains_only_42; Function.fail_pred_map_commute; Function.fail_pred_strings; Function.prop_foldleft_foldright; Function.prop_foldleft_foldright_uncurry; Function.prop_foldleft_foldright_uncurry_funlast; Function.fold_left_test; FindExample.find_ex; FindExample.find_ex_uncaught_issue_99_1_fail; FindExample.find_ex_uncaught_issue_99_2_succeed; Stats.bool_dist; Stats.char_dist; Stats.tree_depth_test ] @ Stats.string_len_tests @ Stats.list_len_tests @ Stats.array_len_tests @ Stats.int_dist_tests) let () = QCheck_base_runner.set_seed 153870556 let _ = QCheck_base_runner.run_tests ~colors:false [Stats.int_dist_empty_bucket] qcheck-0.18.1/test/core/QCheck_expect_test.ml000066400000000000000000000467401417677125000210720ustar00rootroot00000000000000(** QCheck(1) tests **) (** Module representing a tree data structure, used in tests *) module IntTree = struct type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x let node x y = Node (x,y) let rec depth = function | Leaf _ -> 1 | Node (x, y) -> 1 + max (depth x) (depth y) let rec print_tree = function | Leaf x -> Printf.sprintf "Leaf %d" x | Node (x, y) -> Printf.sprintf "Node (%s, %s)" (print_tree x) (print_tree y) let gen_tree = QCheck.Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> frequency [1, map leaf nat; 2, map2 node (self (n/2)) (self (n/2))] )) let rec rev_tree = function | Node (x, y) -> Node (rev_tree y, rev_tree x) | Leaf x -> Leaf x let passing_tree_rev = QCheck.Test.make ~count:1000 ~name:"tree_rev_is_involutive" QCheck.(make gen_tree) (fun tree -> rev_tree (rev_tree tree) = tree) end (* tests of overall functionality *) module Overall = struct open QCheck let passing = Test.make ~name:"list_rev_is_involutive" ~count:100 ~long_factor:100 (list small_int) (fun l -> List.rev (List.rev l) = l) let failing = Test.make ~name:"should_fail_sort_id" ~count:10 (small_list small_int) (fun l -> l = List.sort compare l) exception Error let error = Test.make ~name:"should_error_raise_exn" ~count:10 int (fun _ -> raise Error) let collect = Test.make ~name:"collect_results" ~count:100 ~long_factor:100 (make ~collect:string_of_int (Gen.int_bound 4)) (fun _ -> true) let stats = Test.make ~name:"with_stats" ~count:100 ~long_factor:100 (make (Gen.int_bound 120) ~stats:[ "mod4", (fun i->i mod 4); "num", (fun i->i); ]) (fun _ -> true) let bad_assume_warn = Test.make ~name:"WARN_unlikely_precond" ~count:2_000 int (fun x -> QCheck.assume (x mod 100 = 1); true) let bad_assume_fail = Test.make ~name:"FAIL_unlikely_precond" ~count:2_000 ~if_assumptions_fail:(`Fatal, 0.1) int (fun x -> QCheck.assume (x mod 100 = 1); true) end (* positive tests of the various generators Note: it is important to disable shrinking for these tests, as the shrinkers will suggest inputs that are coming from the generator themselves -- which we want to test -- so their reduced counter-example are confusing rather than helpful. This is achieved by using (Test.make ~print ...), without a ~shrink argument. *) module Generator = struct open QCheck (* example from issue #23 *) let char_dist_issue_23 = Test.make ~name:"char never produces '\\255'" ~count:1_000_000 char (fun c -> c <> '\255') let char_test = Test.make ~name:"char has right range'" ~count:1000 char (fun c -> '\000' <= c && c <= '\255') let nat_test = Test.make ~name:"nat has right range" ~count:1000 (make ~print:Print.int Gen.nat) (fun n -> 0 <= n && n < 10000) let string_test = Test.make ~name:"string has right length and content" ~count:1000 string (fun s -> let len = String.length s in 0 <= len && len < 10000 && String.to_seq s |> Seq.fold_left (fun acc c -> acc && '\000' <= c && c <= '\255') true) let list_test = Test.make ~name:"list has right length" ~count:1000 (list unit) (fun l -> let len = List.length l in 0 <= len && len < 10_000) let list_repeat_test = let gen = Gen.(small_nat >>= fun i -> list_repeat i unit >>= fun l -> return (i,l)) in Test.make ~name:"list_repeat has constant length" ~count:1000 (make ~print:Print.(pair int (list unit)) gen) (fun (i,l) -> List.length l = i) let array_repeat_test = let gen = Gen.(small_nat >>= fun i -> array_repeat i unit >>= fun l -> return (i,l)) in Test.make ~name:"array_repeat has constant length" ~count:1000 (make ~print:Print.(pair int (array unit)) gen) (fun (i,l) -> Array.length l = i) let passing_tree_rev = QCheck.Test.make ~count:1000 ~name:"tree_rev_is_involutive" QCheck.(make IntTree.gen_tree) (fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree) let nat_split2_spec = Test.make ~name:"nat_split2 spec" (make ~print:Print.(pair int (pair int int)) Gen.(small_nat >>= fun n -> pair (return n) (nat_split2 n))) (fun (n, (a, b)) -> 0 <= a && 0 <= b && a + b = n) let pos_split2_spec = Test.make ~name:"pos_split2 spec" (make ~print:Print.(pair int (pair int int)) Gen.(small_nat >>= fun n -> (* we need n > 2 *) let n = n + 2 in pair (return n) (pos_split2 n))) (fun (n, (a, b)) -> (0 < a && 0 < b && a + b = n)) let range_subset_spec = Test.make ~name:"range_subset_spec" (make ~print:Print.(quad int int int (array int)) Gen.(pair small_nat small_nat >>= fun (m, n) -> (* we must guarantee [low <= high] and [size <= high - low + 1] *) let low = m and high = m + n in int_range 0 (high - low + 1) >>= fun size -> quad (return size) (return low) (return high) (range_subset ~size low high))) (fun (size, low, high, arr) -> if size = 0 then arr = [||] else Array.length arr = size && low <= arr.(0) && Array.for_all (fun (a, b) -> a < b) (Array.init (size - 1) (fun k -> arr.(k), arr.(k+1))) && arr.(size - 1) <= high) let nat_split_n_way = Test.make ~name:"nat_split n-way" (make ~print:Print.(pair int (array int)) Gen.(small_nat >>= fun n -> pair (return n) (nat_split ~size:n n))) (fun (n, arr) -> Array.length arr = n && Array.for_all (fun k -> 0 <= k) arr && Array.fold_left (+) 0 arr = n) let nat_split_smaller = Test.make ~name:"nat_split smaller" (make ~print:Print.(triple int int (array int)) Gen.(small_nat >>= fun size -> int_bound size >>= fun n -> triple (return size) (return n) (nat_split ~size n))) (fun (m, n, arr) -> Array.length arr = m && Array.for_all (fun k -> 0 <= k) arr && Array.fold_left (+) 0 arr = n) let pos_split = Test.make ~name:"pos_split" (make ~print:Print.(triple int int (array int)) Gen.(pair small_nat small_nat >>= fun (m, n) -> (* we need both size>0 and n>0 and size <= n *) let size = 1 + min m n and n = 1 + max m n in triple (return size) (return n) (pos_split ~size n))) (fun (m, n, arr) -> Array.length arr = m && Array.for_all (fun k -> 0 < k) arr && Array.fold_left (+) 0 arr = n) end (* negative tests that exercise shrinking behaviour *) module Shrink = struct open QCheck let rec fac n = match n with | 0 -> 1 | n -> n * fac (n - 1) (* example from issue #59 *) let test_fac_issue59 = Test.make ~name:"test fac issue59" (set_shrink Shrink.nil (small_int_corners ())) (fun n -> try (fac n) mod n = 0 with (*| Stack_overflow -> false*) | Division_by_zero -> (n=0)) let big_bound_issue59 = Test.make ~name:"big bound issue59" (small_int_corners()) (fun i -> i < 209609) let long_shrink = let listgen = list_of_size (Gen.int_range 1000 10000) int in Test.make ~name:"long_shrink" (pair listgen listgen) (fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys)) let ints_arent_0_mod_3 = Test.make ~name:"ints arent 0 mod 3" ~count:1000 int (fun i -> i mod 3 <> 0) let ints_are_0 = Test.make ~name:"ints are 0" ~count:1000 int (fun i -> Printf.printf "%i\n" i; i = 0) (* test from issue #59 *) let ints_smaller_209609 = Test.make ~name:"ints < 209609" (small_int_corners()) (fun i -> i < 209609) let nats_smaller_5001 = Test.make ~name:"nat < 5001" ~count:1000 (make ~print:Print.int ~shrink:Shrink.int Gen.nat) (fun n -> n < 5001) let char_is_never_abcdef = Test.make ~name:"char is never produces 'abcdef'" ~count:1000 char (fun c -> not (List.mem c ['a';'b';'c';'d';'e';'f'])) let strings_are_empty = Test.make ~name:"strings are empty" ~count:1000 string (fun s -> s = "") let string_never_has_000_char = Test.make ~name:"string never has a \\000 char" ~count:1000 string (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\000') true) let string_never_has_255_char = Test.make ~name:"string never has a \\255 char" ~count:1000 string (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\255') true) let print_list xs = print_endline Print.(list int xs) (* test from issue #64 *) let lists_are_empty_issue_64 = Test.make ~name:"lists are empty" (list small_int) (fun xs -> print_list xs; xs = []) let list_shorter_10 = Test.make ~name:"lists shorter than 10" (list small_int) (fun xs -> List.length xs < 10) let length_printer xs = Printf.sprintf "[...] list length: %i" (List.length xs) let size_gen = Gen.(oneof [small_nat; int_bound 750_000]) let list_shorter_432 = Test.make ~name:"lists shorter than 432" (set_print length_printer (list_of_size size_gen small_int)) (fun xs -> List.length xs < 432) let list_shorter_4332 = Test.make ~name:"lists shorter than 4332" (set_shrink Shrink.list_spine (set_print length_printer (list_of_size size_gen small_int))) (fun xs -> List.length xs < 4332) let list_equal_dupl = Test.make ~name:"lists equal to duplication" (list_of_size size_gen small_int) (fun xs -> try xs = xs @ xs with Stack_overflow -> false) let list_unique_elems = Test.make ~name:"lists have unique elems" (list small_int) (fun xs -> let ys = List.sort_uniq Int.compare xs in print_list xs; List.length xs = List.length ys) end (* tests function generator and shrinker *) module Function = struct open QCheck let fail_pred_map_commute = Test.make ~name:"fail_pred_map_commute" ~count:100 ~long_factor:100 (triple (small_list small_int) (fun1 Observable.int int) (fun1 Observable.int bool)) (fun (l,Fun (_,f),Fun (_,p)) -> List.filter p (List.map f l) = List.map f (List.filter p l)) let fail_pred_strings = Test.make ~name:"fail_pred_strings" ~count:100 (fun1 Observable.string bool) (fun (Fun (_,p)) -> not (p "some random string") || p "some other string") let int_gen = small_nat (* int *) (* Another example (false) property *) let prop_foldleft_foldright = Test.make ~name:"fold_left fold_right" ~count:1000 ~long_factor:20 (triple int_gen (list int_gen) (fun2 Observable.int Observable.int int_gen)) (fun (z,xs,f) -> let l1 = List.fold_right (Fn.apply f) xs z in let l2 = List.fold_left (Fn.apply f) z xs in if l1=l2 then true else Test.fail_reportf "l=%s, fold_left=%s, fold_right=%s@." (Print.(list int) xs) (Print.int l1) (Print.int l2) ) (* Another example (false) property *) let prop_foldleft_foldright_uncurry = Test.make ~name:"fold_left fold_right uncurried" ~count:1000 ~long_factor:20 (triple (fun1 Observable.(pair int int) int_gen) int_gen (list int_gen)) (fun (f,z,xs) -> List.fold_right (fun x y -> Fn.apply f (x,y)) xs z = List.fold_left (fun x y -> Fn.apply f (x,y)) z xs) (* Same as the above (false) property, but generating+shrinking functions last *) let prop_foldleft_foldright_uncurry_funlast = Test.make ~name:"fold_left fold_right uncurried fun last" ~count:1000 ~long_factor:20 (triple int_gen (list int_gen) (fun1 Observable.(pair int int) int_gen)) (fun (z,xs,f) -> List.fold_right (fun x y -> Fn.apply f (x,y)) xs z = List.fold_left (fun x y -> Fn.apply f (x,y)) z xs) (* test from issue #64 *) let fold_left_test = Test.make ~name:"false fold, fun first" (quad (* string -> int -> string *) (fun2 Observable.string Observable.int small_string) small_string (list small_int) (list small_int)) (fun (f,acc,is,js) -> let f = Fn.apply f in List.fold_left f acc (is @ js) = List.fold_left f (List.fold_left f acc is) is) (*Typo*) end (* tests of (inner) find_example(_gen) behaviour *) module FindExample = struct open QCheck let find_ex = Test.make ~name:"find_example" (2--50) (fun n -> let st = Random.State.make [| 0 |] in let f m = n < m && m < 2 * n in try let m = find_example_gen ~rand:st ~count:100_000 ~f Gen.(0 -- 1000) in f m with No_example_found _ -> false) let find_ex_uncaught_issue_99_1_fail = let rs = make (find_example ~count:10 ~f:(fun _ -> false) Gen.int) in Test.make ~name:"FAIL_#99_1" rs (fun _ -> true) let find_ex_uncaught_issue_99_2_succeed = Test.make ~name:"should_succeed_#99_2" ~count:10 int (fun i -> i <= max_int) end (* tests of statistics and histogram display *) module Stats = struct open QCheck let bool_dist = Test.make ~name:"bool dist" ~count:500_000 (set_collect Bool.to_string bool) (fun _ -> true) let char_dist = Test.make ~name:"char code dist" ~count:500_000 (add_stat ("char code", Char.code) char) (fun _ -> true) let string_len_tests = let len = ("len",String.length) in [ Test.make ~name:"string_size len dist" ~count:5_000 (add_stat len (string_of_size (Gen.int_range 5 10))) (fun _ -> true); Test.make ~name:"string len dist" ~count:5_000 (add_stat len string) (fun _ -> true); Test.make ~name:"string_of len dist" ~count:5_000 (add_stat len (string_gen (Gen.return 'a'))) (fun _ -> true); Test.make ~name:"printable_string len dist" ~count:5_000 (add_stat len printable_string) (fun _ -> true); Test.make ~name:"small_string len dist" ~count:5_000 (add_stat len small_string) (fun _ -> true); ] let list_len_tests = let len = ("len",List.length) in [ (* test from issue #30 *) Test.make ~name:"list len dist" ~count:5_000 (add_stat len (list int)) (fun _ -> true); Test.make ~name:"small_list len dist" ~count:5_000 (add_stat len (small_list int)) (fun _ -> true); 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); Test.make ~name:"list_repeat len dist" ~count:5_000 (add_stat len (make Gen.(list_repeat 42 int))) (fun _ -> true); ] let array_len_tests = let len = ("len",Array.length) in [ Test.make ~name:"array len dist" ~count:5_000 (add_stat len (array int)) (fun _ -> true); Test.make ~name:"small_array len dist" ~count:5_000 (add_stat len (make Gen.(small_array int))) (fun _ -> true); 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); Test.make ~name:"array_repeat len dist" ~count:5_000 (add_stat len (make Gen.(array_repeat 42 int))) (fun _ -> true); ] let int_dist_tests = let dist = ("dist",fun x -> x) in [ (* test from issue #40 *) Test.make ~name:"int_stats_neg" ~count:5000 (add_stat dist small_signed_int) (fun _ -> true); (* distribution tests from PR #45 *) Test.make ~name:"small_signed_int dist" ~count:1000 (add_stat dist small_signed_int) (fun _ -> true); Test.make ~name:"small_nat dist" ~count:1000 (add_stat dist small_nat) (fun _ -> true); Test.make ~name:"nat dist" ~count:1000 (add_stat dist (make Gen.nat)) (fun _ -> true); Test.make ~name:"int_range (-43643) 435434 dist" ~count:1000 (add_stat dist (int_range (-43643) 435434)) (fun _ -> true); Test.make ~name:"int_range (-40000) 40000 dist" ~count:1000 (add_stat dist (int_range (-40000) 40000)) (fun _ -> true); Test.make ~name:"int_range (-4) 4 dist" ~count:1000 (add_stat dist (int_range (-4) 4)) (fun _ -> true); Test.make ~name:"int_range (-4) 17 dist" ~count:1000 (add_stat dist (int_range (-4) 17)) (fun _ -> true); Test.make ~name:"int dist" ~count:100000 (add_stat dist int) (fun _ -> true); Test.make ~name:"oneof int dist" ~count:1000 (add_stat dist (oneofl[min_int;-1;0;1;max_int])) (fun _ -> true); ] let int_dist_empty_bucket = Test.make ~name:"int_dist_empty_bucket" ~count:1_000 (add_stat ("dist",fun x -> x) (oneof [small_int_corners ();int])) (fun _ -> true) let tree_depth_test = let depth = ("depth", IntTree.depth) in Test.make ~name:"tree's depth" ~count:1000 (add_stat depth (make IntTree.gen_tree)) (fun _ -> true) let range_subset_test = Test.make ~name:"range_subset_spec" ~count:5_000 (add_stat ("dist", fun a -> a.(0)) (make (Gen.range_subset ~size:1 0 20))) (fun a -> Array.length a = 1) end (* Calling runners *) let () = QCheck_base_runner.set_seed 1234 let _ = QCheck_base_runner.run_tests ~colors:false ([ Overall.passing; Overall.failing; Overall.error; Overall.collect; Overall.stats; Overall.bad_assume_warn; Overall.bad_assume_fail; Generator.char_dist_issue_23; Generator.char_test; Generator.nat_test; Generator.string_test; Generator.list_test; Generator.list_repeat_test; Generator.array_repeat_test; Generator.passing_tree_rev; Generator.nat_split2_spec; Generator.pos_split2_spec; Generator.range_subset_spec; Generator.nat_split_n_way; Generator.nat_split_smaller; Generator.pos_split; (*Shrink.test_fac_issue59;*) Shrink.big_bound_issue59; Shrink.long_shrink; Shrink.ints_arent_0_mod_3; Shrink.ints_are_0; Shrink.ints_smaller_209609; Shrink.nats_smaller_5001; Shrink.char_is_never_abcdef; Shrink.strings_are_empty; Shrink.string_never_has_000_char; Shrink.string_never_has_255_char; Shrink.lists_are_empty_issue_64; Shrink.list_shorter_10; Shrink.list_shorter_432; Shrink.list_shorter_4332; Shrink.list_equal_dupl; Shrink.list_unique_elems; Function.fail_pred_map_commute; Function.fail_pred_strings; Function.prop_foldleft_foldright; Function.prop_foldleft_foldright_uncurry; Function.prop_foldleft_foldright_uncurry_funlast; Function.fold_left_test; FindExample.find_ex; FindExample.find_ex_uncaught_issue_99_1_fail; FindExample.find_ex_uncaught_issue_99_2_succeed; Stats.bool_dist; Stats.char_dist; Stats.tree_depth_test; Stats.range_subset_test] @ Stats.string_len_tests @ Stats.list_len_tests @ Stats.array_len_tests @ Stats.int_dist_tests) let () = QCheck_base_runner.set_seed 153870556 let _ = QCheck_base_runner.run_tests ~colors:false [Stats.int_dist_empty_bucket] qcheck-0.18.1/test/core/dune000066400000000000000000000021021417677125000156310ustar00rootroot00000000000000 (test (name test) (modules test) (package qcheck-core) (libraries qcheck-core alcotest)) (executables (names QCheck_expect_test QCheck2_expect_test) (modules QCheck_expect_test QCheck2_expect_test) (libraries qcheck-core qcheck-core.runner)) ;; rules for QCheck_expect_test (rule (targets qcheck_output.txt) (deps ./QCheck_expect_test.exe) (package qcheck-core) (enabled_if (= %{os_type} "Unix")) (action (with-stdout-to %{targets} (run ./QCheck_expect_test.exe --no-colors)))) (rule (alias runtest) (package qcheck-core) (enabled_if (= %{os_type} "Unix")) (action (diff qcheck_output.txt.expected qcheck_output.txt))) ;; rules for QCheck2_expect_test (rule (targets qcheck2_output.txt) (deps ./QCheck2_expect_test.exe) (package qcheck-core) (enabled_if (= %{os_type} "Unix")) (action (with-stdout-to %{targets} (run ./QCheck2_expect_test.exe --no-colors)))) (rule (alias runtest) (package qcheck-core) (enabled_if (= %{os_type} "Unix")) (action (diff qcheck2_output.txt.expected qcheck2_output.txt))) qcheck-0.18.1/test/core/qcheck2_output.txt.expected000066400000000000000000001702241417677125000222670ustar00rootroot00000000000000random seed: 1234 2724675603984413065 0 1362337801992206532 0 681168900996103266 0 340584450498051633 0 170292225249025816 0 85146112624512908 0 42573056312256454 0 21286528156128227 0 10643264078064113 0 5321632039032056 0 2660816019516028 0 1330408009758014 0 665204004879007 0 332602002439503 0 166301001219751 0 83150500609875 0 41575250304937 0 20787625152468 0 10393812576234 0 5196906288117 0 2598453144058 0 1299226572029 0 649613286014 0 324806643007 0 162403321503 0 81201660751 0 40600830375 0 20300415187 0 10150207593 0 5075103796 0 2537551898 0 1268775949 0 634387974 0 317193987 0 158596993 0 79298496 0 39649248 0 19824624 0 9912312 0 4956156 0 2478078 0 1239039 0 619519 0 309759 0 154879 0 77439 0 38719 0 19359 0 9679 0 4839 0 2419 0 1209 0 604 0 302 0 151 0 75 0 37 0 18 0 9 0 4 0 2 0 1 0 [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] [] [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] [] [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] [] [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] [] [9; 8; 73; 5; 8; 2; 1; 8; 2; 6; 4; 18; 5; 76; 3] [] [0; 6; 2; 8; 8; 1; 4] [] [5; 2; 3] [] [3] [] [0] [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] [] [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] [] [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] [] [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] [] [9; 8; 73; 5; 8; 2; 1; 8; 2; 6; 4; 18; 5; 76; 3] [] [0; 6; 2; 8; 8; 1; 4] [] [5; 2; 3] [3; 2; 7; 3; 3] [] [5; 3] [5; 3; 2] [9; 87; 7; 0] [0; 2; 7; 3; 3] [0; 0; 7; 3; 3] [0; 0; 0; 3; 3] [0; 0; 0; 0; 3] [0; 0; 0; 0; 0] --- Failure -------------------------------------------------------------------- Test should_fail_sort_id failed (9 shrink steps): [1; 0] === Error ====================================================================== Test should_error_raise_exn errored on (1 shrink steps): 0 exception Dune__exe__QCheck2_expect_test.Overall.Error +++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Collect results for test collect_results: 4: 20 cases 3: 25 cases 2: 17 cases 1: 18 cases 0: 20 cases +++ Stats for with_stats ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats mod4: num: 100, avg: 1.68, stddev: 1.09, median 2, min 0, max 3 0: ############################## 17 1: ################################################### 29 2: ######################################## 23 3: ####################################################### 31 stats num: num: 100, avg: 66.84, stddev: 31.94, median 65, min 2, max 120 2.. 7: ################## 3 8.. 13: ################## 3 14.. 19: 0 20.. 25: ########################################## 7 26.. 31: ######################## 4 32.. 37: ######################## 4 38.. 43: ################## 3 44.. 49: ################################################ 8 50.. 55: #################################### 6 56.. 61: #################################### 6 62.. 67: ####################################################### 9 68.. 73: ########################################## 7 74.. 79: ######################## 4 80.. 85: ################## 3 86.. 91: ############ 2 92.. 97: ########################################## 7 98..103: #################################### 6 104..109: #################################### 6 110..115: ####################################################### 9 116..121: ################## 3 !!! Warning !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Warning for test WARN_unlikely_precond: WARNING: only 0.5% tests (of 2000) passed precondition for "WARN_unlikely_precond" NOTE: it is likely that the precondition is too strong, or that the generator is buggy. --- Failure -------------------------------------------------------------------- Test FAIL_unlikely_precond failed: ERROR: only 0.5% tests (of 2000) passed precondition for "FAIL_unlikely_precond" NOTE: it is likely that the precondition is too strong, or that the generator is buggy. --- Failure -------------------------------------------------------------------- Test char never produces '\255' failed (0 shrink steps): '\255' --- Failure -------------------------------------------------------------------- Test big bound issue59 failed (0 shrink steps): 4611686018427387903 --- Failure -------------------------------------------------------------------- Test long_shrink failed (3039 shrink steps): ([0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0], [0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 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]) --- Failure -------------------------------------------------------------------- Test ints arent 0 mod 3 failed (2 shrink steps): 0 --- Failure -------------------------------------------------------------------- Test ints are 0 failed (61 shrink steps): 1 --- Failure -------------------------------------------------------------------- Test ints < 209609 failed (0 shrink steps): 4611686018427387903 --- Failure -------------------------------------------------------------------- Test nat < 5001 failed (7 shrink steps): 5001 --- Failure -------------------------------------------------------------------- Test char is never produces 'abcdef' failed (1 shrink steps): 'a' --- Failure -------------------------------------------------------------------- Test strings are empty failed (8 shrink steps): "a" --- Failure -------------------------------------------------------------------- Test string never has a \000 char failed (22 shrink steps): "aaaaaa\000aaaaaaaaaaaaaaaa" --- Failure -------------------------------------------------------------------- Test string never has a \255 char failed (59 shrink steps): "aaaaaaaaaaaaaaaaaaaaaaaaaa\255aaaaaaaaaaaaaaaaaaaaaaaa" --- Failure -------------------------------------------------------------------- Test lists are empty failed (8 shrink steps): [0] --- Failure -------------------------------------------------------------------- Test lists shorter than 10 failed (16 shrink steps): [0; 0; 0; 0; 0; 0; 0; 0; 0; 0] --- Failure -------------------------------------------------------------------- Test lists shorter than 432 failed (412 shrink steps): [...] list length: 432 --- Failure -------------------------------------------------------------------- Test lists shorter than 4332 failed (4022 shrink steps): [...] list length: 4332 --- Failure -------------------------------------------------------------------- Test lists equal to duplication failed (4 shrink steps): [0] --- Failure -------------------------------------------------------------------- Test lists have unique elems failed (11 shrink steps): [0; 0; 0; 0; 0] --- Failure -------------------------------------------------------------------- Test tree contains only 42 failed (2 shrink steps): Leaf 0 --- Failure -------------------------------------------------------------------- Test fail_pred_map_commute failed (16 shrink steps): ([2], {_ -> 0}, {1 -> false; 2 -> true; _ -> false}) --- Failure -------------------------------------------------------------------- Test fail_pred_strings failed (1 shrink steps): {"some random string" -> true; _ -> false} --- Failure -------------------------------------------------------------------- Test fold_left fold_right failed (22 shrink steps): (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}) +++ Messages ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Messages for test fold_left fold_right: l=[1], fold_left=1, fold_right=0 --- Failure -------------------------------------------------------------------- Test fold_left fold_right uncurried failed (325 shrink steps): ({(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]) --- Failure -------------------------------------------------------------------- Test fold_left fold_right uncurried fun last failed (25 shrink steps): (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}) --- Failure -------------------------------------------------------------------- Test fold_left test, fun first failed (15 shrink steps): ({_ -> ""}, "a", [], [0]) --- Failure -------------------------------------------------------------------- Test FAIL_#99_1 failed: ERROR: uncaught exception in generator for test FAIL_#99_1 after 100 steps: Exception: QCheck2.No_example_found("") Backtrace: +++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Collect results for test bool dist: true: 250134 cases false: 249866 cases +++ Stats for char code dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats char code: num: 500000, avg: 127.42, stddev: 73.92, median 127, min 0, max 255 0.. 12: ###################################################### 25509 13.. 25: ###################################################### 25398 26.. 38: ###################################################### 25293 39.. 51: ###################################################### 25448 52.. 64: ###################################################### 25392 65.. 77: ####################################################### 25660 78.. 90: ###################################################### 25462 91..103: ###################################################### 25331 104..116: ##################################################### 25129 117..129: ###################################################### 25351 130..142: ###################################################### 25492 143..155: ###################################################### 25370 156..168: ###################################################### 25658 169..181: ###################################################### 25400 182..194: ##################################################### 25167 195..207: ###################################################### 25338 208..220: ##################################################### 25181 221..233: ##################################################### 25145 234..246: ###################################################### 25567 247..259: ##################################### 17709 +++ Stats for tree's depth ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats depth: num: 1000, avg: 3.74, stddev: 3.28, median 3, min 1, max 15 1: ####################################################### 377 2: ################ 113 3: ############ 87 4: ################# 123 5: ########### 81 6: #### 33 7: ##### 40 8: ##### 39 9: # 9 10: ### 25 11: ####### 49 12: 4 13: # 9 14: # 7 15: 4 +++ Stats for string_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 7.49, stddev: 1.70, median 7, min 5, max 10 5: ##################################################### 837 6: ##################################################### 826 7: ###################################################### 843 8: ####################################################### 855 9: #################################################### 813 10: ##################################################### 826 +++ Stats for string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 384.53, stddev: 1330.61, median 9, min 0, max 9969 0.. 498: ####################################################### 4246 499.. 997: ###### 518 998..1496: 21 1497..1995: 10 1996..2494: 11 2495..2993: 10 2994..3492: 13 3493..3991: 13 3992..4490: 5 4491..4989: 10 4990..5488: 19 5489..5987: 9 5988..6486: 10 6487..6985: 12 6986..7484: 17 7485..7983: 16 7984..8482: 16 8483..8981: 16 8982..9480: 16 9481..9979: 12 +++ Stats for string_of len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 363.14, stddev: 1245.80, median 9, min 0, max 9986 0.. 499: ####################################################### 4270 500.. 999: ###### 493 1000.. 1499: 16 1500.. 1999: 11 2000.. 2499: 15 2500.. 2999: 17 3000.. 3499: 11 3500.. 3999: 19 4000.. 4499: 14 4500.. 4999: 10 5000.. 5499: 16 5500.. 5999: 11 6000.. 6499: 15 6500.. 6999: 13 7000.. 7499: 12 7500.. 7999: 16 8000.. 8499: 11 8500.. 8999: 4 9000.. 9499: 13 9500.. 9999: 13 +++ Stats for string_printable len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 384.53, stddev: 1330.61, median 9, min 0, max 9969 0.. 498: ####################################################### 4246 499.. 997: ###### 518 998..1496: 21 1497..1995: 10 1996..2494: 11 2495..2993: 10 2994..3492: 13 3493..3991: 13 3992..4490: 5 4491..4989: 10 4990..5488: 19 5489..5987: 9 5988..6486: 10 6487..6985: 12 6986..7484: 17 7485..7983: 16 7984..8482: 16 8483..8981: 16 8982..9480: 16 9481..9979: 12 +++ Stats for small_string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 15.57, stddev: 24.36, median 6, min 0, max 99 0.. 4: #################################################### 1925 5.. 9: ####################################################### 2005 10.. 14: # 52 15.. 19: # 50 20.. 24: # 55 25.. 29: # 56 30.. 34: # 55 35.. 39: # 49 40.. 44: # 65 45.. 49: # 65 50.. 54: # 55 55.. 59: # 68 60.. 64: # 61 65.. 69: # 65 70.. 74: # 57 75.. 79: # 66 80.. 84: # 65 85.. 89: # 64 90.. 94: # 60 95.. 99: # 62 +++ Stats for list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 400.16, stddev: 1371.90, median 9, min 0, max 9987 0.. 499: ####################################################### 4246 500.. 999: ###### 502 1000.. 1499: 13 1500.. 1999: 10 2000.. 2499: 14 2500.. 2999: 14 3000.. 3499: 20 3500.. 3999: 7 4000.. 4499: 13 4500.. 4999: 16 5000.. 5499: 12 5500.. 5999: 15 6000.. 6499: 15 6500.. 6999: 13 7000.. 7499: 16 7500.. 7999: 12 8000.. 8499: 11 8500.. 8999: 16 9000.. 9499: 15 9500.. 9999: 20 +++ Stats for small_list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 16.14, stddev: 24.86, median 6, min 0, max 99 0.. 4: ###################################################### 1923 5.. 9: ####################################################### 1936 10.. 14: # 61 15.. 19: # 59 20.. 24: # 62 25.. 29: # 70 30.. 34: # 61 35.. 39: # 64 40.. 44: # 64 45.. 49: # 56 50.. 54: # 65 55.. 59: # 55 60.. 64: # 60 65.. 69: # 62 70.. 74: # 57 75.. 79: # 69 80.. 84: ## 73 85.. 89: # 67 90.. 94: # 62 95.. 99: ## 74 +++ Stats for list_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 7.49, stddev: 1.71, median 8, min 5, max 10 5: ####################################################### 867 6: ################################################### 813 7: ################################################### 815 8: #################################################### 833 9: ###################################################### 857 10: ################################################### 815 +++ Stats for list_repeat len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 42.00, stddev: 0.00, median 42, min 42, max 42 42: ####################################################### 5000 +++ Stats for array len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 400.16, stddev: 1371.90, median 9, min 0, max 9987 0.. 499: ####################################################### 4246 500.. 999: ###### 502 1000.. 1499: 13 1500.. 1999: 10 2000.. 2499: 14 2500.. 2999: 14 3000.. 3499: 20 3500.. 3999: 7 4000.. 4499: 13 4500.. 4999: 16 5000.. 5499: 12 5500.. 5999: 15 6000.. 6499: 15 6500.. 6999: 13 7000.. 7499: 16 7500.. 7999: 12 8000.. 8499: 11 8500.. 8999: 16 9000.. 9499: 15 9500.. 9999: 20 +++ Stats for small_array len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 16.14, stddev: 24.86, median 6, min 0, max 99 0.. 4: ###################################################### 1923 5.. 9: ####################################################### 1936 10.. 14: # 61 15.. 19: # 59 20.. 24: # 62 25.. 29: # 70 30.. 34: # 61 35.. 39: # 64 40.. 44: # 64 45.. 49: # 56 50.. 54: # 65 55.. 59: # 55 60.. 64: # 60 65.. 69: # 62 70.. 74: # 57 75.. 79: # 69 80.. 84: ## 73 85.. 89: # 67 90.. 94: # 62 95.. 99: ## 74 +++ Stats for array_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 7.49, stddev: 1.71, median 8, min 5, max 10 5: ####################################################### 867 6: ################################################### 813 7: ################################################### 815 8: #################################################### 833 9: ###################################################### 857 10: ################################################### 815 +++ Stats for array_repeat len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 42.00, stddev: 0.00, median 42, min 42, max 42 42: ####################################################### 5000 +++ Stats for int_stats_neg ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 5000, avg: 0.17, stddev: 29.68, median 0, min -99, max 99 -99..-90: # 65 -89..-80: # 63 -79..-70: # 64 -69..-60: # 58 -59..-50: # 67 -49..-40: # 72 -39..-30: # 61 -29..-20: # 61 -19..-10: # 67 -9.. 0: ####################################################### 2076 1.. 10: ############################################## 1764 11.. 20: # 66 21.. 30: # 64 31.. 40: # 64 41.. 50: # 67 51.. 60: # 60 61.. 70: # 75 71.. 80: # 60 81.. 90: # 60 91..100: # 66 +++ Stats for small_signed_int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 0.90, stddev: 28.23, median 0, min -99, max 99 -99..-90: # 12 -89..-80: # 11 -79..-70: # 9 -69..-60: 6 -59..-50: # 11 -49..-40: # 13 -39..-30: # 9 -29..-20: # 13 -19..-10: 8 -9.. 0: ####################################################### 453 1.. 10: ######################################### 340 11.. 20: # 15 21.. 30: # 11 31.. 40: # 12 41.. 50: # 13 51.. 60: # 13 61.. 70: # 16 71.. 80: # 9 81.. 90: # 16 91..100: # 10 +++ Stats for small_nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 15.11, stddev: 23.27, median 6, min 0, max 99 0.. 4: #################################################### 377 5.. 9: ####################################################### 392 10.. 14: ## 20 15.. 19: ## 15 20.. 24: # 11 25.. 29: ## 17 30.. 34: ## 19 35.. 39: ## 17 40.. 44: # 10 45.. 49: # 9 50.. 54: # 8 55.. 59: # 9 60.. 64: ## 15 65.. 69: # 10 70.. 74: # 13 75.. 79: ## 19 80.. 84: # 11 85.. 89: # 13 90.. 94: 5 95.. 99: # 10 +++ Stats for nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 363.02, stddev: 1215.04, median 9, min 0, max 9476 0.. 473: ####################################################### 847 474.. 947: ###### 95 948..1421: 14 1422..1895: 3 1896..2369: 0 2370..2843: 3 2844..3317: 2 3318..3791: 3 3792..4265: 2 4266..4739: 4 4740..5213: 3 5214..5687: 4 5688..6161: 3 6162..6635: 4 6636..7109: 1 7110..7583: 4 7584..8057: 2 8058..8531: 1 8532..9005: 1 9006..9479: 4 +++ Stats for int_range (-43643) 435434 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 195335.64, stddev: 136803.99, median 195583, min -43624, max 435210 -43624..-19683: ############################################ 52 -19682.. 4259: ######################################## 47 4260.. 28201: ############################## 36 28202.. 52143: ############################################ 52 52144.. 76085: ########################################## 50 76086..100027: ####################################################### 64 100028..123969: ############################################### 55 123970..147911: ######################################## 47 147912..171853: ############################################## 54 171854..195795: #################################### 43 195796..219737: ############################################## 54 219738..243679: ########################################### 51 243680..267621: ################################################ 57 267622..291563: ########################################## 49 291564..315505: #################################### 42 315506..339447: ###################################### 45 339448..363389: ################################################ 57 363390..387331: ###################################### 45 387332..411273: ########################################## 49 411274..435215: ########################################### 51 +++ Stats for int_range (-40000) 40000 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: -173.78, stddev: 23042.92, median 180, min -39859, max 39942 -39859..-35869: ############################################# 56 -35868..-31878: ################################### 43 -31877..-27887: ################################################# 60 -27886..-23896: ##################################### 46 -23895..-19905: ######################################## 49 -19904..-15914: #################################### 45 -15913..-11923: ############################################ 54 -11922.. -7932: ############################################### 58 -7931.. -3941: ######################################### 51 -3940.. 50: ############################ 35 51.. 4041: ####################################### 48 4042.. 8032: ########################################## 52 8033.. 12023: ######################################### 51 12024.. 16014: ########################################### 53 16015.. 20005: ############################################ 54 20006.. 23996: ################################## 42 23997.. 27987: ####################################################### 67 27988.. 31978: ################################ 40 31979.. 35969: ######################################### 51 35970.. 39960: #################################### 45 +++ Stats for int_range (-4) 4 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 0.02, stddev: 2.55, median 0, min -4, max 4 -4: ############################################ 99 -3: ##################################################### 118 -2: ################################################## 111 -1: ################################################## 113 0: ################################################## 113 1: ##################################################### 118 2: ############################################# 102 3: ####################################################### 122 4: ############################################## 104 +++ Stats for int_range (-4) 17 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 6.67, stddev: 6.39, median 7, min -4, max 17 -4..-3: ############################################# 90 -2..-1: ############################################# 91 0.. 1: ########################################## 84 2.. 3: ############################################## 92 4.. 5: ########################################### 87 6.. 7: ########################################### 86 8.. 9: ############################################ 89 10..11: ########################################### 87 12..13: ####################################################### 110 14..15: ############################################# 91 16..17: ############################################## 93 18..19: 0 20..21: 0 22..23: 0 24..25: 0 26..27: 0 28..29: 0 30..31: 0 32..33: 0 34..35: 0 +++ Stats for int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 100000, avg: 2541076923587387.50, stddev: 2660730801206827008.00, median 158655268318060, min -4611522359435274428, max 4611540922436307689 -4611522359435274428..-4150369195341695293: ##################################################### 4976 -4150369195341695292..-3689216031248116157: ##################################################### 4963 -3689216031248116156..-3228062867154537021: ###################################################### 5038 -3228062867154537020..-2766909703060957885: ##################################################### 4979 -2766909703060957884..-2305756538967378749: ##################################################### 5001 -2305756538967378748..-1844603374873799613: ##################################################### 4982 -1844603374873799612..-1383450210780220477: ##################################################### 5025 -1383450210780220476.. -922297046686641341: #################################################### 4901 -922297046686641340.. -461143882593062205: ####################################################### 5126 -461143882593062204.. 9281500516931: ##################################################### 5008 9281500516932.. 461162445594096067: ###################################################### 5041 461162445594096068.. 922315609687675203: ##################################################### 5001 922315609687675204.. 1383468773781254339: ##################################################### 4986 1383468773781254340.. 1844621937874833475: ##################################################### 4949 1844621937874833476.. 2305775101968412611: ##################################################### 5025 2305775101968412612.. 2766928266061991747: ##################################################### 5022 2766928266061991748.. 3228081430155570883: ##################################################### 4958 3228081430155570884.. 3689234594249150019: ##################################################### 4998 3689234594249150020.. 4150387758342729155: ##################################################### 4982 4150387758342729156.. 4611540922436308291: ###################################################### 5039 +++ Stats for oneof int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 4611686018427388.00, stddev: 2905870896563567616.00, median 0, min -4611686018427387904, max 4611686018427387903 -4611686018427387904..-4150517416584649089: ################## 208 -4150517416584649088..-3689348814741910273: 0 -3689348814741910272..-3228180212899171457: 0 -3228180212899171456..-2767011611056432641: 0 -2767011611056432640..-2305843009213693825: 0 -2305843009213693824..-1844674407370955009: 0 -1844674407370955008..-1383505805528216193: 0 -1383505805528216192.. -922337203685477377: 0 -922337203685477376.. -461168601842738561: 0 -461168601842738560.. 255: ####################################################### 603 256.. 461168601842739071: 0 461168601842739072.. 922337203685477887: 0 922337203685477888.. 1383505805528216703: 0 1383505805528216704.. 1844674407370955519: 0 1844674407370955520.. 2305843009213694335: 0 2305843009213694336.. 2767011611056433151: 0 2767011611056433152.. 3228180212899171967: 0 3228180212899171968.. 3689348814741910783: 0 3689348814741910784.. 4150517416584649599: 0 4150517416584649600.. 4611686018427387903: ################# 189 ================================================================================ 1 warning(s) failure (27 tests failed, 1 tests errored, ran 67 tests) random seed: 153870556 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: -55083208105414400.00, stddev: 1847115855773139200.00, median 9, min -4590718933436425025, max 4611686018427387903 -4590718933436425025..-4130598685843234370: ## 26 -4130598685843234369..-3670478438250043714: # 13 -3670478438250043713..-3210358190656853058: ### 37 -3210358190656853057..-2750237943063662402: ### 30 -2750237943063662401..-2290117695470471746: ## 27 -2290117695470471745..-1829997447877281090: ## 24 -1829997447877281089..-1369877200284090434: ## 27 -1369877200284090433.. -909756952690899778: ## 27 -909756952690899777.. -449636705097709122: ## 21 -449636705097709121.. 10483542495481534: ####################################################### 531 10483542495481535.. 470603790088672190: ## 21 470603790088672191.. 930724037681862846: ## 27 930724037681862847.. 1390844285275053502: ## 24 1390844285275053503.. 1850964532868244158: ## 25 1850964532868244159.. 2311084780461434814: ## 28 2311084780461434815.. 2771205028054625470: ## 23 2771205028054625471.. 3231325275647816126: ## 23 3231325275647816127.. 3691445523241006782: ## 25 3691445523241006783.. 4151565770834197438: # 17 4151565770834197439.. 4611686018427387903: ## 24 ================================================================================ success (ran 1 tests) qcheck-0.18.1/test/core/qcheck_output.txt.expected000066400000000000000000001516571417677125000222160ustar00rootroot00000000000000random seed: 1234 2724675603984413065 1362337801992206533 681168900996103267 340584450498051634 170292225249025817 85146112624512909 42573056312256455 21286528156128228 10643264078064114 5321632039032057 2660816019516029 1330408009758015 665204004879008 332602002439504 166301001219752 83150500609876 41575250304938 20787625152469 10393812576235 5196906288118 2598453144059 1299226572030 649613286015 324806643008 162403321504 81201660752 40600830376 20300415188 10150207594 5075103797 2537551899 1268775950 634387975 317193988 158596994 79298497 39649249 19824625 9912313 4956157 2478079 1239040 619520 309760 154880 77440 38720 19360 9680 4840 2420 1210 605 303 152 76 38 19 10 5 3 2 1 0 [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] [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] [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] [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] [4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7] [5; 1; 2; 9; 74; 7; 7] [74; 7; 7] [7] [] [4] [] [2] [] [1] [] [0] [] [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] [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] [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] [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] [4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7] [5; 1; 2; 9; 74; 7; 7] [74; 7; 7] [7] [74] [7; 7] [7] [7] [4; 7] [6; 7] [6; 7] [7; 4] [7; 6] [7; 6] --- Failure -------------------------------------------------------------------- Test should_fail_sort_id failed (18 shrink steps): [1; 0] === Error ====================================================================== Test should_error_raise_exn errored on (63 shrink steps): 0 exception Dune__exe__QCheck_expect_test.Overall.Error +++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Collect results for test collect_results: 4: 20 cases 3: 25 cases 2: 17 cases 1: 18 cases 0: 20 cases +++ Stats for with_stats ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats mod4: num: 100, avg: 1.68, stddev: 1.09, median 2, min 0, max 3 0: ############################## 17 1: ################################################### 29 2: ######################################## 23 3: ####################################################### 31 stats num: num: 100, avg: 66.84, stddev: 31.94, median 65, min 2, max 120 2.. 7: ################## 3 8.. 13: ################## 3 14.. 19: 0 20.. 25: ########################################## 7 26.. 31: ######################## 4 32.. 37: ######################## 4 38.. 43: ################## 3 44.. 49: ################################################ 8 50.. 55: #################################### 6 56.. 61: #################################### 6 62.. 67: ####################################################### 9 68.. 73: ########################################## 7 74.. 79: ######################## 4 80.. 85: ################## 3 86.. 91: ############ 2 92.. 97: ########################################## 7 98..103: #################################### 6 104..109: #################################### 6 110..115: ####################################################### 9 116..121: ################## 3 !!! Warning !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Warning for test WARN_unlikely_precond: WARNING: only 0.5% tests (of 2000) passed precondition for "WARN_unlikely_precond" NOTE: it is likely that the precondition is too strong, or that the generator is buggy. --- Failure -------------------------------------------------------------------- Test FAIL_unlikely_precond failed: ERROR: only 0.5% tests (of 2000) passed precondition for "FAIL_unlikely_precond" NOTE: it is likely that the precondition is too strong, or that the generator is buggy. --- Failure -------------------------------------------------------------------- Test char never produces '\255' failed (0 shrink steps): '\255' --- Failure -------------------------------------------------------------------- Test big bound issue59 failed (52 shrink steps): 209609 --- Failure -------------------------------------------------------------------- Test long_shrink failed (149 shrink steps): ([0], [-1]) --- Failure -------------------------------------------------------------------- Test ints arent 0 mod 3 failed (84 shrink steps): -21 --- Failure -------------------------------------------------------------------- Test ints are 0 failed (62 shrink steps): 1 --- Failure -------------------------------------------------------------------- Test ints < 209609 failed (52 shrink steps): 209609 --- Failure -------------------------------------------------------------------- Test nat < 5001 failed (6 shrink steps): 5001 --- Failure -------------------------------------------------------------------- Test char is never produces 'abcdef' failed (0 shrink steps): 'd' --- Failure -------------------------------------------------------------------- Test strings are empty failed (249 shrink steps): "\177" --- Failure -------------------------------------------------------------------- Test string never has a \000 char failed (25 shrink steps): "\000" --- Failure -------------------------------------------------------------------- Test string never has a \255 char failed (249 shrink steps): "\255" --- Failure -------------------------------------------------------------------- Test lists are empty failed (11 shrink steps): [0] --- Failure -------------------------------------------------------------------- Test lists shorter than 10 failed (50 shrink steps): [0; 0; 0; 0; 0; 0; 0; 0; 0; 0] --- Failure -------------------------------------------------------------------- Test lists shorter than 432 failed (1696 shrink steps): [...] list length: 432 --- Failure -------------------------------------------------------------------- Test lists shorter than 4332 failed (13 shrink steps): [...] list length: 4332 --- Failure -------------------------------------------------------------------- Test lists equal to duplication failed (20 shrink steps): [0] --- Failure -------------------------------------------------------------------- Test lists have unique elems failed (7 shrink steps): [7; 7] --- Failure -------------------------------------------------------------------- Test fail_pred_map_commute failed (127 shrink steps): ([3], {_ -> 0}, {3 -> false; _ -> true}) --- Failure -------------------------------------------------------------------- Test fail_pred_strings failed (1 shrink steps): {some random string -> true; _ -> false} --- Failure -------------------------------------------------------------------- Test fold_left fold_right failed (25 shrink steps): (0, [1], {(1, 0) -> 1; _ -> 0}) +++ Messages ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Messages for test fold_left fold_right: l=[1], fold_left=1, fold_right=0 --- Failure -------------------------------------------------------------------- Test fold_left fold_right uncurried failed (111 shrink steps): ({(5, 7) -> 0; _ -> 7}, 0, [5; 0]) --- Failure -------------------------------------------------------------------- Test fold_left fold_right uncurried fun last failed (26 shrink steps): (0, [1], {(0, 1) -> 1; _ -> 0}) --- Failure -------------------------------------------------------------------- Test false fold, fun first failed (40 shrink steps): ({_ -> ""}, "z", [], [0]) --- Failure -------------------------------------------------------------------- Test FAIL_#99_1 failed: ERROR: uncaught exception in generator for test FAIL_#99_1 after 100 steps: Exception: QCheck.No_example_found("") Backtrace: +++ Collect ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Collect results for test bool dist: true: 250134 cases false: 249866 cases +++ Stats for char code dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats char code: num: 500000, avg: 127.42, stddev: 73.92, median 127, min 0, max 255 0.. 12: ###################################################### 25509 13.. 25: ###################################################### 25398 26.. 38: ###################################################### 25293 39.. 51: ###################################################### 25448 52.. 64: ###################################################### 25392 65.. 77: ####################################################### 25660 78.. 90: ###################################################### 25462 91..103: ###################################################### 25331 104..116: ##################################################### 25129 117..129: ###################################################### 25351 130..142: ###################################################### 25492 143..155: ###################################################### 25370 156..168: ###################################################### 25658 169..181: ###################################################### 25400 182..194: ##################################################### 25167 195..207: ###################################################### 25338 208..220: ##################################################### 25181 221..233: ##################################################### 25145 234..246: ###################################################### 25567 247..259: ##################################### 17709 +++ Stats for tree's depth ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats depth: num: 1000, avg: 3.74, stddev: 3.28, median 3, min 1, max 15 1: ####################################################### 377 2: ################ 113 3: ############ 87 4: ################# 123 5: ########### 81 6: #### 33 7: ##### 40 8: ##### 39 9: # 9 10: ### 25 11: ####### 49 12: 4 13: # 9 14: # 7 15: 4 +++ Stats for range_subset_spec ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 5000, avg: 9.97, stddev: 6.08, median 10, min 0, max 20 0: ################################################# 246 1: ################################################ 244 2: ################################################ 240 3: ################################################ 243 4: ############################################## 232 5: ############################################## 230 6: ############################################### 239 7: ############################################### 235 8: ####################################################### 274 9: ############################################## 233 10: ########################################## 212 11: ############################################## 231 12: ############################################### 239 13: ############################################# 226 14: ############################################# 225 15: ################################################### 256 16: ################################################ 240 17: ############################################# 229 18: ################################################ 243 19: ################################################## 253 20: ############################################## 230 +++ Stats for string_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 7.49, stddev: 1.70, median 7, min 5, max 10 5: ##################################################### 837 6: ##################################################### 826 7: ###################################################### 843 8: ####################################################### 855 9: #################################################### 813 10: ##################################################### 826 +++ Stats for string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 384.53, stddev: 1330.61, median 9, min 0, max 9969 0.. 498: ####################################################### 4246 499.. 997: ###### 518 998..1496: 21 1497..1995: 10 1996..2494: 11 2495..2993: 10 2994..3492: 13 3493..3991: 13 3992..4490: 5 4491..4989: 10 4990..5488: 19 5489..5987: 9 5988..6486: 10 6487..6985: 12 6986..7484: 17 7485..7983: 16 7984..8482: 16 8483..8981: 16 8982..9480: 16 9481..9979: 12 +++ Stats for string_of len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 363.14, stddev: 1245.80, median 9, min 0, max 9986 0.. 499: ####################################################### 4270 500.. 999: ###### 493 1000.. 1499: 16 1500.. 1999: 11 2000.. 2499: 15 2500.. 2999: 17 3000.. 3499: 11 3500.. 3999: 19 4000.. 4499: 14 4500.. 4999: 10 5000.. 5499: 16 5500.. 5999: 11 6000.. 6499: 15 6500.. 6999: 13 7000.. 7499: 12 7500.. 7999: 16 8000.. 8499: 11 8500.. 8999: 4 9000.. 9499: 13 9500.. 9999: 13 +++ Stats for printable_string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 384.53, stddev: 1330.61, median 9, min 0, max 9969 0.. 498: ####################################################### 4246 499.. 997: ###### 518 998..1496: 21 1497..1995: 10 1996..2494: 11 2495..2993: 10 2994..3492: 13 3493..3991: 13 3992..4490: 5 4491..4989: 10 4990..5488: 19 5489..5987: 9 5988..6486: 10 6487..6985: 12 6986..7484: 17 7485..7983: 16 7984..8482: 16 8483..8981: 16 8982..9480: 16 9481..9979: 12 +++ Stats for small_string len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 15.57, stddev: 24.36, median 6, min 0, max 99 0.. 4: #################################################### 1925 5.. 9: ####################################################### 2005 10.. 14: # 52 15.. 19: # 50 20.. 24: # 55 25.. 29: # 56 30.. 34: # 55 35.. 39: # 49 40.. 44: # 65 45.. 49: # 65 50.. 54: # 55 55.. 59: # 68 60.. 64: # 61 65.. 69: # 65 70.. 74: # 57 75.. 79: # 66 80.. 84: # 65 85.. 89: # 64 90.. 94: # 60 95.. 99: # 62 +++ Stats for list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 400.16, stddev: 1371.90, median 9, min 0, max 9987 0.. 499: ####################################################### 4246 500.. 999: ###### 502 1000.. 1499: 13 1500.. 1999: 10 2000.. 2499: 14 2500.. 2999: 14 3000.. 3499: 20 3500.. 3999: 7 4000.. 4499: 13 4500.. 4999: 16 5000.. 5499: 12 5500.. 5999: 15 6000.. 6499: 15 6500.. 6999: 13 7000.. 7499: 16 7500.. 7999: 12 8000.. 8499: 11 8500.. 8999: 16 9000.. 9499: 15 9500.. 9999: 20 +++ Stats for small_list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 16.14, stddev: 24.86, median 6, min 0, max 99 0.. 4: ###################################################### 1923 5.. 9: ####################################################### 1936 10.. 14: # 61 15.. 19: # 59 20.. 24: # 62 25.. 29: # 70 30.. 34: # 61 35.. 39: # 64 40.. 44: # 64 45.. 49: # 56 50.. 54: # 65 55.. 59: # 55 60.. 64: # 60 65.. 69: # 62 70.. 74: # 57 75.. 79: # 69 80.. 84: ## 73 85.. 89: # 67 90.. 94: # 62 95.. 99: ## 74 +++ Stats for list_of_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 7.49, stddev: 1.71, median 8, min 5, max 10 5: ####################################################### 867 6: ################################################### 813 7: ################################################### 815 8: #################################################### 833 9: ###################################################### 857 10: ################################################### 815 +++ Stats for list_repeat len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 42.00, stddev: 0.00, median 42, min 42, max 42 42: ####################################################### 5000 +++ Stats for array len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 400.16, stddev: 1371.90, median 9, min 0, max 9987 0.. 499: ####################################################### 4246 500.. 999: ###### 502 1000.. 1499: 13 1500.. 1999: 10 2000.. 2499: 14 2500.. 2999: 14 3000.. 3499: 20 3500.. 3999: 7 4000.. 4499: 13 4500.. 4999: 16 5000.. 5499: 12 5500.. 5999: 15 6000.. 6499: 15 6500.. 6999: 13 7000.. 7499: 16 7500.. 7999: 12 8000.. 8499: 11 8500.. 8999: 16 9000.. 9499: 15 9500.. 9999: 20 +++ Stats for small_array len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 16.14, stddev: 24.86, median 6, min 0, max 99 0.. 4: ###################################################### 1923 5.. 9: ####################################################### 1936 10.. 14: # 61 15.. 19: # 59 20.. 24: # 62 25.. 29: # 70 30.. 34: # 61 35.. 39: # 64 40.. 44: # 64 45.. 49: # 56 50.. 54: # 65 55.. 59: # 55 60.. 64: # 60 65.. 69: # 62 70.. 74: # 57 75.. 79: # 69 80.. 84: ## 73 85.. 89: # 67 90.. 94: # 62 95.. 99: ## 74 +++ Stats for array_of_size len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 7.49, stddev: 1.71, median 8, min 5, max 10 5: ####################################################### 867 6: ################################################### 813 7: ################################################### 815 8: #################################################### 833 9: ###################################################### 857 10: ################################################### 815 +++ Stats for array_repeat len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: num: 5000, avg: 42.00, stddev: 0.00, median 42, min 42, max 42 42: ####################################################### 5000 +++ Stats for int_stats_neg ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 5000, avg: 0.17, stddev: 29.68, median 0, min -99, max 99 -99..-90: # 65 -89..-80: # 63 -79..-70: # 64 -69..-60: # 58 -59..-50: # 67 -49..-40: # 72 -39..-30: # 61 -29..-20: # 61 -19..-10: # 67 -9.. 0: ####################################################### 2076 1.. 10: ############################################## 1764 11.. 20: # 66 21.. 30: # 64 31.. 40: # 64 41.. 50: # 67 51.. 60: # 60 61.. 70: # 75 71.. 80: # 60 81.. 90: # 60 91..100: # 66 +++ Stats for small_signed_int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 0.90, stddev: 28.23, median 0, min -99, max 99 -99..-90: # 12 -89..-80: # 11 -79..-70: # 9 -69..-60: 6 -59..-50: # 11 -49..-40: # 13 -39..-30: # 9 -29..-20: # 13 -19..-10: 8 -9.. 0: ####################################################### 453 1.. 10: ######################################### 340 11.. 20: # 15 21.. 30: # 11 31.. 40: # 12 41.. 50: # 13 51.. 60: # 13 61.. 70: # 16 71.. 80: # 9 81.. 90: # 16 91..100: # 10 +++ Stats for small_nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 15.11, stddev: 23.27, median 6, min 0, max 99 0.. 4: #################################################### 377 5.. 9: ####################################################### 392 10.. 14: ## 20 15.. 19: ## 15 20.. 24: # 11 25.. 29: ## 17 30.. 34: ## 19 35.. 39: ## 17 40.. 44: # 10 45.. 49: # 9 50.. 54: # 8 55.. 59: # 9 60.. 64: ## 15 65.. 69: # 10 70.. 74: # 13 75.. 79: ## 19 80.. 84: # 11 85.. 89: # 13 90.. 94: 5 95.. 99: # 10 +++ Stats for nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 363.02, stddev: 1215.04, median 9, min 0, max 9476 0.. 473: ####################################################### 847 474.. 947: ###### 95 948..1421: 14 1422..1895: 3 1896..2369: 0 2370..2843: 3 2844..3317: 2 3318..3791: 3 3792..4265: 2 4266..4739: 4 4740..5213: 3 5214..5687: 4 5688..6161: 3 6162..6635: 4 6636..7109: 1 7110..7583: 4 7584..8057: 2 8058..8531: 1 8532..9005: 1 9006..9479: 4 +++ Stats for int_range (-43643) 435434 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 195335.64, stddev: 136803.99, median 195583, min -43624, max 435210 -43624..-19683: ############################################ 52 -19682.. 4259: ######################################## 47 4260.. 28201: ############################## 36 28202.. 52143: ############################################ 52 52144.. 76085: ########################################## 50 76086..100027: ####################################################### 64 100028..123969: ############################################### 55 123970..147911: ######################################## 47 147912..171853: ############################################## 54 171854..195795: #################################### 43 195796..219737: ############################################## 54 219738..243679: ########################################### 51 243680..267621: ################################################ 57 267622..291563: ########################################## 49 291564..315505: #################################### 42 315506..339447: ###################################### 45 339448..363389: ################################################ 57 363390..387331: ###################################### 45 387332..411273: ########################################## 49 411274..435215: ########################################### 51 +++ Stats for int_range (-40000) 40000 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: -173.78, stddev: 23042.92, median 180, min -39859, max 39942 -39859..-35869: ############################################# 56 -35868..-31878: ################################### 43 -31877..-27887: ################################################# 60 -27886..-23896: ##################################### 46 -23895..-19905: ######################################## 49 -19904..-15914: #################################### 45 -15913..-11923: ############################################ 54 -11922.. -7932: ############################################### 58 -7931.. -3941: ######################################### 51 -3940.. 50: ############################ 35 51.. 4041: ####################################### 48 4042.. 8032: ########################################## 52 8033.. 12023: ######################################### 51 12024.. 16014: ########################################### 53 16015.. 20005: ############################################ 54 20006.. 23996: ################################## 42 23997.. 27987: ####################################################### 67 27988.. 31978: ################################ 40 31979.. 35969: ######################################### 51 35970.. 39960: #################################### 45 +++ Stats for int_range (-4) 4 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 0.02, stddev: 2.55, median 0, min -4, max 4 -4: ############################################ 99 -3: ##################################################### 118 -2: ################################################## 111 -1: ################################################## 113 0: ################################################## 113 1: ##################################################### 118 2: ############################################# 102 3: ####################################################### 122 4: ############################################## 104 +++ Stats for int_range (-4) 17 dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 6.67, stddev: 6.39, median 7, min -4, max 17 -4..-3: ############################################# 90 -2..-1: ############################################# 91 0.. 1: ########################################## 84 2.. 3: ############################################## 92 4.. 5: ########################################### 87 6.. 7: ########################################### 86 8.. 9: ############################################ 89 10..11: ########################################### 87 12..13: ####################################################### 110 14..15: ############################################# 91 16..17: ############################################## 93 18..19: 0 20..21: 0 22..23: 0 24..25: 0 26..27: 0 28..29: 0 30..31: 0 32..33: 0 34..35: 0 +++ Stats for int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 100000, avg: 2541076923587387.50, stddev: 2660730801206827008.00, median 158655268318060, min -4611522359435274428, max 4611540922436307689 -4611522359435274428..-4150369195341695293: ##################################################### 4976 -4150369195341695292..-3689216031248116157: ##################################################### 4963 -3689216031248116156..-3228062867154537021: ###################################################### 5038 -3228062867154537020..-2766909703060957885: ##################################################### 4979 -2766909703060957884..-2305756538967378749: ##################################################### 5001 -2305756538967378748..-1844603374873799613: ##################################################### 4982 -1844603374873799612..-1383450210780220477: ##################################################### 5025 -1383450210780220476.. -922297046686641341: #################################################### 4901 -922297046686641340.. -461143882593062205: ####################################################### 5126 -461143882593062204.. 9281500516931: ##################################################### 5008 9281500516932.. 461162445594096067: ###################################################### 5041 461162445594096068.. 922315609687675203: ##################################################### 5001 922315609687675204.. 1383468773781254339: ##################################################### 4986 1383468773781254340.. 1844621937874833475: ##################################################### 4949 1844621937874833476.. 2305775101968412611: ##################################################### 5025 2305775101968412612.. 2766928266061991747: ##################################################### 5022 2766928266061991748.. 3228081430155570883: ##################################################### 4958 3228081430155570884.. 3689234594249150019: ##################################################### 4998 3689234594249150020.. 4150387758342729155: ##################################################### 4982 4150387758342729156.. 4611540922436308291: ###################################################### 5039 +++ Stats for oneof int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: 4611686018427388.00, stddev: 2905870896563567616.00, median 0, min -4611686018427387904, max 4611686018427387903 -4611686018427387904..-4150517416584649089: ################## 208 -4150517416584649088..-3689348814741910273: 0 -3689348814741910272..-3228180212899171457: 0 -3228180212899171456..-2767011611056432641: 0 -2767011611056432640..-2305843009213693825: 0 -2305843009213693824..-1844674407370955009: 0 -1844674407370955008..-1383505805528216193: 0 -1383505805528216192.. -922337203685477377: 0 -922337203685477376.. -461168601842738561: 0 -461168601842738560.. 255: ####################################################### 603 256.. 461168601842739071: 0 461168601842739072.. 922337203685477887: 0 922337203685477888.. 1383505805528216703: 0 1383505805528216704.. 1844674407370955519: 0 1844674407370955520.. 2305843009213694335: 0 2305843009213694336.. 2767011611056433151: 0 2767011611056433152.. 3228180212899171967: 0 3228180212899171968.. 3689348814741910783: 0 3689348814741910784.. 4150517416584649599: 0 4150517416584649600.. 4611686018427387903: ################# 189 ================================================================================ 1 warning(s) failure (26 tests failed, 1 tests errored, ran 73 tests) random seed: 153870556 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats dist: num: 1000, avg: -55083208105414400.00, stddev: 1847115855773139200.00, median 9, min -4590718933436425025, max 4611686018427387903 -4590718933436425025..-4130598685843234370: ## 26 -4130598685843234369..-3670478438250043714: # 13 -3670478438250043713..-3210358190656853058: ### 37 -3210358190656853057..-2750237943063662402: ### 30 -2750237943063662401..-2290117695470471746: ## 27 -2290117695470471745..-1829997447877281090: ## 24 -1829997447877281089..-1369877200284090434: ## 27 -1369877200284090433.. -909756952690899778: ## 27 -909756952690899777.. -449636705097709122: ## 21 -449636705097709121.. 10483542495481534: ####################################################### 531 10483542495481535.. 470603790088672190: ## 21 470603790088672191.. 930724037681862846: ## 27 930724037681862847.. 1390844285275053502: ## 24 1390844285275053503.. 1850964532868244158: ## 25 1850964532868244159.. 2311084780461434814: ## 28 2311084780461434815.. 2771205028054625470: ## 23 2771205028054625471.. 3231325275647816126: ## 23 3231325275647816127.. 3691445523241006782: ## 25 3691445523241006783.. 4151565770834197438: # 17 4151565770834197439.. 4611686018427387903: ## 24 ================================================================================ success (ran 1 tests) qcheck-0.18.1/test/core/test.ml000066400000000000000000000123201417677125000162670ustar00rootroot00000000000000open QCheck2 module Shrink = struct let test_int_towards () = Alcotest.(check' (list int)) ~msg:"int_towards 0 100" ~actual:(Shrink.int_towards 0 100 |> List.of_seq) ~expected:[0; 50; 75; 88; 94; 97; 99]; Alcotest.(check' (list int)) ~msg:"int_towards 500 1000" ~actual:(Shrink.int_towards 500 1000 |> List.of_seq) ~expected:[500; 750; 875; 938; 969; 985; 993; 997; 999]; Alcotest.(check' (list int)) ~msg:"int_towards (-50) (-26)" ~actual:(Shrink.int_towards (-50) (-26) |> List.of_seq) ~expected:[-50; -38; -32; -29; -28; -27] let test_int32_towards () = Alcotest.(check' (list int32)) ~msg:"int32_towards 0l 100l" ~actual:(Shrink.int32_towards 0l 100l |> List.of_seq) ~expected:[0l; 50l; 75l; 88l; 94l; 97l; 99l]; Alcotest.(check' (list int32)) ~msg:"int32_towards 500l 1000l" ~actual:(Shrink.int32_towards 500l 1000l |> List.of_seq) ~expected:[500l; 750l; 875l; 938l; 969l; 985l; 993l; 997l; 999l]; Alcotest.(check' (list int32)) ~msg:"int32_towards (-50l) (-26l)" ~actual:(Shrink.int32_towards (-50l) (-26l) |> List.of_seq) ~expected:[-50l; -38l; -32l; -29l; -28l; -27l] let test_int64_towards () = Alcotest.(check' (list int64)) ~msg:"int64_towards 0L 100L" ~actual:(Shrink.int64_towards 0L 100L |> List.of_seq) ~expected:[0L; 50L; 75L; 88L; 94L; 97L; 99L]; Alcotest.(check' (list int64)) ~msg:"int64_towards 500L 1000L" ~actual:(Shrink.int64_towards 500L 1000L |> List.of_seq) ~expected:[500L; 750L; 875L; 938L; 969L; 985L; 993L; 997L; 999L]; Alcotest.(check' (list int64)) ~msg:"int64_towards (-50L) (-26L)" ~actual:(Shrink.int64_towards (-50L) (-26L) |> List.of_seq) ~expected:[-50L; -38L; -32L; -29L; -28L; -27L] let test_float_towards () = Alcotest.(check' (list (float 0.0001))) ~msg:"float_towards 0. 100." ~actual:(Shrink.float_towards 0. 100. |> List.of_seq) ~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]; Alcotest.(check' (list (float 0.001))) ~msg:"float_towards 500. 1000." ~actual:(Shrink.float_towards 500. 1000. |> List.of_seq) ~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]; Alcotest.(check' (list (float 0.0001))) ~msg:"float_towards (-50.) (-26.)" ~actual:(Shrink.float_towards (-50.) (-26.) |> List.of_seq) ~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] let tests = ("Shrink", Alcotest.[ test_case "int_towards" `Quick test_int_towards; test_case "int32_towards" `Quick test_int32_towards; test_case "int64_towards" `Quick test_int64_towards; test_case "float_towards" `Quick test_float_towards ]) end module Gen = struct let test_gen_opt ~ratio = let opt_int = Gen.opt ?ratio Gen.int in let nb = ref 0 in for _i = 0 to 1000 do Gen.generate1 opt_int |> function None -> () | Some _ -> nb := !nb + 1 done; !nb let test_gen_opt_default () = let nb = test_gen_opt ~ratio:None in let b = nb > 800 && nb < 900 in Alcotest.(check bool) "Gen.opt produces around 85% of Some" b true let test_gen_opt_custom () = let nb = test_gen_opt ~ratio:(Some 0.5) in let b = nb > 450 && nb < 550 in Alcotest.(check bool) "Gen.opt produces around 50% of Some" b true let tests = ("Gen", Alcotest.[ test_case "opt with default ratio" `Quick test_gen_opt_default; test_case "opt with custom ratio" `Quick test_gen_opt_custom; ]) end module Test = struct let test_count_n ?count expected = let t = QCheck2.(Test.make ?count Gen.int (fun _ -> true)) in let msg = Printf.sprintf "QCheck2.Test.make ~count:%s |> get_count = %d" (Option.fold ~none:"None" ~some:string_of_int count) expected in Alcotest.(check int) msg expected (QCheck2.Test.test_get_count t) let test_count_10 () = test_count_n ~count:10 10 let test_count_0 () = test_count_n ~count:0 0 let test_count_default () = test_count_n 100 let test_count_env () = let () = Unix.putenv "QCHECK_COUNT" "5" in let t = QCheck2.(Test.make Gen.int (fun _ -> true)) in let actual = QCheck2.Test.test_get_count t in Alcotest.(check int) "default count is from QCHECK_COUNT" 5 actual let tests = ("Test", Alcotest.[ test_case "make with custom count" `Quick test_count_10; test_case "make with custom count" `Quick test_count_0; test_case "make with default count" `Quick test_count_default; test_case "make with env count" `Quick test_count_env; ]) end module String = struct let test_string_shrinking () = let shrink_result = QCheck2.(find_example_gen ~f:(fun s -> s <> s ^ s) Gen.string) in Alcotest.(check string) "Shrinking a non-empty string shrinks to \"a\"" "a" shrink_result let tests = ("String", Alcotest.[test_case "shrinking" `Quick test_string_shrinking]) end let () = Alcotest.run "QCheck" [ Shrink.tests; Gen.tests; Test.tests; String.tests ]