Shrinker adjustments

CHANGELOG.md

@@ -9,6 +9,8 @@
 - fix issue with `ppx_deriving_qcheck` deriving a generator with unbound
   `gen` for recursive types [#269](https://github.com/c-cube/qcheck/issues/269)
   and a related issue when deriving a generator for a record type
+- fix #241 causing `QCheck.Shrink.int*` to emit duplicates, also affecting `QCheck.Shrink.{char,string}`
+- fix a cornercase where `Shrink.list_spine` would emit duplicates
 - ...
 
 ## 0.20

src/core/QCheck.ml

@@ -677,26 +677,26 @@ module Shrink = struct
     let y = ref x in
     (* try some divisors *)
     while !y < -2 || !y >2 do y := !y / 2; yield (x - !y); done; (* fast path *)
-    if x>0 then yield (x-1);
-    if x<0 then yield (x+1);
+    if x = 1 || (x>0 && !y <> 1) then yield (x-1);
+    if x = -1 || (x<0 && !y <> -1) then yield (x+1);
     ()
 
   let int32 x yield =
     let open Int32 in
     let y = ref x in
     (* try some divisors *)
     while !y < -2l || !y > 2l do y := div !y 2l; yield (sub x !y); done; (* fast path *)
-    if x>0l then yield (pred x);
-    if x<0l then yield (succ x);
+    if x = 1l || (x>0l && !y <> 1l) then yield (pred x);
+    if x = -1l || (x<0l && !y <> -1l) then yield (succ x);
     ()
 
   let int64 x yield =
     let open Int64 in
     let y = ref x in
     (* try some divisors *)
     while !y < -2L || !y > 2L do y := div !y 2L; yield (sub x !y); done; (* fast path *)
-    if x>0L then yield (pred x);
-    if x<0L then yield (succ x);
+    if x = 1L || (x>0L && !y <> 1L) then yield (pred x);
+    if x = -1L || (x<0L && !y <> -1L) then yield (succ x);
     ()
 
   (* aggressive shrinker for integers,
@@ -760,7 +760,7 @@ module Shrink = struct
     match l with
     | [] -> ()
     | [_] -> yield []
-    | [x;y] -> yield []; yield [x]; yield [y]
+    | [x;y] -> yield []; yield [x]; if x <> y then yield [y]
     | _::_ ->
       let len = List.length l in
       let xs,ys = split l ((1 + len) / 2) [] in

test/core/QCheck_expect_test.expected.32

@@ -74,7 +74,6 @@ random seed: 1234
 [1; 1]
 []
 [1]
-[1]
 [0; 1]
 [1; 0]
 

test/core/QCheck_expect_test.expected.64

@@ -106,7 +106,6 @@ random seed: 1234
 [1; 1]
 []
 [1]
-[1]
 [0; 1]
 [1; 0]
 

test/core/QCheck_expect_test.expected.ocaml5

@@ -116,7 +116,6 @@ random seed: 1234
 [2; 2]
 []
 [2]
-[2]
 [1; 2]
 [2; 1]
 

test/core/QCheck_unit_tests.ml

@@ -19,29 +19,29 @@ module Shrink = struct
 
   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; 99]); (*WTF?*)
-        ("int 1000",  1000, [500; 750; 875; 938; 969; 985; 993; 997; 999; 999]); (*WTF?*)
-        ("int (-26)", -26,  [-13; -20; -23; -25; -25]) ]; (*WTF?*)
+      [ ("int 100",   100,  [50; 75; 88; 94; 97; 99]);
+        ("int 1000",  1000, [500; 750; 875; 938; 969; 985; 993; 997; 999]);
+        ("int (-26)", -26,  [-13; -20; -23; -25]) ];
     List.iter (alco_check Alcotest.int (trace_true Shrink.int) "on repeated success")
       [ ("int 100",   100,  [50; 25; 13; 7; 4; 2; 1; 0]);
         ("int 1000",  1000, [500; 250; 125; 63; 32; 16; 8; 4; 2; 1; 0]);
         ("int (-26)", -26,  [-13; -7; -4; -2; -1; 0]) ]
 
   let test_int32 () =
     List.iter (alco_check Alcotest.int32 (trace_false Shrink.int32) "on repeated failure")
