Merge pull request #299 from jmid/add-shrink-bool

Add Shrink.bool

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
 

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 --------------------------------------------------------------------
 

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 --------------------------------------------------------------------
 

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 --------------------------------------------------------------------
 

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 --------------------------------------------------------------------
 

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

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/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 --------------------------------------------------------------------
 

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 --------------------------------------------------------------------
 

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 --------------------------------------------------------------------
 

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 --------------------------------------------------------------------
 

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;