Repository: c-cube/qcheck (ocaml)

Issue:
Missing QCheck.Shrink.bool
I noticed that QCheck.Shrink is missing a `bool` combinator.

This should be probably shrink `true` to `false` like QCheck2: 
  https://github.com/c-cube/qcheck/blob/dd5feb49be06b585b943037e7a6c218d9cb7fb49/src/core/QCheck2.ml#L313-L317

Finally the `bool arbitrary` could be extended to use it. 

Pull request description:
Add Shrink.bool
This PR adds the missing Shrink.bool combinator and thus fixes #251

Like the QCheck2 bool shrinker it shrinks towards false (for uniformity)

Patch:
diff --git a/CHANGELOG.md b/CHANGELOG.md
index afd95b1..39f955f 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,7 @@
 
 ## NEXT RELEASE
 
+- Add `Shrink.bool` and use it in `QCheck.bool`
 - Remove unread `fun_gen` field from `QCheck2`'s `fun_repr_tbl` type
   thereby silencing a compiler warning
 
diff --git a/src/core/QCheck.ml b/src/core/QCheck.ml
index b67a4ca..0784084 100644
--- a/src/core/QCheck.ml
+++ b/src/core/QCheck.ml
@@ -672,6 +672,9 @@ module Shrink = struct
 
   let unit = nil
 
+  let bool b =
+    if b then Iter.return false else Iter.empty
+
   (* balanced shrinker for integers (non-exhaustive) *)
   let int x yield =
     let y = ref x in
@@ -1085,9 +1088,9 @@ let choose l = match l with
           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
+  make ~small:small1 ~shrink:Shrink.nil ~print:Print.unit Gen.unit
+let bool =
+  make ~small:small1 ~shrink:Shrink.bool ~print:Print.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
diff --git a/src/core/QCheck.mli b/src/core/QCheck.mli
index 92d31a3..ea3fcd2 100644
--- a/src/core/QCheck.mli
+++ b/src/core/QCheck.mli
@@ -723,7 +723,11 @@ module Shrink : sig
   val nil : 'a t
   (** No shrink *)
 
