Merge pull request #321 from jmid/further-qcheck2-list-improvements

Further QCheck2 list shrinker improvements

CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## NEXT RELEASE
 
+- Adjust the `QCheck2.Gen.list` shrinker to produce minimal counterexamples at size 3 too
 - Replace the `QCheck2` OCaml 4 `Random.State.split` hack with a faster one
 - Improve the `QCheck2.Gen.list` shrinker heuristic and utilize the improved
   shrinker in other `QCheck2` `{list,array,bytes,string,function}*` shrinkers

src/core/QCheck2.ml

@@ -267,30 +267,38 @@ module Tree = struct
     | (0, _) | (_, []) -> pure []
     | (n, (tree :: trees)) -> liftA2 List.cons tree (applicative_take (pred n) trees)
 
+  (** [drop_one l []] returns all versions of [l] with one element removed, for example
+      [drop_one [1;2;3] [] = [ [2;3]; [1;3]; [1;2] ]] *)
+  let rec drop_one (l : 'a list) (rev_prefix : 'a list) : 'a list list = match l with
+    | [] -> []
+    | x::xs -> (List.rev rev_prefix @ xs) :: drop_one xs (x::rev_prefix)
+
   let rec build_list_shrink_tree (l : 'a t list) : 'a list t Seq.t = match l with
     | [] -> Seq.empty
-    | [_] ->
-      fun () -> Seq.cons (Tree ([], Seq.empty))   (* [x] leaves only empty list to try *)
-                  (children (sequence_list l)) () (* otherwise, reduce element(s) *)
     | _::_ ->
       fun () ->
         let len = List.length l in
-        let xs,ys = list_split l ((1 + len) / 2) [] in
-        let xs_roots = List.map root xs in
-        let ys_roots = List.map root ys in
-        (* Try reducing a list [1;2;3;4] in halves: [1;2] and [3;4] *)
-        Seq.cons (Tree (xs_roots, build_list_shrink_tree xs))
-          (Seq.cons (Tree (ys_roots, build_list_shrink_tree ys))
-             (fun () ->
-                (if len >= 4
-                 then (* Try dropping an element from either half: [2;3;4] and [1;2;4] *)
-                   let rest = List.tl l in
-                   let rest_roots = List.map root rest in
-                   (Seq.cons (Tree (rest_roots, build_list_shrink_tree rest))
-                      (Seq.cons (Tree (xs_roots@(List.tl ys_roots), build_list_shrink_tree (xs@(List.tl ys))))
-                         (children (sequence_list l))))     (* at bottom: reduce elements *)
-                 else
-                   children (sequence_list l)) ())) ()
+        if len < 4 then
+          let candidates = drop_one l [] in
+          List.fold_right (* try dropping each element in turn, starting with the list head *)
+            (fun cand acc -> Seq.cons (Tree (List.map root cand, build_list_shrink_tree cand)) acc)
+            candidates
+            (fun () -> children (sequence_list l) ()) ()  (* otherwise, reduce element(s) *)
+        else
+          let xs,ys = list_split l ((1 + len) / 2) [] in
+          let xs_roots = List.map root xs in
+          let ys_roots = List.map root ys in
+          (* Try reducing a list [1;2;3;4] in halves: [1;2] and [3;4] *)
+          Seq.cons (Tree (xs_roots, build_list_shrink_tree xs))
+            (Seq.cons (Tree (ys_roots, build_list_shrink_tree ys))
+               (fun () ->
+                  (* Try dropping an element from either half: [2;3;4] and [1;2;4] *)
+                  let rest = List.tl l in
+                  let rest_roots = List.map root rest in
+                  (Seq.cons (Tree (rest_roots, build_list_shrink_tree rest))
+                     (Seq.cons (Tree (xs_roots@(List.tl ys_roots), build_list_shrink_tree (xs@(List.tl ys))))
+                        (fun () -> children (sequence_list l) ())))  (* at bottom: reduce elements *)
+                    () )) ()
 end
 
 module Gen = struct

test/core/QCheck2_expect_test.expected.ocaml4.32

@@ -73,8 +73,9 @@ random seed: 1234
 [0; 13; 4; 6; 14; 6; 47; 3]
 [0; 13; 4; 6]
 [0; 13]
-[0]
+[13]
 []
+[0]
 [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]
 [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]
 [0; 13; 4; 6; 14; 6; 47; 3; 4; 3; 6; 6; 9; 4; 3; 65]
@@ -89,14 +90,16 @@ random seed: 1234
 [6; 47; 3]
 [6; 14; 6; 47; 3]
 [6; 14; 6]
-[6; 14]
+[14; 6]
+[6; 6]
+[6]
 [6]
-[0; 14; 6]
-[3; 14; 6]
-[5; 14; 6]
-[6; 0; 6]
-[0; 0; 6]
-[0; 0; 0]
+[0; 6]
+[3; 6]
+[5; 6]
+[6; 0]
+[6; 3]
+[6; 5]
 
 --- Failure --------------------------------------------------------------------
 
@@ -308,15 +311,15 @@ Test bytes never has a \000 char failed (13 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test bytes never has a \255 char failed (5 shrink steps):
+Test bytes never has a \255 char failed (6 shrink steps):
 
 "\255"
 
 --- Failure --------------------------------------------------------------------
 
-Test bytes have unique chars failed (16 shrink steps):
+Test bytes have unique chars failed (13 shrink steps):
 
-"aaa"
+"**"
 
 --- Failure --------------------------------------------------------------------
 
@@ -332,15 +335,15 @@ Test string never has a \000 char failed (13 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test string never has a \255 char failed (5 shrink steps):
+Test string never has a \255 char failed (6 shrink steps):
 
 "\255"
 
 --- Failure --------------------------------------------------------------------
 
-Test strings have unique chars failed (16 shrink steps):
+Test strings have unique chars failed (13 shrink steps):
 
-"aaa"
+"**"
 
 --- Failure --------------------------------------------------------------------
 
@@ -386,13 +389,13 @@ Test pairs sum to less than 128 failed (26 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test pairs lists rev concat failed (34 shrink steps):
+Test pairs lists rev concat failed (30 shrink steps):
 
 ([0], [1])
 
 --- Failure --------------------------------------------------------------------
 
-Test pairs lists no overlap failed (12 shrink steps):
+Test pairs lists no overlap failed (13 shrink steps):
 
 ([0], [0])
 
@@ -506,7 +509,7 @@ Test bind list_size constant failed (12 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test lists are empty failed (6 shrink steps):
+Test lists are empty failed (7 shrink steps):
 
 [0]
 
@@ -530,9 +533,9 @@ Test lists shorter than 4332 failed (4022 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test lists have unique elems failed (10 shrink steps):
+Test lists have unique elems failed (8 shrink steps):
 
-[0; 0; 0]
+[6; 6]
 
 --- Failure --------------------------------------------------------------------
 
@@ -572,31 +575,31 @@ Test sum list = 0 failed (0 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_map_commute_int failed (53 shrink steps):
+Test fail_pred_map_commute_int failed (55 shrink steps):
 
 ([0], {0 -> 5; _ -> 0}, {5 -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_map_commute_int32 failed (54 shrink steps):
+Test fail_pred_map_commute_int32 failed (57 shrink steps):
 
 ([0l], {0l -> -15l; _ -> 0l}, {-15l -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_map_commute_int64 failed (105 shrink steps):
+Test fail_pred_map_commute_int64 failed (107 shrink steps):
 
 ([0L], {0L -> -71L; _ -> 0L}, {-71L -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_strings failed (0 shrink steps):
+Test fail_pred_strings failed (1 shrink steps):
 
-{"some random string" -> true; "some other string" -> false; _ -> false}
+{"some random string" -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
-Test fold_left fold_right failed (17 shrink steps):
+Test fold_left fold_right failed (20 shrink steps):
 
 (0, [1], {(0, 1) -> 1; _ -> 0})
 
@@ -609,9 +612,9 @@ l=[1], fold_left=0, fold_right=1
 
 --- Failure --------------------------------------------------------------------
 
-Test fold_left fold_right uncurried failed (14 shrink steps):
+Test fold_left fold_right uncurried failed (17 shrink steps):
 
-({(9, 6) -> 0; (1, 5) -> 0; (4, 8) -> 1; (9, 8) -> 0; _ -> 0}, 8, [4])
+({(9, 6) -> 0; (1, 5) -> 0; (4, 8) -> 0; (9, 8) -> 1; _ -> 0}, 8, [9])
 
 --- Failure --------------------------------------------------------------------
 

test/core/QCheck2_expect_test.expected.ocaml4.64

@@ -135,8 +135,9 @@ random seed: 1234
 [0; 13; 4; 6; 14; 6; 47; 3]
 [0; 13; 4; 6]
 [0; 13]
-[0]
+[13]
 []
+[0]
 [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]
 [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]
 [0; 13; 4; 6; 14; 6; 47; 3; 4; 3; 6; 6; 9; 4; 3; 65]
@@ -151,14 +152,16 @@ random seed: 1234
 [6; 47; 3]
 [6; 14; 6; 47; 3]
 [6; 14; 6]
-[6; 14]
+[14; 6]
+[6; 6]
+[6]
 [6]
-[0; 14; 6]
-[3; 14; 6]
-[5; 14; 6]
-[6; 0; 6]
-[0; 0; 6]
-[0; 0; 0]
+[0; 6]
+[3; 6]
+[5; 6]
+[6; 0]
+[6; 3]
+[6; 5]
 
 --- Failure --------------------------------------------------------------------
 
@@ -370,15 +373,15 @@ Test bytes never has a \000 char failed (13 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test bytes never has a \255 char failed (5 shrink steps):
+Test bytes never has a \255 char failed (6 shrink steps):
 
 "\255"
 
 --- Failure --------------------------------------------------------------------
 
-Test bytes have unique chars failed (16 shrink steps):
+Test bytes have unique chars failed (13 shrink steps):
 
-"aaa"
+"**"
 
 --- Failure --------------------------------------------------------------------
 
@@ -394,15 +397,15 @@ Test string never has a \000 char failed (13 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test string never has a \255 char failed (5 shrink steps):
+Test string never has a \255 char failed (6 shrink steps):
 
 "\255"
 
 --- Failure --------------------------------------------------------------------
 
-Test strings have unique chars failed (16 shrink steps):
+Test strings have unique chars failed (13 shrink steps):
 
-"aaa"
+"**"
 
 --- Failure --------------------------------------------------------------------
 
@@ -454,7 +457,7 @@ Test pairs lists rev concat failed (66 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test pairs lists no overlap failed (12 shrink steps):
+Test pairs lists no overlap failed (13 shrink steps):
 
 ([0], [0])
 
@@ -568,7 +571,7 @@ Test bind list_size constant failed (12 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test lists are empty failed (6 shrink steps):
+Test lists are empty failed (7 shrink steps):
 
 [0]
 
@@ -592,9 +595,9 @@ Test lists shorter than 4332 failed (4022 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test lists have unique elems failed (10 shrink steps):
+Test lists have unique elems failed (8 shrink steps):
 
-[0; 0; 0]
+[6; 6]
 
 --- Failure --------------------------------------------------------------------
 
@@ -634,31 +637,31 @@ Test sum list = 0 failed (0 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_map_commute_int failed (105 shrink steps):
+Test fail_pred_map_commute_int failed (107 shrink steps):
 
 ([0], {0 -> 29; _ -> 0}, {29 -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_map_commute_int32 failed (54 shrink steps):
+Test fail_pred_map_commute_int32 failed (57 shrink steps):
 
 ([0l], {0l -> -15l; _ -> 0l}, {-15l -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_map_commute_int64 failed (105 shrink steps):
+Test fail_pred_map_commute_int64 failed (107 shrink steps):
 
 ([0L], {0L -> -71L; _ -> 0L}, {-71L -> true; _ -> false})
 
 --- Failure --------------------------------------------------------------------
 
-Test fail_pred_strings failed (0 shrink steps):
+Test fail_pred_strings failed (1 shrink steps):
 
-{"some random string" -> true; "some other string" -> false; _ -> false}
+{"some random string" -> true; _ -> false}
 
 --- Failure --------------------------------------------------------------------
 
-Test fold_left fold_right failed (17 shrink steps):
+Test fold_left fold_right failed (20 shrink steps):
 
 (0, [1], {(0, 1) -> 1; _ -> 0})
 
@@ -671,9 +674,9 @@ l=[1], fold_left=0, fold_right=1
 
 --- Failure --------------------------------------------------------------------
 
-Test fold_left fold_right uncurried failed (14 shrink steps):
+Test fold_left fold_right uncurried failed (17 shrink steps):
 
-({(9, 6) -> 0; (1, 5) -> 0; (4, 8) -> 1; (9, 8) -> 0; _ -> 0}, 8, [4])
+({(9, 6) -> 0; (1, 5) -> 0; (4, 8) -> 0; (9, 8) -> 1; _ -> 0}, 8, [9])
 
 --- Failure --------------------------------------------------------------------