From c6e72099a50fe24c1f954f2eb27e45720ef0bc7d Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 17 Aug 2023 17:34:22 +0200 Subject: [PATCH 1/8] Reintroduce list shrinker optimization using an address comparison instead --- src/core/QCheck.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/QCheck.ml b/src/core/QCheck.ml index 2809e6ed..20f5fcdc 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 x != y then yield [y] | _::_ -> let len = List.length l in let xs,ys = split l ((1 + len) / 2) [] in From 18e63a1d2b43180e7f6cbb97c634c2b8b5fce637 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 17 Aug 2023 17:42:34 +0200 Subject: [PATCH 2/8] Update expect test outputs --- test/core/QCheck_expect_test.expected.ocaml4.32 | 1 - test/core/QCheck_expect_test.expected.ocaml4.64 | 1 - test/core/QCheck_expect_test.expected.ocaml5.32 | 1 - test/core/QCheck_expect_test.expected.ocaml5.64 | 1 - 4 files changed, 4 deletions(-) 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] From 36e15374ceb2bfe2dc4c5073df9408f4feaf9825 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 17 Aug 2023 17:42:51 +0200 Subject: [PATCH 3/8] Update unit test output --- test/core/QCheck_unit_tests.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml index 5360376f..19d31421 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") From 1b3e1a0119cee716a0edcdb459d7c3fbbc62b360 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 17 Aug 2023 17:47:06 +0200 Subject: [PATCH 4/8] Add a CHANGELOG entry --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6319a2c8..1fa5698b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,8 @@ ## NEXT RELEASE -- fix #273 by lowering `ppx_deriving_qcheck`'s `qcheck` dependency to `qcheck-core` +- Reintroduce the `Shrink.list_spine` fix using an address comparison instead. +- Fix #273 by lowering `ppx_deriving_qcheck`'s `qcheck` dependency to `qcheck-core` ## 0.21.1 From 0fc57342d68ecaec33cb77dd3591f5320a86470c Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 22 Aug 2023 14:20:34 +0200 Subject: [PATCH 5/8] Add unit tests of Shrink.list_spine --- test/core/QCheck_unit_tests.ml | 38 ++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml index 19d31421..8b433a33 100644 --- a/test/core/QCheck_unit_tests.ml +++ b/test/core/QCheck_unit_tests.ml @@ -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]; [0l]]); + ("list int32 [0l;0l;0l]", List.map Int32.of_int [0;0;0], [[0l; 0l]; [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]; [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 From 6f3762e59ac8a12c28fd60a1125acc130375e512 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 22 Aug 2023 14:22:33 +0200 Subject: [PATCH 6/8] Use @shym's suggestion --- src/core/QCheck.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/QCheck.ml b/src/core/QCheck.ml index 20f5fcdc..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]; if x != y then 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 From 917ebae2f2e869777f14cdc21b6814d28f7465a9 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 22 Aug 2023 14:24:11 +0200 Subject: [PATCH 7/8] Update unit test outputs --- test/core/QCheck_unit_tests.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml index 8b433a33..01375af3 100644 --- a/test/core/QCheck_unit_tests.ml +++ b/test/core/QCheck_unit_tests.ml @@ -137,9 +137,9 @@ module Shrink = struct ("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]; [0l]]); - ("list int32 [0l;0l;0l]", List.map Int32.of_int [0;0;0], [[0l; 0l]; [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]; [0l; 0l; 0l]]); ]; + ("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], [[]]); From ca2c049982d6b649ce5d931f2886d5967b5145c4 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 22 Aug 2023 14:30:32 +0200 Subject: [PATCH 8/8] Update CHANGELOG entry --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1fa5698b..0d6a2904 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,8 @@ ## NEXT RELEASE -- Reintroduce the `Shrink.list_spine` fix using an address comparison instead. +- 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