-  val unit : unit t (** @since 0.6 *)
+  val unit : unit t
+  (** @since 0.6 *)
+
+  val bool : bool t
+  (** @since NEXT_RELEASE *)
 
   val char : char t
   (** Shrinks towards ['a'].


Test patch:
diff --git a/example/QCheck_runner_test.expected.ocaml4.32 b/example/QCheck_runner_test.expected.ocaml4.32
index 5eb9e10..6f2af91 100644
--- a/example/QCheck_runner_test.expected.ocaml4.32
+++ b/example/QCheck_runner_test.expected.ocaml4.32
@@ -74,15 +74,15 @@ exception Dune__exe__QCheck_runner_test.Error
 
 --- Failure --------------------------------------------------------------------
 
-Test FAIL_pred_map_commute failed (47 shrink steps):
+Test FAIL_pred_map_commute failed (48 shrink steps):
 
-([1], {_ -> 0}, {0 -> false; _ -> true})
+([1], {_ -> 0}, {1 -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test FAIL_fun2_pred_strings failed (1 shrink steps):
+Test FAIL_fun2_pred_strings failed (2 shrink steps):
 
-{some other string -> false; _ -> true}
+{some random string -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
diff --git a/example/QCheck_runner_test.expected.ocaml4.64 b/example/QCheck_runner_test.expected.ocaml4.64
index f54f8f4..6a0526f 100644
--- a/example/QCheck_runner_test.expected.ocaml4.64
+++ b/example/QCheck_runner_test.expected.ocaml4.64
@@ -80,9 +80,9 @@ Test FAIL_pred_map_commute failed (77 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test FAIL_fun2_pred_strings failed (1 shrink steps):
+Test FAIL_fun2_pred_strings failed (2 shrink steps):
 
-{some other string -> false; _ -> true}
+{some random string -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
diff --git a/example/QCheck_runner_test.expected.ocaml5.32 b/example/QCheck_runner_test.expected.ocaml5.32
index 4a96b67..96d6298 100644
--- a/example/QCheck_runner_test.expected.ocaml5.32
+++ b/example/QCheck_runner_test.expected.ocaml5.32
@@ -80,9 +80,9 @@ Test FAIL_pred_map_commute failed (47 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test FAIL_fun2_pred_strings failed (1 shrink steps):
+Test FAIL_fun2_pred_strings failed (2 shrink steps):
 
-{some other string -> false; _ -> true}
+{some random string -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
diff --git a/example/QCheck_runner_test.expected.ocaml5.64 b/example/QCheck_runner_test.expected.ocaml5.64
index 6e700e6..18e321d 100644
--- a/example/QCheck_runner_test.expected.ocaml5.64
+++ b/example/QCheck_runner_test.expected.ocaml5.64
@@ -74,15 +74,15 @@ exception Dune__exe__QCheck_runner_test.Error
 
 --- Failure --------------------------------------------------------------------
 
-Test FAIL_pred_map_commute failed (79 shrink steps):
+Test FAIL_pred_map_commute failed (89 shrink steps):
 
-([11], {_ -> 0}, {11 -> false; _ -> true})
+([1], {_ -> 0}, {0 -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test FAIL_fun2_pred_strings failed (1 shrink steps):
+Test FAIL_fun2_pred_strings failed (2 shrink steps):
 
-{some other string -> false; _ -> true}
+{some random string -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
diff --git a/test/core/QCheck_expect_test.expected.ocaml4.32 b/test/core/QCheck_expect_test.expected.ocaml4.32
index 865566a..bdbd94c 100644
--- a/test/core/QCheck_expect_test.expected.ocaml4.32
+++ b/test/core/QCheck_expect_test.expected.ocaml4.32
@@ -503,15 +503,15 @@ Test sum list = 0 failed (0 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_map_commute failed (47 shrink steps):
+Test fail_pred_map_commute failed (48 shrink steps):
 
-([1], {_ -> 0}, {0 -> false; _ -> true})
+([1], {_ -> 0}, {1 -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_strings failed (1 shrink steps):
+Test fail_pred_strings failed (2 shrink steps):
 
-{some other string -> false; _ -> true}
+{some random string -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
diff --git a/test/core/QCheck_expect_test.expected.ocaml4.64 b/test/core/QCheck_expect_test.expected.ocaml4.64
index 4b32e05..001496d 100644
--- a/test/core/QCheck_expect_test.expected.ocaml4.64
+++ b/test/core/QCheck_expect_test.expected.ocaml4.64
@@ -541,9 +541,9 @@ Test fail_pred_map_commute failed (77 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_strings failed (1 shrink steps):
+Test fail_pred_strings failed (2 shrink steps):
 
-{some other string -> false; _ -> true}
+{some random string -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
diff --git a/test/core/QCheck_expect_test.expected.ocaml5.32 b/test/core/QCheck_expect_test.expected.ocaml5.32
index c8218b2..0c273ef 100644
--- a/test/core/QCheck_expect_test.expected.ocaml5.32
+++ b/test/core/QCheck_expect_test.expected.ocaml5.32
@@ -519,9 +519,9 @@ Test fail_pred_map_commute failed (47 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_strings failed (1 shrink steps):
+Test fail_pred_strings failed (2 shrink steps):
 
-{some other string -> false; _ -> true}
+{some random string -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
diff --git a/test/core/QCheck_expect_test.expected.ocaml5.64 b/test/core/QCheck_expect_test.expected.ocaml5.64
index ed35317..8105c9e 100644
--- a/test/core/QCheck_expect_test.expected.ocaml5.64
+++ b/test/core/QCheck_expect_test.expected.ocaml5.64
@@ -545,15 +545,15 @@ Test sum list = 0 failed (0 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_map_commute failed (79 shrink steps):
+Test fail_pred_map_commute failed (89 shrink steps):
 
-([11], {_ -> 0}, {11 -> false; _ -> true})
+([1], {_ -> 0}, {0 -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_strings failed (1 shrink steps):
+Test fail_pred_strings failed (2 shrink steps):
 
-{some other string -> false; _ -> true}
+{some random string -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml
index 01375af..f07af0d 100644
--- a/test/core/QCheck_unit_tests.ml
+++ b/test/core/QCheck_unit_tests.ml
@@ -17,6 +17,14 @@ module Shrink = struct
   let alco_check typ func msg_suffix (msg,input,expected) =
     Alcotest.(check (list typ)) (msg ^ " - " ^ msg_suffix) expected (func input)
 
+  let test_bool () =
+    List.iter (alco_check Alcotest.bool (trace_false Shrink.bool) "on repeated failure")
+      [ ("bool true",  true,  [false]);
+        ("bool false", false, []) ];
+    List.iter (alco_check Alcotest.bool (trace_true Shrink.bool) "on repeated success")
+      [ ("bool true",  true,  [false]);
+        ("bool false", false, []) ]
+
   let test_int () =
     List.iter (alco_check Alcotest.int (trace_false Shrink.int) "on repeated failure")
       [ ("int 100",   100,  [50; 75; 88; 94; 97; 99]);
@@ -154,6 +162,7 @@ module Shrink = struct
     Alcotest.(check unit) "doesn't compare elements" () @@ run_test ()
 
   let tests = ("Shrink", Alcotest.[
+      test_case "bool"  `Quick test_bool;
       test_case "int"   `Quick test_int;
       test_case "int32" `Quick test_int32;
       test_case "int64" `Quick test_int64;