diff --git a/CHANGELOG.md b/CHANGELOG.md index 6319a2c8..0d6a2904 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/src/core/QCheck.ml b/src/core/QCheck.ml index 2809e6ed..b67a4ca1 100644 --- a/src/core/QCheck.ml +++ b/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 diff --git a/test/core/QCheck_expect_test.expected.ocaml4.32 b/test/core/QCheck_expect_test.expected.ocaml4.32 index e5de618b..865566a8 100644 --- a/test/core/QCheck_expect_test.expected.ocaml4.32 +++ b/test/core/QCheck_expect_test.expected.ocaml4.32 @@ -74,7 +74,6 @@ random seed: 1234 [1; 1] [] [1] -[1] [0; 1] [1; 0] diff --git a/test/core/QCheck_expect_test.expected.ocaml4.64 b/test/core/QCheck_expect_test.expected.ocaml4.64 index 7accc9a8..4b32e050 100644 --- a/test/core/QCheck_expect_test.expected.ocaml4.64 +++ b/test/core/QCheck_expect_test.expected.ocaml4.64 @@ -106,7 +106,6 @@ random seed: 1234 [1; 1] [] [1] -[1] [0; 1] [1; 0] diff --git a/test/core/QCheck_expect_test.expected.ocaml5.32 b/test/core/QCheck_expect_test.expected.ocaml5.32 index f5ec356f..c8218b2e 100644 --- a/test/core/QCheck_expect_test.expected.ocaml5.32 +++ b/test/core/QCheck_expect_test.expected.ocaml5.32 @@ -84,7 +84,6 @@ random seed: 1234 [2; 2] [] [2] -[2] [1; 2] [2; 1] diff --git a/test/core/QCheck_expect_test.expected.ocaml5.64 b/test/core/QCheck_expect_test.expected.ocaml5.64 index 1572ed29..ed35317c 100644 --- a/test/core/QCheck_expect_test.expected.ocaml5.64 +++ b/test/core/QCheck_expect_test.expected.ocaml5.64 @@ -116,7 +116,6 @@ random seed: 1234 [2; 2] [] [2] -[2] [1; 2] [2; 1] diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml index 5360376f..01375af3 100644 --- a/test/core/QCheck_unit_tests.ml +++ b/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