Repository: c-cube/qcheck
Pull request #220 (2022-01-07 12:59:24)

QCHECK_LONG_FACTOR environment variable
In https://github.com/c-cube/qcheck/pull/142 we introduced a `QCHECK_COUNT` environment variable. It is very useful to debug flaky tests by running a dedicated pipeline with a lot higher `QCHECK_COUNT`. We decided that the `~count` in a `Test.make` overrides the environment variable (which I think is fine), but, there is no easy way to conditionally increase these given counts.

I propose another environment variable `QCHECK_COUNT_MULTIPLIER` to increase the `~count` value.

c-cube: just a remark, there is already the notion of `long` tests, which is a multiplier. Is this different? (the env var is a good idea anyway, mind you).
vch9: > just a remark, there is already the notion of long tests, which is a multiplier. Is this different? (the env var is a good idea anyway, mind you).

I was not aware of `long` tests, what I proposed is not different. I'll change to an env variable `QCHECK_LONG_FACTOR` yes



Patch:
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 39c8e6b..63aa823 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -34,6 +34,8 @@
     `string_gen`, `string`, `printable_string`, `numeral_string`, `list`, and `array`
   - fix exception documentation for `check_result`, `check_cell_exn`, and `check_exn`
 
+- add environment variable `QCHECK_LONG_FACTOR` similar to `QCHECK_COUNT` [#220](https://github.com/c-cube/qcheck/pull/220)
+
 ## 0.18.1
 
 - fix `Gen.{nat,pos}_split{2,}`
diff --git a/src/core/QCheck2.ml b/src/core/QCheck2.ml
index 4546faa..2e3c5da 100644
--- a/src/core/QCheck2.ml
+++ b/src/core/QCheck2.ml
@@ -1415,13 +1415,19 @@ module Test = struct
 
   let default_count = 100
 
-  let global_count count =
-    let count = match (count, Sys.getenv_opt "QCHECK_COUNT") with
+  let default_long_factor = 1
+
+  let global_positive_var default env_var var =
+    let var = match (var, Sys.getenv_opt env_var) with
     | (Some x, _) -> x
     | (_, Some x) -> int_of_string x
-    | (None, None) -> default_count
+    | (None, None) -> default
   in
-  if count < 0 then invalid_arg ("count must be > 0 but value is " ^ string_of_int count) else count
+  if var <= 0 then invalid_arg (env_var ^ " must be > 0 but value is " ^ string_of_int var) else var
+
+  let global_count count = global_positive_var default_count "QCHECK_COUNT" count
+
+  let global_long_factor long_factor = global_positive_var default_long_factor "QCHECK_LONG_FACTOR" long_factor
 
   let fresh_name =
     let r = ref 0 in
@@ -1430,10 +1436,11 @@ module Test = struct
   let default_if_assumptions_fail = `Warning, 0.05
 
   let make_cell ?(if_assumptions_fail=default_if_assumptions_fail)
-      ?(count) ?(long_factor=1) ?max_gen
+      ?(count) ?long_factor ?max_gen
       ?(max_fail=1) ?(retries=1) ?(name=fresh_name()) ?print ?collect ?(stats=[]) gen law
     =
     let count = global_count count in
+    let long_factor = global_long_factor long_factor in
     let max_gen = match max_gen with None -> count + 200 | Some x->x in
     {
       law;
@@ -1452,10 +1459,11 @@ module Test = struct
     }
 
   let make_cell_from_QCheck1 ?(if_assumptions_fail=default_if_assumptions_fail)
-      ?(count) ?(long_factor=1) ?max_gen
+      ?(count) ?long_factor ?max_gen
       ?(max_fail=1) ?(retries=1) ?(name=fresh_name()) ~gen ?shrink ?print ?collect ~stats law
     =
     let count = global_count count in
+    let long_factor = global_long_factor long_factor 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
@@ -1479,6 +1487,8 @@ module Test = struct
     Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?retries ?name ?print ?collect ?stats gen law)
 
   let test_get_count (Test cell) = get_count cell
+  
+  let test_get_long_factor (Test cell) = get_long_factor cell
 
   (** {6 Running the test} *)
 
diff --git a/src/core/QCheck2.mli b/src/core/QCheck2.mli
index 4c0d842..ec54ca1 100644
--- a/src/core/QCheck2.mli
+++ b/src/core/QCheck2.mli
@@ -1662,6 +1662,8 @@ module Test : sig
 
   val test_get_count : t -> int
 
+  val test_get_long_factor : t -> int
+
   val fail_report : string -> 'a
   (** Fail the test with some additional message that will be reported.
 


Test patch:
diff --git a/test/core/QCheck2_unit_tests.ml b/test/core/QCheck2_unit_tests.ml
index cfbc02f..8711971 100644
--- a/test/core/QCheck2_unit_tests.ml
+++ b/test/core/QCheck2_unit_tests.ml
@@ -101,8 +101,6 @@ module TestCount = struct
 
   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 () =
@@ -114,12 +112,37 @@ module TestCount = struct
   let tests =
     ("Test.make ~count", 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 TestLongFactor = struct
+  let test_long_factor_n ?long_factor expected =
+    let t = QCheck2.(Test.make ?long_factor Gen.int (fun _ -> true)) in
+    let msg = Printf.sprintf "QCheck2.Test.make ~long_factor:%s |> long_factor = %d"
+                (Option.fold ~none:"None" ~some:string_of_int long_factor) expected
+    in
+    Alcotest.(check int) msg expected (QCheck2.Test.test_get_long_factor t)
+
+  let test_long_factor_10 () = test_long_factor_n ~long_factor:10 10
+
+  let test_long_factor_default () = test_long_factor_n 1
+
+  let test_long_factor_env () =
+    let () = Unix.putenv "QCHECK_LONG_FACTOR" "5" in
+    let t = QCheck2.(Test.make Gen.int (fun _ -> true)) in
+    let actual = QCheck2.Test.test_get_long_factor t in
+    Alcotest.(check int) "default long factor is from QCHECK_LONG_FACTOR" 5 actual
+
+  let tests =
+    ("Test.make ~long_factor", Alcotest.[
+         test_case "make with custom long_factor" `Quick test_long_factor_10;
+         test_case "make with default long_factor" `Quick test_long_factor_default;
+         test_case "make with env long_factor" `Quick test_long_factor_env;
+       ])
+end
+
 module String = struct
 
   let test_string_shrinking () =