-      [ ("int 100",   100l,  [50l; 75l; 88l; 94l; 97l; 99l; 99l]);
-        ("int 1000",  1000l, [500l; 750l; 875l; 938l; 969l; 985l; 993l; 997l; 999l; 999l]);
-        ("int (-26)", -26l,  [-13l; -20l; -23l; -25l; -25l]) ];
+      [ ("int 100",   100l,  [50l; 75l; 88l; 94l; 97l; 99l]);
+        ("int 1000",  1000l, [500l; 750l; 875l; 938l; 969l; 985l; 993l; 997l; 999l]);
+        ("int (-26)", -26l,  [-13l; -20l; -23l; -25l]) ];
     List.iter (alco_check Alcotest.int32 (trace_true Shrink.int32) "on repeated success")
       [ ("int 100",   100l,  [50l; 25l; 13l; 7l; 4l; 2l; 1l; 0l]);
         ("int 1000",  1000l, [500l; 250l; 125l; 63l; 32l; 16l; 8l; 4l; 2l; 1l; 0l]);
         ("int (-26)", -26l,  [-13l; -7l; -4l; -2l; -1l; 0l]) ]
 
   let test_int64 () =
     List.iter (alco_check Alcotest.int64 (trace_false Shrink.int64) "on repeated failure")
-      [ ("int 100",   100L,  [50L; 75L; 88L; 94L; 97L; 99L; 99L]);
-        ("int 1000",  1000L, [500L; 750L; 875L; 938L; 969L; 985L; 993L; 997L; 999L; 999L]);
-        ("int (-26)", -26L,  [-13L; -20L; -23L; -25L; -25L]) ];
+      [ ("int 100",   100L,  [50L; 75L; 88L; 94L; 97L; 99L]);
+        ("int 1000",  1000L, [500L; 750L; 875L; 938L; 969L; 985L; 993L; 997L; 999L]);
+        ("int (-26)", -26L,  [-13L; -20L; -23L; -25L]) ];
     List.iter (alco_check Alcotest.int64 (trace_true Shrink.int64) "on repeated success")
       [ ("int 100",   100L,  [50L; 25L; 13L; 7L; 4L; 2L; 1L; 0L]);
         ("int 1000",  1000L, [500L; 250L; 125L; 63L; 32L; 16L; 8L; 4L; 2L; 1L; 0L]);
@@ -50,9 +50,9 @@ module Shrink = struct
   let test_char () =
     List.iter (alco_check Alcotest.char (trace_false Shrink.char) "on repeated failure")
       [ ("char 'a'",   'a',  []);
-        ("char 'z'",   'z',  ['n'; 't'; 'w'; 'y'; 'y']); (*WTF?*)
+        ("char 'z'",   'z',  ['n'; 't'; 'w'; 'y']);
         ("char 'A'",   'A',  ['Q'; 'I'; 'E'; 'C'; 'B']);
-        ("char '~'",   '~',  ['p'; 'w'; '{'; '}'; '}']) ]; (*WTF?*)
+        ("char '~'",   '~',  ['p'; 'w'; '{'; '}']) ];
     List.iter (alco_check Alcotest.char (trace_true Shrink.char) "on repeated success")
       [ ("char 'a'",   'a',  []);
         ("char 'z'",   'z',  ['n'; 'h'; 'e'; 'c'; 'b'; 'a']);
@@ -72,22 +72,55 @@ module Shrink = struct
       [ ("char 'A'",   'A',  ['Q'; 'I'; 'E'; 'C'; 'B']);
         ("char 'a'",   'a',  []);
         ("char ' '",   ' ',  ['@'; '0'; '('; '$'; '"'; '!']);
-        ("char '~'",   '~',  ['p'; 'w'; '{'; '}'; '}']); (*WTF?*)
-        ("char '\\n'", '\n', ['p'; 'w'; '{'; '}'; '}']); ]; (*WTF?*)
+        ("char '~'",   '~',  ['p'; 'w'; '{'; '}']);
+        ("char '\\n'", '\n', ['p'; 'w'; '{'; '}']); ];
     List.iter (alco_check Alcotest.char (trace_true Shrink.char_printable) "on repeated success")
       [ ("char 'A'",   'A',  ['Q'; 'Y'; ']'; '_'; '`'; 'a']);
         ("char 'a'",   'a',  []);
         ("char ' '",   ' ',  ['@'; 'P'; 'X'; '\\'; '^'; '_'; '`'; 'a']);
         ("char '~'",   '~',  ['p'; 'i'; 'e'; 'c'; 'b'; 'a']);
         ("char '\\n'", '\n', ['p'; 'i'; 'e'; 'c'; 'b'; 'a']); ]
 
