The Great Renaming, Chapter 11: Add QCheck.noshrink

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)

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

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.

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]
 

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]
 

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]
 

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]
 

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)
 

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]
 

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]
 

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]
 

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]
 

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