From e9fded1b27996a4ad6c65e18df4ab8a09ee16ae1 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Fri, 6 Dec 2024 23:17:18 +0100 Subject: [PATCH 1/7] Add Shrink.bool --- src/core/QCheck.ml | 9 ++++++--- src/core/QCheck.mli | 6 +++++- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/core/QCheck.ml b/src/core/QCheck.ml index b67a4ca1..07840844 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 92d31a3f..ea3fcd28 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']. From 746563a2451e214b2d5f57fc3352edb524ce4774 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Fri, 6 Dec 2024 23:17:59 +0100 Subject: [PATCH 2/7] Add unit test for Shrink.bool --- test/core/QCheck_unit_tests.ml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml index 01375af3..f07af0d1 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; From 832f94ed027e2a57cc9842599ccc57780d33030e Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Fri, 6 Dec 2024 23:20:39 +0100 Subject: [PATCH 3/7] Update 64-bit outputs for example/QCheck_runner_test.ml --- example/QCheck_runner_test.expected.ocaml4.64 | 4 ++-- example/QCheck_runner_test.expected.ocaml5.64 | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/example/QCheck_runner_test.expected.ocaml4.64 b/example/QCheck_runner_test.expected.ocaml4.64 index f54f8f4f..6a0526f2 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.64 b/example/QCheck_runner_test.expected.ocaml5.64 index 6e700e68..18e321d3 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 -------------------------------------------------------------------- From 450dab90fd14d101b604cefc5570efd773fa2ec7 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Fri, 6 Dec 2024 23:22:04 +0100 Subject: [PATCH 4/7] Update 64-bit outputs for test/core/QCheck_expect_test.ml --- test/core/QCheck_expect_test.expected.ocaml4.64 | 4 ++-- test/core/QCheck_expect_test.expected.ocaml5.64 | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/test/core/QCheck_expect_test.expected.ocaml4.64 b/test/core/QCheck_expect_test.expected.ocaml4.64 index 4b32e050..001496d7 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.64 b/test/core/QCheck_expect_test.expected.ocaml5.64 index ed35317c..8105c9ee 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 -------------------------------------------------------------------- From 49180a5165c79ce5e1015560508bc7a02fc5b470 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Fri, 6 Dec 2024 23:44:45 +0100 Subject: [PATCH 5/7] Update 32-bit outputs for example/QCheck_runner_test.ml --- example/QCheck_runner_test.expected.ocaml4.32 | 8 ++++---- example/QCheck_runner_test.expected.ocaml5.32 | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/example/QCheck_runner_test.expected.ocaml4.32 b/example/QCheck_runner_test.expected.ocaml4.32 index 5eb9e10c..6f2af91b 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.ocaml5.32 b/example/QCheck_runner_test.expected.ocaml5.32 index 4a96b674..96d62981 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 -------------------------------------------------------------------- From 82086b77ca646cce5778fd989fc5b9a662ccaaa8 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Fri, 6 Dec 2024 23:45:49 +0100 Subject: [PATCH 6/7] Update 32-bit outputs for test/core/QCheck_expect_test.ml --- test/core/QCheck_expect_test.expected.ocaml4.32 | 8 ++++---- test/core/QCheck_expect_test.expected.ocaml5.32 | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/test/core/QCheck_expect_test.expected.ocaml4.32 b/test/core/QCheck_expect_test.expected.ocaml4.32 index 865566a8..bdbd94cb 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.ocaml5.32 b/test/core/QCheck_expect_test.expected.ocaml5.32 index c8218b2e..0c273efd 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 -------------------------------------------------------------------- From d1c7c8125c1b578062fafa006959e2e3d9843c8e Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Sat, 7 Dec 2024 00:01:35 +0100 Subject: [PATCH 7/7] Add CHANGELOG entry --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index afd95b15..39f955ff 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