Reintroduce Shrink.list_spine optimization

CHANGELOG.md

@@ -2,7 +2,9 @@
 
 ## NEXT RELEASE
 
-- fix #273 by lowering `ppx_deriving_qcheck`'s `qcheck` dependency to `qcheck-core`
+- Reintroduce the `Shrink.list_spine` fix by catching `Invalid_argument` and
+  falling back on an address comparison.
+- Fix #273 by lowering `ppx_deriving_qcheck`'s `qcheck` dependency to `qcheck-core`
 
 ## 0.21.1
 

src/core/QCheck.ml

@@ -760,7 +760,7 @@ module Shrink = struct
     match l with
     | [] -> ()
     | [_] -> yield []
-    | [x;y] -> yield []; yield [x]; yield [y]
+    | [x;y] -> yield []; yield [x]; if (try x <> y with Invalid_argument _ -> 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.ocaml4.32

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

test/core/QCheck_expect_test.expected.ocaml4.64

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

test/core/QCheck_expect_test.expected.ocaml5.32

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

test/core/QCheck_expect_test.expected.ocaml5.64

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

test/core/QCheck_unit_tests.ml

@@ -85,8 +85,8 @@ module Shrink = struct
     List.iter (alco_check Alcotest.string (trace_false Shrink.string) "on repeated failure")
       [ ("string \"\"",     "",     []);
         ("string \"a\"",    "a",    [""]);
-        ("string \"aa\"",   "aa",   [""; "a"; "a"]);
-        ("string \"aaaa\"", "aaaa", ["aa"; "aa"; "aaa"; "aaa"]);
+        ("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'+"]);
@@ -101,7 +101,7 @@ module Shrink = struct
           "vi5x92mgG"; "vi5x92sgG"; "vi5x92vgG"; "vi5x92wgG";
           "vi5x92xdG"; "vi5x92xfG";
           "vi5x92xgT"; "vi5x92xgM"; "vi5x92xgJ"; "vi5x92xgH"]);
-        ("string \"~~~~\"", "~~~~", ["~~"; "~~"; "~~~"; "~~~"; "p~~~"; "w~~~"; "{~~~"; "}~~~"; "~p~~";
+        ("string \"~~~~\"", "~~~~", ["~~"; "~~"; "~~~"; "p~~~"; "w~~~"; "{~~~"; "}~~~"; "~p~~";
                                      "~w~~"; "~{~~"; "~}~~"; "~~p~"; "~~w~"; "~~{~"; "~~}~";
                                      "~~~p"; "~~~w"; "~~~{"; "~~~}"]); ];
     List.iter (alco_check Alcotest.string (trace_true Shrink.string) "on repeated success")
@@ -113,6 +113,42 @@ module Shrink = struct
         ("string \"E'*\"",  "E'*",  ["E'"; ""]);
         ("string \"vi5x92xgG\"", "vi5x92xgG", ["vi5x9"; "vi5"; "vi"; ""]); ]
 
+  let test_int_list () =
+    List.iter (alco_check Alcotest.(list int) (trace_false (Shrink.list_spine)) "on repeated failure")
+      [ ("list int [0]",       [0],       [[]]);
+        ("list int [0;1]",     [0;1],     [[]; [0]; [1]]);
+        ("list int [0;1;2]",   [0;1;2],   [[0; 1]; [2]; [0; 2]; [1; 2]]);
+        ("list int [0;1;2;3]", [0;1;2;3], [[0; 1]; [2; 3]; [0; 2; 3]; [1; 2; 3]]);
+        ("list int [0;0]",     [0;0],     [[]; [0]]);
+        ("list int [0;0;0]",   [0;0;0],   [[0; 0]; [0]; [0; 0]]);
+        ("list int [0;0;0;0]", [0;0;0;0], [[0; 0]; [0; 0]; [0; 0; 0]]); ];
+    List.iter (alco_check Alcotest.(list int) (trace_true (Shrink.list_spine)) "on repeated success")
+      [ ("list int [0]",       [0],       [[]]);
+        ("list int [0;1]",     [0;1],     [[]]);
+        ("list int [0;1;2]",   [0;1;2],   [[0; 1]; []]);
+        ("list int [0;1;2;3]", [0;1;2;3], [[0; 1]; []]);
+        ("list int [0;0]",     [0;0],     [[]]);
+        ("list int [0;0;0]",   [0;0;0],   [[0; 0]; []]);
+        ("list int [0;0;0;0]", [0;0;0;0], [[0; 0]; []]); ]
+
+  let test_int32_list () = (* use int32 as a boxed type and List.map to force run-time allocations *)
+    List.iter (alco_check Alcotest.(list int32) (trace_false (Shrink.list_spine)) "on repeated failure")
+      [ ("list int32 [0l]",          List.map Int32.of_int [0],       [[]]);
+        ("list int32 [0l;1l]",       List.map Int32.of_int [0;1],     [[]; [0l]; [1l]]);
+        ("list int32 [0l;1l;2l]",    List.map Int32.of_int [0;1;2],   [[0l; 1l]; [2l]; [0l; 2l]; [1l; 2l]]);
+        ("list int32 [0l;1l;2l;3l]", List.map Int32.of_int [0;1;2;3], [[0l; 1l]; [2l; 3l]; [0l; 2l; 3l]; [1l; 2l; 3l]]);
+        ("list int32 [0l;0l]",       List.map Int32.of_int [0;0],     [[]; [0l]]);
+        ("list int32 [0l;0l;0l]",    List.map Int32.of_int [0;0;0],   [[0l; 0l]; [0l]; [0l; 0l]]);
+        ("list int32 [0l;0l;0l;0l]", List.map Int32.of_int [0;0;0;0], [[0l; 0l]; [0l; 0l]; [0l; 0l; 0l]]); ];
+    List.iter (alco_check Alcotest.(list int32) (trace_true (Shrink.list_spine)) "on repeated success")
+      [ ("list int [0l]",          List.map Int32.of_int [0],       [[]]);
+        ("list int [0l;1l]",       List.map Int32.of_int [0;1],     [[]]);
+        ("list int [0l;1l;2l]",    List.map Int32.of_int [0;1;2],   [[0l; 1l]; []]);
+        ("list int [0l;1l;2l;3l]", List.map Int32.of_int [0;1;2;3], [[0l; 1l]; []]);
+        ("list int [0l;0l]",       List.map Int32.of_int [0;0],     [[]]);
+        ("list int [0l;0l;0l]",    List.map Int32.of_int [0;0;0],   [[0l; 0l]; []]);
+        ("list int [0l;0l;0l;0l]", List.map Int32.of_int [0;0;0;0], [[0l; 0l]; []]); ]
+
   let test_list_spine_compare () =
     let run_test () = QCheck.Shrink.list_spine [pred;succ] ignore in
     Alcotest.(check unit) "doesn't compare elements" () @@ run_test ()
@@ -125,6 +161,8 @@ module Shrink = struct
       test_case "char_numeral"   `Quick test_char_numeral;
       test_case "char_printable" `Quick test_char_printable;
       test_case "string" `Quick test_string;
+      test_case "int list" `Quick test_int_list;
+      test_case "int32 list" `Quick test_int32_list;
       test_case "list_spine" `Quick test_list_spine_compare;
     ])
 end