Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ocaml-qcheck for openSUSE:Factory checked in at 2021-04-29 01:37:01 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ocaml-qcheck (Old) and /work/SRC/openSUSE:Factory/.ocaml-qcheck.new.12324 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-qcheck" Thu Apr 29 01:37:01 2021 rev:7 rq:875415 version:0.17 Changes: -------- --- /work/SRC/openSUSE:Factory/ocaml-qcheck/ocaml-qcheck.changes 2020-08-24 15:08:17.978546009 +0200 +++ /work/SRC/openSUSE:Factory/.ocaml-qcheck.new.12324/ocaml-qcheck.changes 2021-04-29 01:37:31.254503642 +0200 @@ -1,0 +2,6 @@ +Thu Jan 21 21:21:21 UTC 2021 - [email protected] + +- Update to version 0.17 + See included CHANGELOG.md for details + +------------------------------------------------------------------- Old: ---- ocaml-qcheck-0.14.tar.xz New: ---- ocaml-qcheck-0.17.tar.xz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ocaml-qcheck.spec ++++++ --- /var/tmp/diff_new_pack.IFk69D/_old 2021-04-29 01:37:31.678504243 +0200 +++ /var/tmp/diff_new_pack.IFk69D/_new 2021-04-29 01:37:31.682504249 +0200 @@ -1,7 +1,7 @@ # # spec file for package ocaml-qcheck # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2021 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %bcond_with ocaml_alcotest Name: ocaml-qcheck -Version: 0.14 +Version: 0.17 Release: 0 %{?ocaml_preserve_bytecode} Summary: QuickCheck inspired property-based testing for OCaml @@ -31,7 +31,7 @@ BuildRequires: ocaml BuildRequires: ocaml-dune -BuildRequires: ocaml-rpm-macros >= 20200514 +BuildRequires: ocaml-rpm-macros >= 20210121 BuildRequires: ocamlfind(bytes) BuildRequires: ocamlfind(ounit2) BuildRequires: ocamlfind(unix) ++++++ _service ++++++ --- /var/tmp/diff_new_pack.IFk69D/_old 2021-04-29 01:37:31.714504294 +0200 +++ /var/tmp/diff_new_pack.IFk69D/_new 2021-04-29 01:37:31.718504300 +0200 @@ -1,7 +1,7 @@ <services> <service name="tar_scm" mode="disabled"> <param name="filename">ocaml-qcheck</param> - <param name="revision">6a170e34269164d45aba6303dff1c77cfb8b8fd0</param> + <param name="revision">6aaef3945ca9ffad312e397fa0d81538763d9abd</param> <param name="scm">git</param> <param name="submodules">disable</param> <param name="url">https://github.com/c-cube/qcheck.git</param> ++++++ ocaml-qcheck-0.14.tar.xz -> ocaml-qcheck-0.17.tar.xz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/.ocamlinit new/ocaml-qcheck-0.17/.ocamlinit --- old/ocaml-qcheck-0.14/.ocamlinit 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/.ocamlinit 1970-01-01 01:00:00.000000000 +0100 @@ -1,2 +0,0 @@ - -module Q = QCheck;; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/.travis.yml new/ocaml-qcheck-0.17/.travis.yml --- old/ocaml-qcheck-0.14/.travis.yml 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/.travis.yml 2021-02-15 22:44:41.000000000 +0100 @@ -10,11 +10,11 @@ - PACKAGE="qcheck" - DEPOPTS="ounit alcotest" matrix: - - 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" + - 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.14/CHANGELOG.md new/ocaml-qcheck-0.17/CHANGELOG.md --- old/ocaml-qcheck-0.14/CHANGELOG.md 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/CHANGELOG.md 2021-02-15 22:44:41.000000000 +0100 @@ -1,5 +1,28 @@ # Changes +## 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`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/Makefile new/ocaml-qcheck-0.17/Makefile --- old/ocaml-qcheck-0.14/Makefile 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/Makefile 2021-02-15 22:44:41.000000000 +0100 @@ -20,7 +20,7 @@ @dune exec example/ounit/QCheck_ounit_test.exe example-runner: - @dune exec example/QCheck_runner_test.exe -- --debug-shrink=log.tmp + @dune exec example/QCheck_runner_test.exe -- -v --debug-shrink=log.tmp example-alcotest: @dune exec example/alcotest/QCheck_alcotest_test.exe @@ -40,10 +40,6 @@ watch: - while find src/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \ - echo "============ at `date` ==========" ; \ - sleep 0.2; \ - make all; \ - done + @dune build @all -w .PHONY: benchs tests examples update_next_tag watch release diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/README.adoc new/ocaml-qcheck-0.17/README.adoc --- old/ocaml-qcheck-0.14/README.adoc 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/README.adoc 2021-02-15 22:44:41.000000000 +0100 @@ -11,9 +11,15 @@ This library spent some time in https://github.com/vincent-hugot/iTeML[qtest], but is now standalone again! -Note that @gasche's -https://github.com/gasche/random-generator/[generator library] -can be useful too, for generating random values. + +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 has http://janmidtgaard.dk/quickcheck/index.html[a lecture] about +property-based testing that relies on QCheck. toc::[] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/example/QCheck_runner_test.ml new/ocaml-qcheck-0.17/example/QCheck_runner_test.ml --- old/ocaml-qcheck-0.14/example/QCheck_runner_test.ml 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/example/QCheck_runner_test.ml 2021-02-15 22:44:41.000000000 +0100 @@ -118,6 +118,16 @@ 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" @@ -157,5 +167,5 @@ stats_negs; bad_assume_warn; bad_assume_fail; - ] @ stats_tests) + ] @ find_ex_uncaught_issue_99 @ stats_tests) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/example/ounit/dune new/ocaml-qcheck-0.17/example/ounit/dune --- old/ocaml-qcheck-0.14/example/ounit/dune 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/example/ounit/dune 2021-02-15 22:44:41.000000000 +0100 @@ -1,5 +1,5 @@ (executables (names QCheck_ounit_test QCheck_test) - (libraries qcheck oUnit qcheck-ounit) + (libraries qcheck ounit2 qcheck-ounit) ) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/qcheck-alcotest.opam new/ocaml-qcheck-0.17/qcheck-alcotest.opam --- old/ocaml-qcheck-0.14/qcheck-alcotest.opam 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/qcheck-alcotest.opam 2021-02-15 22:44:41.000000000 +0100 @@ -4,7 +4,7 @@ homepage: "https://github.com/c-cube/qcheck/"; synopsis: "Alcotest backend for qcheck" doc: ["http://c-cube.github.io/qcheck/";] -version: "0.14" +version: "0.17" tags: [ "test" "quickcheck" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/qcheck-core.opam new/ocaml-qcheck-0.17/qcheck-core.opam --- old/ocaml-qcheck-0.14/qcheck-core.opam 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/qcheck-core.opam 2021-02-15 22:44:41.000000000 +0100 @@ -4,7 +4,7 @@ homepage: "https://github.com/c-cube/qcheck/"; synopsis: "Core qcheck library" doc: ["http://c-cube.github.io/qcheck/";] -version: "0.14" +version: "0.17" tags: [ "test" "property" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/qcheck-ounit.opam new/ocaml-qcheck-0.17/qcheck-ounit.opam --- old/ocaml-qcheck-0.14/qcheck-ounit.opam 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/qcheck-ounit.opam 2021-02-15 22:44:41.000000000 +0100 @@ -4,7 +4,7 @@ homepage: "https://github.com/c-cube/qcheck/"; doc: ["http://c-cube.github.io/qcheck/";] synopsis: "OUnit backend for qcheck" -version: "0.14" +version: "0.17" tags: [ "qcheck" "quickcheck" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/qcheck.opam new/ocaml-qcheck-0.17/qcheck.opam --- old/ocaml-qcheck-0.14/qcheck.opam 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/qcheck.opam 2021-02-15 22:44:41.000000000 +0100 @@ -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.14" +version: "0.17" tags: [ "test" "property" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/alcotest/QCheck_alcotest.ml new/ocaml-qcheck-0.17/src/alcotest/QCheck_alcotest.ml --- old/ocaml-qcheck-0.14/src/alcotest/QCheck_alcotest.ml 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/src/alcotest/QCheck_alcotest.ml 2021-02-15 22:44:41.000000000 +0100 @@ -39,7 +39,7 @@ let print = Raw.print_std in let run() = T.check_cell_exn cell - ~long ~rand ~call:(Raw.callback ~verbose ~print_res:true ~print) + ~long ~rand ~call:(Raw.callback ~colors:false ~verbose ~print_res:true ~print) in let name = T.get_name cell in name, `Slow, run diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/core/QCheck.ml new/ocaml-qcheck-0.17/src/core/QCheck.ml --- old/ocaml-qcheck-0.14/src/core/QCheck.ml 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/src/core/QCheck.ml 2021-02-15 22:44:41.000000000 +0100 @@ -162,16 +162,19 @@ 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 *) + if a >= 0 || b < 0 then ( + (* range smaller than max_int *) + assert (b-a >= 0); fun st -> a + (int_bound (b-a) st) - else + ) 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) + 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 @@ -301,6 +304,15 @@ list_repeat n g rand let generate1 ?(rand=Random.State.make_self_init()) g = g rand + + let delay f st = f () st + + include Qcheck_ops.Make(struct + type nonrec 'a t = 'a t + let (>|=) = (>|=) + let monoid_product a b = map2 (fun x y -> x,y) a b + let (>>=) = (>>=) + end) end module Print = struct @@ -375,6 +387,13 @@ !r let find p iter = find_map (fun x->if p x then Some x else None) iter + + include Qcheck_ops.Make(struct + type nonrec 'a t = 'a t + let (>|=) = (>|=) + let monoid_product a b = map2 (fun x y -> x,y) a b + let (>>=) = (>>=) + end) end module Shrink = struct @@ -1448,11 +1467,25 @@ then the input that caused the failure is returned in [Failed]. If [func input] raises [FailedPrecondition] then the input is discarded, unless max_gen is 0. *) - let rec check_state state = + let rec check_state state : _ R.t = if is_done state then state.res else ( state.handler state.test.name state.test Generating; - let input = new_input state in + match new_input state with + | i -> + check_state_input state i + | 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:\n%s\n%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 = state.handler state.test.name state.test (Collecting input); state.res.R.instances <- input :: state.res.R.instances; collect state input; @@ -1480,7 +1513,6 @@ match res with | CR_continue -> check_state state | CR_yield x -> x - ) type 'a callback = string -> 'a cell -> 'a TestResult.t -> unit @@ -1673,6 +1705,7 @@ (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 = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/core/QCheck.mli new/ocaml-qcheck-0.17/src/core/QCheck.mli --- old/ocaml-qcheck-0.14/src/core/QCheck.mli 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/src/core/QCheck.mli 2021-02-15 22:44:41.000000000 +0100 @@ -422,11 +422,20 @@ *) + 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]. *) + + include Qcheck_ops.S with type 'a t_let := 'a t + (** @since 0.15 *) end (** {2 Pretty printing} *) @@ -503,6 +512,9 @@ val flatten : 'a t t -> 'a t (** @since 0.8 *) + + include Qcheck_ops.S with type 'a t_let := 'a t + (** @since 0.15 *) end (** {2 Shrink Values} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/core/dune new/ocaml-qcheck-0.17/src/core/dune --- old/ocaml-qcheck-0.14/src/core/dune 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/src/core/dune 2021-02-15 22:44:41.000000000 +0100 @@ -6,3 +6,8 @@ (libraries unix bytes) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) ) + +(rule + (targets qcheck_ops.ml) + (deps) + (action (with-stdout-to %{targets} (run ./gen/gen_ops.exe)))) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/core/gen/dune new/ocaml-qcheck-0.17/src/core/gen/dune --- old/ocaml-qcheck-0.14/src/core/gen/dune 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-qcheck-0.17/src/core/gen/dune 2021-02-15 22:44:41.000000000 +0100 @@ -0,0 +1,3 @@ + +(executable + (name gen_ops)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/core/gen/gen_ops.ml new/ocaml-qcheck-0.17/src/core/gen/gen_ops.ml --- old/ocaml-qcheck-0.14/src/core/gen/gen_ops.ml 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-qcheck-0.17/src/core/gen/gen_ops.ml 2021-02-15 22:44:41.000000000 +0100 @@ -0,0 +1,50 @@ + +let shims_let_op_pre_408 = + " + module type S = sig type 'a t_let end + module Make(X:sig type 'a t end) = struct type 'a t_let = 'a X.t end +" +let shims_let_op_post_408 = + " + module type S = sig + type 'a t_let + val (let+) : 'a t_let -> ('a -> 'b) -> 'b t_let + val (and+) : 'a t_let -> 'b t_let -> ('a * 'b) t_let + val (let*) : 'a t_let -> ('a -> 'b t_let) -> 'b t_let + val (and*) : 'a t_let -> 'b t_let -> ('a * 'b) t_let + end + module Make(X:sig + type 'a t + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + val monoid_product : 'a t -> 'b t -> ('a * 'b) t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + end) : S with type 'a t_let = 'a X.t = struct + type 'a t_let = 'a X.t + let (let+) = X.(>|=) + let (and+) = X.monoid_product + let (let*) = X.(>>=) + let (and*) = X.monoid_product +end[@@inline] + +" + +let split_on c s = + let l = ref [] in + let i = ref 0 in + while !i < String.length s do + let j = try String.index_from s !i c with Not_found -> String.length s in + l := String.sub s !i (j- !i) :: !l; + i := j+1; + done; + List.rev !l + +let () = + let maj, min = match split_on '.' Sys.ocaml_version with + | m1 :: m2 :: _ -> int_of_string m1, int_of_string m2 + | _ -> failwith "cannot parse ocaml version" + in + if (maj,min) >= (4,8) then ( + print_endline shims_let_op_post_408 + ) else ( + print_endline shims_let_op_pre_408 + ) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/ounit/QCheck_ounit.ml new/ocaml-qcheck-0.17/src/ounit/QCheck_ounit.ml --- old/ocaml-qcheck-0.14/src/ounit/QCheck_ounit.ml 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/src/ounit/QCheck_ounit.ml 2021-02-15 22:44:41.000000000 +0100 @@ -73,7 +73,7 @@ err = (fun fmt -> logf ctxt `Error fmt); } in T.check_cell_exn cell - ~long ~rand ~call:(Raw.callback ~verbose ~print_res:true ~print)) + ~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) @@ -87,7 +87,7 @@ let run () = try T.check_cell_exn cell ~long ~rand - ~call:(Raw.callback ~verbose ~print_res:verbose ~print:Raw.print_std); + ~call:(Raw.callback ~colors:false ~verbose ~print_res:verbose ~print:Raw.print_std); true with T.Test_fail _ -> false diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/runner/QCheck_base_runner.ml new/ocaml-qcheck-0.17/src/runner/QCheck_base_runner.ml --- old/ocaml-qcheck-0.14/src/runner/QCheck_base_runner.ml 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/src/runner/QCheck_base_runner.ml 2021-02-15 22:44:41.000000000 +0100 @@ -4,10 +4,6 @@ all rights reserved. *) -let ps = print_string -let va = Printf.sprintf -let pf = Printf.printf - module Color = struct let fpf = Printf.fprintf type color = @@ -50,15 +46,13 @@ else output_string out s end -let separator1 = "\027[K" ^ (String.make 79 '\\') -let separator2 = String.make 79 '/' - let seed = ref ~-1 let st = ref None -let set_seed_ s = +let set_seed_ ~colors s = seed := s; - Printf.printf "%srandom seed: %d\n%!" Color.reset_line 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 @@ -72,19 +66,21 @@ let set_time_between_msg f = time_between_msg := f -let set_seed s = ignore (set_seed_ s) +let set_seed s = ignore (set_seed_ ~colors:false s) -let setup_random_state_ () = +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_ s + set_seed_ ~colors s (* initialize random generator from seed (if any) *) -let random_state () = match !st with +let random_state_ ~colors () = match !st with | Some st -> st - | None -> setup_random_state_ () + | None -> setup_random_state_ ~colors () + +let random_state() = random_state_ ~colors:false () let verbose, set_verbose = let r = ref false in @@ -123,13 +119,14 @@ (* 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 ~verbose ~print_res ~print name cell result = + let callback ~colors ~verbose ~print_res ~print name cell result = let module R = QCheck.TestResult in let module T = QCheck.Test in let arb = T.get_arbitrary cell 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" - Color.reset_line name result.R.count result.R.count_gen; + reset_line name result.R.count result.R.count_gen; begin match QCheck.TestResult.collect result with | None -> () | Some tbl -> @@ -141,11 +138,11 @@ match result.R.state with | R.Success -> () | R.Failed {instances=l} -> - print.fail "%s%s\n" Color.reset_line (T.print_fail arb name l); + print.fail "%s%s\n" reset_line (T.print_fail arb name l); | R.Failed_other {msg} -> - print.fail "%s%s\n" Color.reset_line (T.print_fail_other name ~msg); + print.fail "%s%s\n" reset_line (T.print_fail_other name ~msg); | R.Error {instance; exn; backtrace} -> - print.err "%s%s\n" Color.reset_line + print.err "%s%s\n" reset_line (T.print_error ~st:backtrace arb name (instance,exn)); ) @@ -180,7 +177,7 @@ ] ) in Arg.parse_argv argv options (fun _ ->()) "run qtest suite"; - let cli_rand = setup_random_state_ () in + 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(); @@ -277,12 +274,13 @@ 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) + (if colors then Color.reset_line else "\n") + (pp_counter ~size) c name (st r) ) in { handler; } -let step ~size ~out ~verbose c name _ _ r = +let step ~colors ~size ~out ~verbose c name _ _ r = let aux = function | QCheck.Test.Success -> c.passed <- c.passed + 1 | QCheck.Test.Failure -> c.failed <- c.failed + 1 @@ -295,15 +293,15 @@ if verbose && now -. !last_msg > get_time_between_msg () then ( last_msg := now; Printf.fprintf out "%s[ ] %a %s%!" - Color.reset_line (pp_counter ~size) c name + (if colors then Color.reset_line else "\n") (pp_counter ~size) c name ) -let callback ~size ~out ~verbose ~colors c name _ _ = - let pass = c.failed = 0 && c.errored = 0 in +let callback ~size ~out ~verbose ~colors c name _ r = + let pass = QCheck.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%!" - Color.reset_line + (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 ) @@ -382,7 +380,8 @@ ?(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 = + ?(out=stdout) ?rand l = + let rand = match rand with Some x -> x | None -> random_state_ ~colors () in let module T = QCheck.Test in let module R = QCheck.TestResult in let pp_color = Color.pp_str_c ~bold:true ~colors in @@ -394,6 +393,7 @@ (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 = { @@ -402,11 +402,12 @@ } in if verbose then Printf.fprintf out "%s[ ] %a %s%!" - Color.reset_line (pp_counter ~size) c (T.get_name cell); + (if colors then Color.reset_line else "") + (pp_counter ~size) c (T.get_name cell); let r = QCheck.Test.check_cell ~long ~rand ~handler:(handler ~colors ~debug_shrink ~debug_shrink_list ~size ~out ~verbose c).handler - ~step:(step ~size ~out ~verbose c) + ~step:(step ~colors ~size ~out ~verbose c) ~call:(callback ~size ~out ~verbose ~colors c) cell in diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/runner/QCheck_base_runner.mli new/ocaml-qcheck-0.17/src/runner/QCheck_base_runner.mli --- old/ocaml-qcheck-0.14/src/runner/QCheck_base_runner.mli 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/src/runner/QCheck_base_runner.mli 2021-02-15 22:44:41.000000000 +0100 @@ -186,6 +186,7 @@ (* main callback for display *) val callback : + colors:bool -> verbose:bool -> print_res:bool -> print:('a, 'b) printer -> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-qcheck-0.14/src/runner/dune new/ocaml-qcheck-0.17/src/runner/dune --- old/ocaml-qcheck-0.14/src/runner/dune 2020-07-30 15:34:18.000000000 +0200 +++ new/ocaml-qcheck-0.17/src/runner/dune 2021-02-15 22:44:41.000000000 +0100 @@ -4,5 +4,5 @@ (public_name qcheck-core.runner) (wrapped false) (libraries qcheck-core) - (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) + (flags :standard -warn-error -a+8 -safe-string) )
