Hello community, here is the log from the commit of package ocaml-qcheck for openSUSE:Factory checked in at 2020-08-24 15:07:04 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ocaml-qcheck (Old) and /work/SRC/openSUSE:Factory/.ocaml-qcheck.new.3399 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-qcheck" Mon Aug 24 15:07:04 2020 rev:6 rq:828691 version:0.14 Changes: -------- --- /work/SRC/openSUSE:Factory/ocaml-qcheck/ocaml-qcheck.changes 2020-03-09 15:22:53.144184425 +0100 +++ /work/SRC/openSUSE:Factory/.ocaml-qcheck.new.3399/ocaml-qcheck.changes 2020-08-24 15:08:17.978546009 +0200 @@ -1,0 +2,6 @@ +Thu Aug 20 20:20:20 UTC 2020 - [email protected] + +- Update to version 0.14 + See included CHANGELOG.md for details + +------------------------------------------------------------------- Old: ---- ocaml-qcheck-0.10.tar.xz New: ---- ocaml-qcheck-0.14.tar.xz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ocaml-qcheck.spec ++++++ --- /var/tmp/diff_new_pack.kiYrZI/_old 2020-08-24 15:08:24.818549342 +0200 +++ /var/tmp/diff_new_pack.kiYrZI/_new 2020-08-24 15:08:24.822549344 +0200 @@ -1,7 +1,7 @@ # # spec file for package ocaml-qcheck # -# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2020 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,21 +19,21 @@ %bcond_with ocaml_alcotest Name: ocaml-qcheck -Version: 0.10 +Version: 0.14 Release: 0 %{?ocaml_preserve_bytecode} Summary: QuickCheck inspired property-based testing for OCaml License: BSD-2-Clause Group: Development/Languages/OCaml -URL: https://github.com/c-cube/qcheck +URL: https://opam.ocaml.org/packages/qcheck Source0: %{name}-%{version}.tar.xz BuildRequires: ocaml BuildRequires: ocaml-dune -BuildRequires: ocaml-rpm-macros >= 20200220 +BuildRequires: ocaml-rpm-macros >= 20200514 BuildRequires: ocamlfind(bytes) -BuildRequires: ocamlfind(oUnit) +BuildRequires: ocamlfind(ounit2) BuildRequires: ocamlfind(unix) %if %{with ocaml_alcotest} BuildRequires: ocamlfind(alcotest) ++++++ _service ++++++ --- /var/tmp/diff_new_pack.kiYrZI/_old 2020-08-24 15:08:24.854549360 +0200 +++ /var/tmp/diff_new_pack.kiYrZI/_new 2020-08-24 15:08:24.854549360 +0200 @@ -1,10 +1,13 @@ <services> <service name="tar_scm" mode="disabled"> - <param name="url">https://github.com/c-cube/qcheck.git</param> - <param name="scm">git</param> - <param name="versionformat">0.10</param> - <param name="revision">0.10</param> <param name="filename">ocaml-qcheck</param> + <param name="revision">6a170e34269164d45aba6303dff1c77cfb8b8fd0</param> + <param name="scm">git</param> + <param name="submodules">disable</param> + <param name="url">https://github.com/c-cube/qcheck.git</param> + <param name="versionformat">@PARENT_TAG@</param> + <param name="versionrewrite-pattern">[v]?([^\+]+)(.*)</param> + <param name="versionrewrite-replacement">\1</param> </service> <service name="recompress" mode="disabled"> <param name="file">*.tar</param> ++++++ ocaml-qcheck-0.10.tar.xz -> ocaml-qcheck-0.14.tar.xz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/.travis.yml new/ocaml-qcheck-0.14/.travis.yml --- old/ocaml-qcheck-0.10/.travis.yml 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/.travis.yml 2020-07-30 15:34:18.000000000 +0200 @@ -7,9 +7,14 @@ global: - PINS="qcheck:. qcheck-core:. qcheck-ounit:. qcheck-alcotest:." - DISTRO="ubuntu-16.04" + - PACKAGE="qcheck" + - DEPOPTS="ounit alcotest" matrix: - - PACKAGE="qcheck" OCAML_VERSION="4.03.0" DEPOPTS="ounit alcotest" - - PACKAGE="qcheck" OCAML_VERSION="4.04.2" DEPOPTS="ounit alcotest" - - PACKAGE="qcheck" OCAML_VERSION="4.05.0" DEPOPTS="ounit alcotest" - - PACKAGE="qcheck" OCAML_VERSION="4.06.0" DEPOPTS="ounit alcotest" - - PACKAGE="qcheck" OCAML_VERSION="4.07.0" DEPOPTS="ounit alcotest" + - OCAML_VERSION="4.03" + - OCAML_VERSION="4.04" + - OCAML_VERSION="4.05" + - OCAML_VERSION="4.06" + - OCAML_VERSION="4.07" + - OCAML_VERSION="4.08" + - OCAML_VERSION="4.09" + - OCAML_VERSION="4.10" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/CHANGELOG.md new/ocaml-qcheck-0.14/CHANGELOG.md --- old/ocaml-qcheck-0.10/CHANGELOG.md 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/CHANGELOG.md 2020-07-30 15:34:18.000000000 +0200 @@ -1,5 +1,34 @@ # Changes +## 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/Makefile new/ocaml-qcheck-0.14/Makefile --- old/ocaml-qcheck-0.10/Makefile 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/Makefile 2020-07-30 15:34:18.000000000 +0200 @@ -20,7 +20,7 @@ @dune exec example/ounit/QCheck_ounit_test.exe example-runner: - @dune exec example/QCheck_runner_test.exe + @dune exec example/QCheck_runner_test.exe -- --debug-shrink=log.tmp example-alcotest: @dune exec example/alcotest/QCheck_alcotest_test.exe @@ -35,7 +35,7 @@ release: update_next_tag @echo "release version $(VERSION)..." git tag -f $(VERSION) ; git push origin :$(VERSION) ; git push origin $(VERSION) - opam publish prepare https://github.com/c-cube/qcheck/archive/$(VERSION).tar.gz + opam publish https://github.com/c-cube/qcheck/archive/$(VERSION).tar.gz @echo "review the release, then type 'opam publish submit qcheck.$(VERSION)/'" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/README.adoc new/ocaml-qcheck-0.14/README.adoc --- old/ocaml-qcheck-0.10/README.adoc 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/README.adoc 2020-07-30 15:34:18.000000000 +0200 @@ -293,7 +293,7 @@ === Integration within OUnit -http://ounit.forge.ocamlcore.org/[OUnit] is a popular unit-testing framework +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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/dune-project new/ocaml-qcheck-0.14/dune-project --- old/ocaml-qcheck-0.10/dune-project 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/dune-project 2020-07-30 15:34:18.000000000 +0200 @@ -1 +1,2 @@ (lang dune 1.0) +(name qcheck) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/qcheck-alcotest.opam new/ocaml-qcheck-0.14/qcheck-alcotest.opam --- old/ocaml-qcheck-0.10/qcheck-alcotest.opam 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/qcheck-alcotest.opam 2020-07-30 15:34:18.000000000 +0200 @@ -4,24 +4,23 @@ homepage: "https://github.com/c-cube/qcheck/"; synopsis: "Alcotest backend for qcheck" doc: ["http://c-cube.github.io/qcheck/";] -version: "0.10" +version: "0.14" tags: [ "test" - "property" "quickcheck" + "qcheck" + "alcotest" ] build: [ ["dune" "build" "-p" name "-j" jobs] - ["dune" "build" "@doc" "-p" name] {with-doc} -] -run-test: [ - ["dune" "runtest" "-p" name] + ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} + ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "dune" "base-bytes" "base-unix" - "qcheck-core" { >= "0.9" } + "qcheck-core" { = version } "alcotest" "odoc" {with-doc} "ocaml" {>= "4.03.0"} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/qcheck-core.opam new/ocaml-qcheck-0.14/qcheck-core.opam --- old/ocaml-qcheck-0.10/qcheck-core.opam 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/qcheck-core.opam 2020-07-30 15:34:18.000000000 +0200 @@ -4,7 +4,7 @@ homepage: "https://github.com/c-cube/qcheck/"; synopsis: "Core qcheck library" doc: ["http://c-cube.github.io/qcheck/";] -version: "0.10" +version: "0.14" tags: [ "test" "property" @@ -12,10 +12,8 @@ ] build: [ ["dune" "build" "-p" name "-j" jobs] - ["dune" "build" "@doc" "-p" name] {with-doc} -] -run-test: [ - ["dune" "runtest" "-p" name] + ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} + ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "dune" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/qcheck-ounit.opam new/ocaml-qcheck-0.14/qcheck-ounit.opam --- old/ocaml-qcheck-0.10/qcheck-ounit.opam 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/qcheck-ounit.opam 2020-07-30 15:34:18.000000000 +0200 @@ -4,25 +4,23 @@ homepage: "https://github.com/c-cube/qcheck/"; doc: ["http://c-cube.github.io/qcheck/";] synopsis: "OUnit backend for qcheck" -version: "0.10" +version: "0.14" tags: [ - "test" - "property" + "qcheck" "quickcheck" + "ounit" ] build: [ ["dune" "build" "-p" name "-j" jobs] - ["dune" "build" "@doc" "-p" name] {with-doc} -] -run-test: [ - ["dune" "runtest" "-p" name] + ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} + ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "dune" "base-bytes" "base-unix" - "qcheck-core" { >= "0.9" } - "ounit" {>= "2.0"} + "qcheck-core" { = version } + "ounit2" "odoc" {with-doc} "ocaml" {>= "4.03.0"} ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/qcheck.opam new/ocaml-qcheck-0.14/qcheck.opam --- old/ocaml-qcheck-0.10/qcheck.opam 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/qcheck.opam 2020-07-30 15:34:18.000000000 +0200 @@ -4,7 +4,7 @@ synopsis: "Compatibility package for qcheck" homepage: "https://github.com/c-cube/qcheck/"; doc: ["http://c-cube.github.io/qcheck/";] -version: "0.10" +version: "0.14" tags: [ "test" "property" @@ -12,17 +12,15 @@ ] build: [ ["dune" "build" "-p" name "-j" jobs] - ["dune" "build" "@doc" "-p" name] {with-doc} -] -run-test: [ - ["dune" "runtest" "-p" name] + ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} + ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "dune" "base-bytes" "base-unix" - "qcheck-core" { >= "0.9" } - "qcheck-ounit" { >= "0.9" } + "qcheck-core" { = version } + "qcheck-ounit" { = version } "odoc" {with-doc} "ocaml" {>= "4.03.0"} ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/src/core/QCheck.ml new/ocaml-qcheck-0.14/src/core/QCheck.ml --- old/ocaml-qcheck-0.10/src/core/QCheck.ml 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/src/core/QCheck.ml 2020-07-30 15:34:18.000000000 +0200 @@ -1,4 +1,3 @@ - (* QCheck: Random testing for OCaml copyright (c) 2013-2017, Guillaume Bury, Simon Cruanes, Vincent Hugot, Jan Midtgaard @@ -7,6 +6,7 @@ (** {1 Quickcheck inspired property-based testing} *) +let poly_compare=compare open Printf module RS = Random.State @@ -75,7 +75,8 @@ 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 = map 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)) @@ -122,6 +123,20 @@ 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 f st = @@ -142,12 +157,22 @@ 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"; - fun st -> - let r = pint st in - r mod (n+1) + 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"; - fun st -> a + (int_bound (b-a) st) + if a >= 0 || b <= 0 then (* range smaller than max_int *) + 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) /. (float_of_int b -. f_a) in + if Random.float 1. < ratio then - (int_bound a st) + else int_bound b st + let (--) = int_range (* NOTE: we keep this alias to not break code that uses [small_int] @@ -159,6 +184,8 @@ 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 @@ -182,6 +209,17 @@ 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 @@ -195,6 +233,14 @@ 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 pair g1 g2 st = (g1 st, g2 st) let triple g1 g2 g3 st = (g1 st, g2 st, g3 st) @@ -222,6 +268,8 @@ 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_readable = string_size ~gen:char 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 @@ -345,6 +393,24 @@ 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 = @@ -397,7 +463,7 @@ let list_spine l yield = let n = List.length l in - let chunk_size = ref (n/2) 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 @@ -614,6 +680,14 @@ 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) @@ -625,8 +699,12 @@ let small_int_corners () = make_int (Gen.nng_corners ()) let neg_int = make_int Gen.neg_int -let int32 = make_scalar ~print:(fun i -> Int32.to_string i ^ "l") Gen.ui32 -let int64 = make_scalar ~print:(fun i -> Int64.to_string i ^ "L") Gen.ui64 +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 @@ -1135,7 +1213,7 @@ (* all counter-examples in [l] have same size according to [small], so we just compare to the first one, and we enforce the invariant *) - begin match Pervasives.compare (small instance) (small c_ex'.instance) with + begin match poly_compare (small instance) (small c_ex'.instance) with | 0 -> res.state <- Failed {instances=c_ex :: l} (* same size: add [c_ex] to [l] *) | n when n<0 -> res.state <- Failed {instances=[c_ex]} (* drop [l] *) | _ -> () (* drop [c_ex], not small enough *) @@ -1538,7 +1616,7 @@ 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,_) -> compare i j) + |> List.sort (fun (i,_) (j,_) -> poly_compare i j) |> List.iter (fun (i,cnt) -> if !median_num < !num/2 then ( diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/src/core/QCheck.mli new/ocaml-qcheck-0.14/src/core/QCheck.mli --- old/ocaml-qcheck-0.10/src/core/QCheck.mli 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/src/core/QCheck.mli 2020-07-30 15:34:18.000000000 +0200 @@ -163,6 +163,10 @@ 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. *) @@ -190,27 +194,67 @@ val shuffle_l : 'a list -> 'a list t (** Creates a generator of shuffled lists. *) - val unit: unit t (** The unit generator. *) + 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 bool: bool t (** The boolean generator. *) + val unit : unit t (** The unit generator. *) - val float: float t (** Generates floating point numbers. *) + 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 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 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_nat : int t + (** Small integers (< 100) + @since 0.5.1 *) val small_int : int t (** Small UNSIGNED integers, for retrocompatibility. @@ -222,11 +266,12 @@ 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] or if the range is larger than [max_int]. *) + @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 @@ -271,21 +316,39 @@ 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 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 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}). *) + 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 {!char} character generator. + @since 0.11 *) val small_string : ?gen:char t -> string t (** Builds a string generator, length is {!small_nat} @@ -295,6 +358,22 @@ (** 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 *) @@ -446,6 +525,12 @@ 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 @@ -563,7 +648,7 @@ {b NOTE} the collect field is unstable and might be removed, or moved into {!Test}. - Made private @since 0.8 + Made private since 0.8 *) val make : @@ -619,8 +704,12 @@ module TestResult : sig 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 *) + + msg_l: string list; + (** messages. + @since 0.7 *) } type 'a failed_state = 'a counter_ex list @@ -738,7 +827,7 @@ See {!make_cell} for a description of the parameters. *) - (** {6 Running the test} *) + (** {3 Running the test} *) exception Test_fail of string * string list (** Exception raised when a test failed, with the list of counter-examples. @@ -870,7 +959,7 @@ @raise No_example_found if no example was found within [count] tries. @since 0.6 *) -(** {2 Combinators for {!arbitrary}} *) +(** {2 Combinators for arbitrary} *) val choose : 'a arbitrary list -> 'a arbitrary (** Choose among the given list of generators. The list must not @@ -892,6 +981,22 @@ 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. *) @@ -1016,15 +1121,19 @@ - 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 + + 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 + renamed from {!fun2} since 0.6 + @deprecated use {!fun_} instead since 0.6 *) type _ fun_repr diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/src/ounit/QCheck_ounit.mli new/ocaml-qcheck-0.14/src/ounit/QCheck_ounit.mli --- old/ocaml-qcheck-0.10/src/ounit/QCheck_ounit.mli 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/src/ounit/QCheck_ounit.mli 2020-07-30 15:34:18.000000000 +0200 @@ -17,7 +17,7 @@ (** Same as {!to_ounit_test} but with a polymorphic test cell *) val (>:::) : string -> QCheck.Test.t list -> OUnit.test -(** Same as {!OUnit.>:::} but with a list of QCheck tests *) +(** Same as [OUnit.(>:::)] but with a list of QCheck tests *) val to_ounit2_test : ?rand:Random.State.t -> QCheck.Test.t -> OUnit2.test (** [to_ounit2_test ?rand t] wraps [t] into a OUnit2 test @@ -54,7 +54,8 @@ This test runner displays execution in a compact way, making it good for suites that have lots of tests. - Output example: {v + Output example: + {v random seed: 101121210 random seed: 101121210 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/src/ounit/dune new/ocaml-qcheck-0.14/src/ounit/dune --- old/ocaml-qcheck-0.10/src/ounit/dune 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/src/ounit/dune 2020-07-30 15:34:18.000000000 +0200 @@ -4,6 +4,6 @@ (public_name qcheck-ounit) (optional) (wrapped false) - (libraries unix bytes qcheck-core qcheck-core.runner oUnit) + (libraries unix bytes qcheck-core qcheck-core.runner ounit2) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) ) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/src/runner/QCheck_base_runner.ml new/ocaml-qcheck-0.14/src/runner/QCheck_base_runner.ml --- old/ocaml-qcheck-0.10/src/runner/QCheck_base_runner.ml 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/src/runner/QCheck_base_runner.ml 2020-07-30 15:34:18.000000000 +0200 @@ -94,6 +94,14 @@ 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; @@ -108,6 +116,8 @@ 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 @@ -165,13 +175,16 @@ ; "--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 <file>" + ; "--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_ () in { cli_verbose=verbose(); cli_long_tests=long_tests(); cli_rand; cli_print_list= !print_list; cli_slow_test= !slow; - cli_colors= !colors; } + cli_colors= !colors; cli_debug_shrink = debug_shrink(); + cli_debug_shrink_list = debug_shrink_list(); } end open Raw @@ -189,30 +202,85 @@ type res = | Res : 'a QCheck.Test.cell * 'a QCheck.TestResult.t -> res +type handler = { + handler : 'a. 'a QCheck.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 handler ~size ~out ~verbose c name _ r = - let st = function - | QCheck.Test.Generating -> "generating" - | QCheck.Test.Collecting _ -> "collecting" - | QCheck.Test.Testing _ -> " testing" - | QCheck.Test.Shrunk (i, _) -> - Printf.sprintf "shrinking: %4d" i - | QCheck.Test.Shrinking (i, j, _) -> - Printf.sprintf "shrinking: %4d.%04d" i j +let debug_shrinking_counter_example cell out x = + match (QCheck.Test.get_arbitrary cell).QCheck.print with + | None -> Printf.fprintf out "<no printer provided>" + | Some print -> Printf.fprintf out "%s" (print x) + +let debug_shrinking_size cell out x = + match (QCheck.Test.get_arbitrary cell).QCheck.small with + | None -> () + | Some f -> Printf.fprintf out ", size %d" (f 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 sucessfully shrunk counter example (step %d%a) to:\n\n%a\n%!" + name i + (debug_shrinking_size cell) x + (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 + | QCheck.Test.Generating -> "generating" + | QCheck.Test.Collecting _ -> "collecting" + | QCheck.Test.Testing _ -> " testing" + | QCheck.Test.Shrunk (i, _) -> + Printf.sprintf "shrinking: %4d" i + | QCheck.Test.Shrinking (i, j, _) -> + Printf.sprintf "shrinking: %4d.%04d" i j + in + (* debug shrinking choices *) + begin match r with + | QCheck.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)%!" + Color.reset_line (pp_counter ~size) c name (st r) + ) in - (* 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)%!" - Color.reset_line (pp_counter ~size) c name (st r) - ) - + { handler; } let step ~size ~out ~verbose c name _ _ r = let aux = function @@ -278,12 +346,14 @@ (Color.pp_str_c ~colors `Yellow) "Warning" (String.make 68 '!') (QCheck.Test.get_name cell) msg) (QCheck.TestResult.warnings r); + + if QCheck.TestResult.stats r <> [] then + Printf.fprintf out + "\n+++ %a %s\n%!" + (Color.pp_str_c ~colors `Blue) ("Stats for " ^ QCheck.Test.get_name cell) + (String.make 56 '+'); List.iter - (fun st -> - Printf.fprintf out - "\n+++ %a %s\n\nStat for test %s:\n\n%s%!" - (Color.pp_str_c ~colors `Blue) "Stat" (String.make 68 '+') - (QCheck.Test.get_name cell) (QCheck.Test.print_stat st)) + (fun st -> Printf.fprintf out "\n%s%!" (QCheck.Test.print_stat st)) (QCheck.TestResult.stats r); () @@ -309,7 +379,10 @@ print_messages ~colors out cell c_ex.QCheck.TestResult.msg_l let run_tests - ?(colors=true) ?(verbose=verbose()) ?(long=long_tests()) ?(out=stdout) ?(rand=random_state()) l = + ?(handler=default_handler) + ?(colors=true) ?(verbose=verbose()) ?(long=long_tests()) + ?(debug_shrink=debug_shrink()) ?(debug_shrink_list=debug_shrink_list()) + ?(out=stdout) ?(rand=random_state()) l = let module T = QCheck.Test in let module R = QCheck.TestResult in let pp_color = Color.pp_str_c ~bold:true ~colors in @@ -331,7 +404,8 @@ Printf.fprintf out "%s[ ] %a %s%!" Color.reset_line (pp_counter ~size) c (T.get_name cell); let r = QCheck.Test.check_cell ~long ~rand - ~handler:(handler ~size ~out ~verbose c) + ~handler:(handler ~colors ~debug_shrink ~debug_shrink_list + ~size ~out ~verbose c).handler ~step:(step ~size ~out ~verbose c) ~call:(callback ~size ~out ~verbose ~colors c) cell diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.10/src/runner/QCheck_base_runner.mli new/ocaml-qcheck-0.14/src/runner/QCheck_base_runner.mli --- old/ocaml-qcheck-0.10/src/runner/QCheck_base_runner.mli 2019-07-15 02:23:27.000000000 +0200 +++ new/ocaml-qcheck-0.14/src/runner/QCheck_base_runner.mli 2020-07-30 15:34:18.000000000 +0200 @@ -58,10 +58,43 @@ (** 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 QCheck.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 -> QCheck.Test.t list -> int (** Run a suite of tests, and print its results. This is an heritage from @@ -82,7 +115,8 @@ - "--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 + function: + {v random seed: 438308050 generated error; fail; pass / total - time -- test name [✓] (1000) 0 ; 0 ; 1000 / 1000 -- 0.5s -- list_rev_is_involutive @@ -164,6 +198,8 @@ 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