+  let test_string () =
+    List.iter (alco_check Alcotest.string (trace_false Shrink.string) "on repeated failure")
+      [ ("string \"\"",     "",     []);
+        ("string \"a\"",    "a",    [""]);
+        ("string \"aa\"",   "aa",   [""; "a"]);
+        ("string \"aaaa\"", "aaaa", ["aa"; "aa"; "aaa"]);
+        ("string \"abcd\"", "abcd", ["ab"; "cd"; "acd"; "bcd"; "aacd"; "abbd"; "abcc"]);
+        ("string \"E'*\"",  "E'*",  ["E'"; "*"; "E*"; "'*"; "S'*"; "L'*"; "H'*"; "F'*"; "ED*";
+                                     "E5*"; "E.*"; "E**"; "E(*"; "E'E"; "E'7"; "E'0"; "E'-"; "E'+"]);
+        ("string \"vi5x92xgG\"", "vi5x92xgG", (* A less exhaustive string shrinker would be preferable *)
+         ["vi5x9"; "vi52xgG"; "vix92xgG"; "5x92xgG";
+          "v5x92xgG"; "i5x92xgG"; "li5x92xgG"; "qi5x92xgG"; "ti5x92xgG"; "ui5x92xgG";
+          "ve5x92xgG"; "vg5x92xgG"; "vh5x92xgG";
+          "viKx92xgG"; "vi@x92xgG"; "vi:x92xgG"; "vi7x92xgG"; "vi6x92xgG";
+          "vi5m92xgG"; "vi5s92xgG"; "vi5v92xgG"; "vi5w92xgG";
+          "vi5xM2xgG"; "vi5xC2xgG"; "vi5x>2xgG"; "vi5x;2xgG"; "vi5x:2xgG";
+          "vi5x9IxgG"; "vi5x9=xgG"; "vi5x97xgG"; "vi5x94xgG"; "vi5x93xgG";
+          "vi5x92mgG"; "vi5x92sgG"; "vi5x92vgG"; "vi5x92wgG";
+          "vi5x92xdG"; "vi5x92xfG";
+          "vi5x92xgT"; "vi5x92xgM"; "vi5x92xgJ"; "vi5x92xgH"]);
+        ("string \"~~~~\"", "~~~~", ["~~"; "~~"; "~~~"; "p~~~"; "w~~~"; "{~~~"; "}~~~"; "~p~~";
+                                     "~w~~"; "~{~~"; "~}~~"; "~~p~"; "~~w~"; "~~{~"; "~~}~";
+                                     "~~~p"; "~~~w"; "~~~{"; "~~~}"]); ];
+    List.iter (alco_check Alcotest.string (trace_true Shrink.string) "on repeated success")
+      [ ("string \"\"",     "",     []);
+        ("string \"a\"",    "a",    [""]);
+        ("string \"aa\"",   "aa",   [""]);
+        ("string \"aaaa\"", "aaaa", ["aa"; ""]);
+        ("string \"abcd\"", "abcd", ["ab"; ""]);
+        ("string \"E'*\"",  "E'*",  ["E'"; ""]);
+        ("string \"vi5x92xgG\"", "vi5x92xgG", ["vi5x9"; "vi5"; "vi"; ""]); ]
+
   let tests = ("Shrink", Alcotest.[
       test_case "int"   `Quick test_int;
       test_case "int32" `Quick test_int32;
       test_case "int64" `Quick test_int64;
       test_case "char"  `Quick test_char;
       test_case "char_numeral"   `Quick test_char_numeral;
       test_case "char_printable" `Quick test_char_printable;
+      test_case "string" `Quick test_string;
     ])
 end