@@ -184,6 +207,7 @@ let () =
       Shrink.tests;
       Gen.tests;
       TestCount.tests;
+      TestLongFactor.tests;
       String.tests;
       Check_exn.tests;
     ]
diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml
index 9ace8fc..bb26e85 100644
--- a/test/core/QCheck_unit_tests.ml
+++ b/test/core/QCheck_unit_tests.ml
@@ -102,9 +102,63 @@ module Check_exn = struct
        ])
 end
 
+module TestCount = struct
+  let test_count_n ?count expected =
+    let (Test cell) = QCheck.(Test.make ?count int (fun _ -> true)) in
+    let msg = Printf.sprintf "QCheck.Test.make ~count:%s |> get_count = %d"
+                (Option.fold ~none:"None" ~some:string_of_int count) expected
+    in
+    Alcotest.(check int) msg expected (QCheck.Test.get_count cell)
+
+  let test_count_10 () = test_count_n ~count:10 10
+
+  let test_count_default () = test_count_n 100
+
+  let test_count_env () =
+    let () = Unix.putenv "QCHECK_COUNT" "5" in
+    let (Test cell) = QCheck.(Test.make int (fun _ -> true)) in
+    let actual = QCheck.Test.get_count cell in
+    Alcotest.(check int) "default count is from QCHECK_COUNT" 5 actual
+
+  let tests =
+    ("Test.make ~count", Alcotest.[
+         test_case "make with custom count" `Quick test_count_10;
+         test_case "make with default count" `Quick test_count_default;
+         test_case "make with env count" `Quick test_count_env;
+       ])
+end
+
+module TestLongFactor = struct
+  let test_long_factor_n ?long_factor expected =
+    let (Test cell) = QCheck.(Test.make ?long_factor int (fun _ -> true)) in
+    let msg = Printf.sprintf "QCheck.Test.make ~long_factor:%s |> long_factor = %d"
+                (Option.fold ~none:"None" ~some:string_of_int long_factor) expected
+    in
+    Alcotest.(check int) msg expected (QCheck.Test.get_long_factor cell)
+
+  let test_long_factor_10 () = test_long_factor_n ~long_factor:10 10
+
+  let test_long_factor_default () = test_long_factor_n 1
+
+  let test_long_factor_env () =
+    let () = Unix.putenv "QCHECK_LONG_FACTOR" "5" in
+    let (Test cell) = QCheck.(Test.make int (fun _ -> true)) in
+    let actual = QCheck.Test.get_long_factor cell in
+    Alcotest.(check int) "default long factor is from QCHECK_LONG_FACTOR" 5 actual
+
+  let tests =
+    ("Test.make ~long_factor", Alcotest.[
+         test_case "make with custom long_factor" `Quick test_long_factor_10;
+         test_case "make with default long_factor" `Quick test_long_factor_default;
+         test_case "make with env long_factor" `Quick test_long_factor_env;
+       ])
+end
+
 let () =
   Alcotest.run "QCheck"
     [
       Shrink.tests;
       Check_exn.tests;
+      TestCount.tests;
+      TestLongFactor.tests;
     ]