diff --git a/CHANGELOG.md b/CHANGELOG.md index 66f72c29..134e1e81 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -82,6 +82,7 @@ - Add missing `QCheck.Gen.bind` for consistency - Add missing `QCheck.Gen.ap` for consistency - Add missing `QCheck2.Gen.map_keep_input` for consistency +- Add `QCheck.no_shrink` for consistency ## 0.27 (2025-10-31) diff --git a/src/core/QCheck.ml b/src/core/QCheck.ml index bdb71abb..2e3a2f2f 100644 --- a/src/core/QCheck.ml +++ b/src/core/QCheck.ml @@ -1235,6 +1235,8 @@ let set_stats s o = {o with stats=s} let add_stat s o = {o with stats=s :: o.stats} let set_gen g o = {o with gen=g} +let no_shrink o = {o with shrink=None} + let add_shrink_invariant f o = match o.shrink with | None -> o | Some shr -> {o with shrink=Some (Shrink.filter f shr)} diff --git a/src/core/QCheck.mli b/src/core/QCheck.mli index 51625125..560e9a89 100644 --- a/src/core/QCheck.mli +++ b/src/core/QCheck.mli @@ -1186,6 +1186,11 @@ val set_shrink : 'a Shrink.t -> 'a arbitrary -> 'a arbitrary val set_collect : ('a -> string) -> 'a arbitrary -> 'a arbitrary val set_stats : 'a stat list -> 'a arbitrary -> 'a arbitrary (** @since 0.6 *) +val no_shrink : 'a arbitrary -> 'a arbitrary +(** [no_shrink gen] returns a generator using [gen] but with shrinking + disabled. + @since NEXT_RELEASE *) + val add_shrink_invariant : ('a -> bool) -> 'a arbitrary -> 'a arbitrary (** Update shrinker by only keeping smaller values satisfying the given invariant. diff --git a/test/core/QCheck2_expect_test.expected.ocaml4.32 b/test/core/QCheck2_expect_test.expected.ocaml4.32 index 72dd9e65..566dc335 100644 --- a/test/core/QCheck2_expect_test.expected.ocaml4.32 +++ b/test/core/QCheck2_expect_test.expected.ocaml4.32 @@ -635,7 +635,7 @@ Leaf 0 --- Failure -------------------------------------------------------------------- -Test sum list = 0 failed (0 shrink steps): +Test sum list = 0 with no_shrink failed (0 shrink steps): [0; 13; 4; 6; 14; 6; 47; 3; 4; 3; 6; 6; 9; 4; 3; 65; 2; 4; 55; 2; 4; 87; 9; 5; 35; 73; 9; 9; 2; 74; 5; 9; 10; 93; 2; 7; 1; 4; 6; 91; 8; 8; 2; 9; 47; 6; 26; 3; 60; 1; 0; 5; 26; 4; 28; 6; 0; 5; 88; 3; 7] diff --git a/test/core/QCheck2_expect_test.expected.ocaml4.64 b/test/core/QCheck2_expect_test.expected.ocaml4.64 index dc6e6476..ef0d4da6 100644 --- a/test/core/QCheck2_expect_test.expected.ocaml4.64 +++ b/test/core/QCheck2_expect_test.expected.ocaml4.64 @@ -697,7 +697,7 @@ Leaf 0 --- Failure -------------------------------------------------------------------- -Test sum list = 0 failed (0 shrink steps): +Test sum list = 0 with no_shrink failed (0 shrink steps): [0; 13; 4; 6; 14; 6; 47; 3; 4; 3; 6; 6; 9; 4; 3; 65; 2; 4; 55; 2; 4; 87; 9; 5; 35; 73; 9; 9; 2; 74; 5; 9; 10; 93; 2; 7; 1; 4; 6; 91; 8; 8; 2; 9; 47; 6; 26; 3; 60; 1; 0; 5; 26; 4; 28; 6; 0; 5; 88; 3; 7] diff --git a/test/core/QCheck2_expect_test.expected.ocaml5.32 b/test/core/QCheck2_expect_test.expected.ocaml5.32 index 78e56eae..9a778cfb 100644 --- a/test/core/QCheck2_expect_test.expected.ocaml5.32 +++ b/test/core/QCheck2_expect_test.expected.ocaml5.32 @@ -618,7 +618,7 @@ Leaf 0 --- Failure -------------------------------------------------------------------- -Test sum list = 0 failed (0 shrink steps): +Test sum list = 0 with no_shrink failed (0 shrink steps): [0; 1; 80; 0; 9; 2; 3] diff --git a/test/core/QCheck2_expect_test.expected.ocaml5.64 b/test/core/QCheck2_expect_test.expected.ocaml5.64 index 7495e620..54543a68 100644 --- a/test/core/QCheck2_expect_test.expected.ocaml5.64 +++ b/test/core/QCheck2_expect_test.expected.ocaml5.64 @@ -680,7 +680,7 @@ Leaf 0 --- Failure -------------------------------------------------------------------- -Test sum list = 0 failed (0 shrink steps): +Test sum list = 0 with no_shrink failed (0 shrink steps): [0; 1; 80; 0; 9; 2; 3] diff --git a/test/core/QCheck2_tests.ml b/test/core/QCheck2_tests.ml index 1ca3e89a..6b79f4a7 100644 --- a/test/core/QCheck2_tests.ml +++ b/test/core/QCheck2_tests.ml @@ -721,7 +721,7 @@ module Shrink = struct (fun tree -> IntTree.contains_only_n tree 42) let test_gen_no_shrink = - Test.make ~name:"sum list = 0" ~print:Print.(list int) + Test.make ~name:"sum list = 0 with no_shrink" ~print:Print.(list int) Gen.(no_shrink @@ list nat_small) (fun xs -> List.fold_left (+) 0 xs = 0) diff --git a/test/core/QCheck_expect_test.expected.ocaml4.32 b/test/core/QCheck_expect_test.expected.ocaml4.32 index 3027404e..4a7463cf 100644 --- a/test/core/QCheck_expect_test.expected.ocaml4.32 +++ b/test/core/QCheck_expect_test.expected.ocaml4.32 @@ -743,7 +743,7 @@ Leaf 0 --- Failure -------------------------------------------------------------------- -Test sum list = 0 failed (0 shrink steps): +Test sum list = 0 with no_shrink failed (0 shrink steps): [7; 1; 42; 1; 8; 5; 3; 9; 5; 38; 3; 3; 0; 1; 98; 1; 4; 13; 9; 2; 6; 9; 47; 6; 5; 8; 8; 6; 0; 9; 7; 2; 8; 6; 62; 6; 4; 31; 19; 1; 41; 60; 6; 5; 8; 1; 1; 4; 7; 7; 0; 5; 5; 71; 14; 26; 47; 5; 1; 6; 34; 9; 4; 2; 37; 3; 8; 4; 31; 6; 2; 1; 0; 7; 5; 1; 0; 15; 6; 1; 8; 13; 0; 6; 2; 4; 2; 6; 6; 1; 4; 1; 9; 79; 0; 87; 6; 8; 8; 62; 1; 4; 62; 6; 31; 1; 5; 6; 5; 9; 3; 3; 1; 79; 4; 3; 2; 67; 5; 7; 12; 70; 8; 8; 6; 1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7] diff --git a/test/core/QCheck_expect_test.expected.ocaml4.64 b/test/core/QCheck_expect_test.expected.ocaml4.64 index 43e6b0f8..ba395dbc 100644 --- a/test/core/QCheck_expect_test.expected.ocaml4.64 +++ b/test/core/QCheck_expect_test.expected.ocaml4.64 @@ -775,7 +775,7 @@ Leaf 0 --- Failure -------------------------------------------------------------------- -Test sum list = 0 failed (0 shrink steps): +Test sum list = 0 with no_shrink failed (0 shrink steps): [7; 1; 42; 1; 8; 5; 3; 9; 5; 38; 3; 3; 0; 1; 98; 1; 4; 13; 9; 2; 6; 9; 47; 6; 5; 8; 8; 6; 0; 9; 7; 2; 8; 6; 62; 6; 4; 31; 19; 1; 41; 60; 6; 5; 8; 1; 1; 4; 7; 7; 0; 5; 5; 71; 14; 26; 47; 5; 1; 6; 34; 9; 4; 2; 37; 3; 8; 4; 31; 6; 2; 1; 0; 7; 5; 1; 0; 15; 6; 1; 8; 13; 0; 6; 2; 4; 2; 6; 6; 1; 4; 1; 9; 79; 0; 87; 6; 8; 8; 62; 1; 4; 62; 6; 31; 1; 5; 6; 5; 9; 3; 3; 1; 79; 4; 3; 2; 67; 5; 7; 12; 70; 8; 8; 6; 1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7] diff --git a/test/core/QCheck_expect_test.expected.ocaml5.32 b/test/core/QCheck_expect_test.expected.ocaml5.32 index 6a015b76..3630f742 100644 --- a/test/core/QCheck_expect_test.expected.ocaml5.32 +++ b/test/core/QCheck_expect_test.expected.ocaml5.32 @@ -753,7 +753,7 @@ Leaf 0 --- Failure -------------------------------------------------------------------- -Test sum list = 0 failed (0 shrink steps): +Test sum list = 0 with no_shrink failed (0 shrink steps): [46; 2; 22; 4; 4; 2; 6; 5; 88; 24; 7; 9; 9; 2; 5; 1; 55; 8; 45; 1; 96; 0; 1; 2; 7; 4; 1; 5; 95; 6; 8; 6; 4; 0; 5; 5; 22; 87; 2; 1; 1; 0; 2; 2; 9; 5; 9; 3; 7; 59; 7; 96; 6; 5; 1; 3; 9; 9; 65; 6; 7; 7; 2; 5; 0; 0; 70; 5; 5; 2; 1; 57; 9; 7; 8; 10; 9; 7; 9; 75; 73; 80; 7; 9; 4; 3; 16; 5; 79; 1; 8; 6; 2; 3; 4; 9; 2; 8; 4; 6; 50; 2; 1; 5; 9; 5; 4; 3; 56; 6; 5; 9; 4; 1; 47; 1; 2; 5; 2; 0; 7; 31; 55; 6; 7; 4; 7; 8; 8; 2; 4; 40; 4; 6; 9; 3; 59; 5; 1; 0; 2; 6; 90; 1; 6; 81; 0; 1; 3; 7; 2; 4; 5; 4; 7; 3; 62; 0; 1; 6; 7; 5; 97; 83; 41; 7; 2; 6; 3; 0; 4; 8; 99; 8; 6; 0; 7; 9; 7; 1; 55; 30; 25; 3; 4; 7; 1; 6; 80; 8; 0; 4; 21; 3; 5; 9; 27; 10; 60; 47; 54; 6; 5; 8; 1; 5; 9; 65; 9; 5; 7; 7; 6; 48; 9; 5; 6; 4; 9; 7; 1; 2; 71; 6; 9; 2; 7; 8; 14; 59; 71; 30; 7; 3; 5; 4; 6; 7; 3; 6; 9; 8; 2; 38; 6; 6; 7; 1; 5; 2; 43; 5; 2; 9; 3; 0; 3; 2; 7; 71; 26; 3; 9; 11; 5; 1; 5; 2; 53; 46; 4; 6; 7; 67; 1; 0; 34; 0; 48; 5; 5; 0; 7; 49; 92; 8; 3; 0; 67; 1; 5; 2; 9; 5; 9; 3; 1; 4; 8; 0; 3; 6; 46; 58; 1; 54; 77; 0; 96; 1; 6; 2; 8; 22; 3; 9; 2; 6; 25; 49; 9; 6; 3; 8; 5; 9; 54; 1; 7; 5; 6; 5; 1; 7; 8; 23; 4; 6; 4; 2; 5; 8; 4; 7; 4] diff --git a/test/core/QCheck_expect_test.expected.ocaml5.64 b/test/core/QCheck_expect_test.expected.ocaml5.64 index 2c0fea56..9cb30e73 100644 --- a/test/core/QCheck_expect_test.expected.ocaml5.64 +++ b/test/core/QCheck_expect_test.expected.ocaml5.64 @@ -785,7 +785,7 @@ Leaf 0 --- Failure -------------------------------------------------------------------- -Test sum list = 0 failed (0 shrink steps): +Test sum list = 0 with no_shrink failed (0 shrink steps): [46; 2; 22; 4; 4; 2; 6; 5; 88; 24; 7; 9; 9; 2; 5; 1; 55; 8; 45; 1; 96; 0; 1; 2; 7; 4; 1; 5; 95; 6; 8; 6; 4; 0; 5; 5; 22; 87; 2; 1; 1; 0; 2; 2; 9; 5; 9; 3; 7; 59; 7; 96; 6; 5; 1; 3; 9; 9; 65; 6; 7; 7; 2; 5; 0; 0; 70; 5; 5; 2; 1; 57; 9; 7; 8; 10; 9; 7; 9; 75; 73; 80; 7; 9; 4; 3; 16; 5; 79; 1; 8; 6; 2; 3; 4; 9; 2; 8; 4; 6; 50; 2; 1; 5; 9; 5; 4; 3; 56; 6; 5; 9; 4; 1; 47; 1; 2; 5; 2; 0; 7; 31; 55; 6; 7; 4; 7; 8; 8; 2; 4; 40; 4; 6; 9; 3; 59; 5; 1; 0; 2; 6; 90; 1; 6; 81; 0; 1; 3; 7; 2; 4; 5; 4; 7; 3; 62; 0; 1; 6; 7; 5; 97; 83; 41; 7; 2; 6; 3; 0; 4; 8; 99; 8; 6; 0; 7; 9; 7; 1; 55; 30; 25; 3; 4; 7; 1; 6; 80; 8; 0; 4; 21; 3; 5; 9; 27; 10; 60; 47; 54; 6; 5; 8; 1; 5; 9; 65; 9; 5; 7; 7; 6; 48; 9; 5; 6; 4; 9; 7; 1; 2; 71; 6; 9; 2; 7; 8; 14; 59; 71; 30; 7; 3; 5; 4; 6; 7; 3; 6; 9; 8; 2; 38; 6; 6; 7; 1; 5; 2; 43; 5; 2; 9; 3; 0; 3; 2; 7; 71; 26; 3; 9; 11; 5; 1; 5; 2; 53; 46; 4; 6; 7; 67; 1; 0; 34; 0; 48; 5; 5; 0; 7; 49; 92; 8; 3; 0; 67; 1; 5; 2; 9; 5; 9; 3; 1; 4; 8; 0; 3; 6; 46; 58; 1; 54; 77; 0; 96; 1; 6; 2; 8; 22; 3; 9; 2; 6; 25; 49; 9; 6; 3; 8; 5; 9; 54; 1; 7; 5; 6; 5; 1; 7; 8; 23; 4; 6; 4; 2; 5; 8; 4; 7; 4] diff --git a/test/core/QCheck_tests.ml b/test/core/QCheck_tests.ml index efe36f55..de50f600 100644 --- a/test/core/QCheck_tests.ml +++ b/test/core/QCheck_tests.ml @@ -897,8 +897,8 @@ module Shrink = struct (fun tree -> IntTree.contains_only_n tree 42) let test_gen_no_shrink = - Test.make ~name:"sum list = 0" - (set_shrink Shrink.nil (list nat_small)) + Test.make ~name:"sum list = 0 with no_shrink" + (no_shrink @@ list nat_small) (fun xs -> List.fold_left (+) 0 xs = 0) let tests = [