diff --git a/CHANGELOG.md b/CHANGELOG.md
index a15b964..515ccdb 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,30 @@
 # Changes
 
+## 0.19
+
+- add optional `debug_shrink` parameters in alcotest interface and
+  expose default `debug_shrinking_choices` in test runners
+
+- add missing `?handler` parameter to `Test.check_cell_exn`
+
+- remove `--no-buffer` option on `dune runtest` to avoid garbling the
+  test output
+
+- add an option `retries` parameter `Test.make` et al. for checking a
+  property repeatedly while shrinking.
+  This can be useful when testing non-deterministic code.
+  [#212](https://github.com/c-cube/qcheck/pull/212)
+
+- add tup2 to tup9 for generators
+
+- documentation updates:
+  - clarify upper bound inclusion in `Gen.int_bound` and `Gen.int_range`
+  - clarify `printable_char` and `Gen.printable` distributions
+  - add missing `string_gen_of_size` and `small_printable_string` documentation
+  - document `QCheck_alcotest.to_alcotest`
+  - fix documented size distribution for `arbitrary` generators
+    `string_gen`, `string`, `printable_string`, `numeral_string`, `list`, and `array`
+
 ## 0.18.1
 
 - fix `Gen.{nat,pos}_split{2,}`
diff --git a/Makefile b/Makefile
index cf92114..aed037c 100644
--- a/Makefile
+++ b/Makefile
@@ -5,7 +5,7 @@ build:
 	@dune build @install
 
 test:
-	@dune runtest --no-buffer --force
+	@dune runtest --force
 
 clean:
 	@dune clean
diff --git a/debian/changelog b/debian/changelog
index bb33ef8..cd663e8 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+ocaml-qcheck (0.18.1+git20220309.1.e92837e-1) UNRELEASED; urgency=low
+
+  * New upstream snapshot.
+
+ -- Debian Janitor <janitor@jelmer.uk>  Sun, 20 Mar 2022 13:42:23 -0000
+
 ocaml-qcheck (0.18.1-2) unstable; urgency=medium
 
   * Team upload
diff --git a/example/alcotest/QCheck_alcotest_test.ml b/example/alcotest/QCheck_alcotest_test.ml
index 5df257f..3b72c16 100644
--- a/example/alcotest/QCheck_alcotest_test.ml
+++ b/example/alcotest/QCheck_alcotest_test.ml
@@ -48,6 +48,13 @@ let passing_tree_rev =
     QCheck.(make gen_tree)
     (fun tree -> rev_tree (rev_tree tree) = tree)
 
+let debug_shrink =
+  QCheck.Test.make ~count:10
+    ~name:"debug_shrink"
+    (* we use a very constrained test to have a smaller shrinking tree *)
+    QCheck.(pair (1 -- 3) (1 -- 3))
+    (fun (a, b) -> a = b);;
+
 let () =
   Printexc.record_backtrace true;
   let module A = Alcotest in
@@ -55,6 +62,9 @@ let () =
     List.map QCheck_alcotest.to_alcotest
       [ passing; failing; error; simple_qcheck; passing_tree_rev ]
   in
-  A.run "my test" [
-    "suite", suite
-  ]
+  A.run ~show_errors:true "my test" [
+    "suite", suite;
+    "shrinking", [
+      QCheck_alcotest.to_alcotest ~verbose:true ~debug_shrink:(Some stdout) debug_shrink
+    ];
+  ];
diff --git a/example/alcotest/output.txt.expected b/example/alcotest/output.txt.expected
index 9564333..79e4f3c 100644
--- a/example/alcotest/output.txt.expected
+++ b/example/alcotest/output.txt.expected
@@ -1,14 +1,60 @@
 qcheck random seed: 1234
 Testing `my test'.
-  [OK]          suite          0   list_rev_is_involutive.
-> [FAIL]        suite          1   fail_sort_id.
-  [FAIL]        suite          2   error_raise_exn.
-  [FAIL]        suite          3   fail_check_err_message.
-  [OK]          suite          4   tree_rev_is_involutive.
+  [OK]          suite              0   list_rev_is_involutive.
+  [FAIL]        suite              1   fail_sort_id.
+  [FAIL]        suite              2   error_raise_exn.
+  [FAIL]        suite              3   fail_check_err_message.
+  [OK]          suite              4   tree_rev_is_involutive.
+  [FAIL]        shrinking          0   debug_shrink.
 ┌──────────────────────────────────────────────────────────────────────────────┐
-│ [FAIL]        suite          1   fail_sort_id.                               │
+│ [FAIL]        suite              1   fail_sort_id.                           │
 └──────────────────────────────────────────────────────────────────────────────┘
 test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps)
 [exception] test `fail_sort_id` failed on ≥ 1 cases: [1; 0] (after 20 shrink steps)
  ──────────────────────────────────────────────────────────────────────────────
-3 failures! 5 tests run.
+┌──────────────────────────────────────────────────────────────────────────────┐
+│ [FAIL]        suite              2   error_raise_exn.                        │
+└──────────────────────────────────────────────────────────────────────────────┘
+test `error_raise_exn`
+raised exception `Error`
+on `0 (after 63 shrink steps)`
+[exception] test `error_raise_exn`
+raised exception `Error`
+on `0 (after 63 shrink steps)`
+ ──────────────────────────────────────────────────────────────────────────────
+┌──────────────────────────────────────────────────────────────────────────────┐
+│ [FAIL]        suite              3   fail_check_err_message.                 │
+└──────────────────────────────────────────────────────────────────────────────┘
+test `fail_check_err_message` failed on ≥ 1 cases:
+0 (after 7 shrink steps)
+this
+will
+always
+fail
+[exception] test `fail_check_err_message` failed on ≥ 1 cases:
+0 (after 7 shrink steps)
+this
+will
+always
+fail
+ ──────────────────────────────────────────────────────────────────────────────
+┌──────────────────────────────────────────────────────────────────────────────┐
+│ [FAIL]        shrinking          0   debug_shrink.                           │
+└──────────────────────────────────────────────────────────────────────────────┘
+~~~ Shrink ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Test debug_shrink successfully shrunk counter example (step 0) to:
+(3, 1)
+~~~ Shrink ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Test debug_shrink successfully shrunk counter example (step 1) to:
+(2, 1)
+~~~ Shrink ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Test debug_shrink successfully shrunk counter example (step 2) to:
+(2, 0)
+~~~ Shrink ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Test debug_shrink successfully shrunk counter example (step 3) to:
+(1, 0)
+law debug_shrink: 2 relevant cases (2 total)
+test `debug_shrink` failed on ≥ 1 cases: (1, 0) (after 3 shrink steps)
+[exception] test `debug_shrink` failed on ≥ 1 cases: (1, 0) (after 3 shrink steps)
+ ──────────────────────────────────────────────────────────────────────────────
+4 failures! 6 tests run.
diff --git a/example/alcotest/run_alcotest.sh b/example/alcotest/run_alcotest.sh
index d57e750..3565f42 100755
--- a/example/alcotest/run_alcotest.sh
+++ b/example/alcotest/run_alcotest.sh
@@ -12,6 +12,7 @@ echo "$OUT" | grep -v 'This run has ID' \
   | grep -v 'Raised at ' \
   | grep -v 'Called from ' \
   | sed 's/! in .*s\./!/' \
+  | sed 's/`.*.Error`/`Error`/g' \
   | sed 's/[ \t]*$//g' \
   | tr -s "\n"
 exit $CODE
diff --git a/ppx_deriving_qcheck.opam b/ppx_deriving_qcheck.opam
new file mode 100644
index 0000000..b4ca422
--- /dev/null
+++ b/ppx_deriving_qcheck.opam
@@ -0,0 +1,28 @@
+opam-version: "2.0"
+name: "ppx_deriving_qcheck"
+version: "0.2.0"
+license: "BSD-2-Clause"
+synopsis: "PPX Deriver for QCheck"
+
+maintainer: "valentin.chb@gmail.com"
+author: [ "the qcheck contributors" ]
+
+depends: [
+  "dune" {>= "2.8.0"}
+  "ocaml" {>= "4.08.0"}
+  "qcheck" {>= "0.17"}
+  "ppxlib" {>= "0.22.0"}
+  "ppx_deriving" {>= "5.2.1"}
+  "odoc" {with-doc}
+  "alcotest" {with-test & >= "1.4.0" }
+]
+
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc}
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
+]
+
+homepage: "https://github.com/c-cube/qcheck/"
+bug-reports: "https://github.com/c-cube/qcheck/-/issues"
+dev-repo: "git+https://github.com/vch9/ppx_deriving_qcheck.git"
diff --git a/qcheck-alcotest.opam b/qcheck-alcotest.opam
index 6c856a9..2c39f31 100644
--- a/qcheck-alcotest.opam
+++ b/qcheck-alcotest.opam
@@ -5,7 +5,7 @@ homepage: "https://github.com/c-cube/qcheck/"
 license: "BSD-2-Clause"
 synopsis: "Alcotest backend for qcheck"
 doc: ["http://c-cube.github.io/qcheck/"]
-version: "0.18.1"
+version: "0.18"
 tags: [
   "test"
   "quickcheck"
diff --git a/qcheck-core.opam b/qcheck-core.opam
index 037576b..6ad35a3 100644
--- a/qcheck-core.opam
+++ b/qcheck-core.opam
@@ -5,7 +5,7 @@ homepage: "https://github.com/c-cube/qcheck/"
 license: "BSD-2-Clause"
 synopsis: "Core qcheck library"
 doc: ["http://c-cube.github.io/qcheck/"]
-version: "0.18.1"
+version: "0.18"
 tags: [
   "test"
   "property"
diff --git a/qcheck-ounit.opam b/qcheck-ounit.opam
index 304f1d3..5075225 100644
--- a/qcheck-ounit.opam
+++ b/qcheck-ounit.opam
@@ -5,7 +5,7 @@ license: "BSD-2-Clause"
 homepage: "https://github.com/c-cube/qcheck/"
 doc: ["http://c-cube.github.io/qcheck/"]
 synopsis: "OUnit backend for qcheck"
-version: "0.18.1"
+version: "0.18"
 tags: [
   "qcheck"
   "quickcheck"
diff --git a/qcheck.opam b/qcheck.opam
index adc53a2..88995fa 100644
--- a/qcheck.opam
+++ b/qcheck.opam
@@ -5,7 +5,7 @@ synopsis: "Compatibility package for qcheck"
 homepage: "https://github.com/c-cube/qcheck/"
 license: "BSD-2-Clause"
 doc: ["http://c-cube.github.io/qcheck/"]
-version: "0.18.1"
+version: "0.18"
 tags: [
   "test"
   "property"
diff --git a/src/alcotest/QCheck_alcotest.ml b/src/alcotest/QCheck_alcotest.ml
index 6046af7..ea2b71a 100644
--- a/src/alcotest/QCheck_alcotest.ml
+++ b/src/alcotest/QCheck_alcotest.ml
@@ -33,13 +33,29 @@ let long_ = lazy (
 )
 
 let to_alcotest
-    ?(verbose=Lazy.force verbose_) ?(long=Lazy.force long_) ?(rand=default_rand())
+    ?(colors=false) ?(verbose=Lazy.force verbose_) ?(long=Lazy.force long_)
+    ?(debug_shrink = None) ?debug_shrink_list ?(rand=default_rand())
     (t:T.t) =
   let T.Test cell = t in
+  let handler name cell r =
+    match r, debug_shrink with
+    | QCheck2.Test.Shrunk (step, x), Some out ->
+      let go = match debug_shrink_list with
+        | None -> true
+        | Some test_list -> List.mem name test_list in
+      if not go then ()
+      else
+        QCheck_base_runner.debug_shrinking_choices
+          ~colors ~out ~name cell ~step x
+    | _ ->
+      ()
+  in
   let print = Raw.print_std in
   let run() =
-    T.check_cell_exn cell
-      ~long ~rand ~call:(Raw.callback ~colors:false ~verbose ~print_res:true ~print)
+    let call = Raw.callback ~colors ~verbose ~print_res:true ~print in
+    T.check_cell_exn
+      ~long ~call ~handler ~rand
+      cell
   in
   let name = T.get_name cell in
-  name, `Slow, run
+  ((name, `Slow, run) : unit Alcotest.test_case)
diff --git a/src/alcotest/QCheck_alcotest.mli b/src/alcotest/QCheck_alcotest.mli
index 0d0836d..9177566 100644
--- a/src/alcotest/QCheck_alcotest.mli
+++ b/src/alcotest/QCheck_alcotest.mli
@@ -12,10 +12,18 @@
 *)
 
 val to_alcotest :
-  ?verbose:bool -> ?long:bool -> ?rand:Random.State.t ->
+  ?colors:bool -> ?verbose:bool -> ?long:bool ->
+  ?debug_shrink:(out_channel option) ->
+  ?debug_shrink_list:(string list) ->
+  ?rand:Random.State.t ->
   QCheck2.Test.t -> unit Alcotest.test_case
-(** Convert a qcheck test into an alcotest test
-    @param verbose used to print information on stdout (default: [verbose()])
-    @param rand the random generator to use (default: [random_state ()])
+(** Convert a qcheck test into an alcotest test.
+
+    In addition to the environment variables mentioned above, you can control
+    the behavior of QCheck tests using optional parameters that behave in the
+    same way as the parameters of {!QCheck_base_runner.run_tests}.
+
     @since 0.9
+    @since 0.9 parameters [verbose], [long], [rand]
+    @since NEXT_VERSION parameters [colors], [debug_shrink], [debug_shrink_list]
 *)
diff --git a/src/core/QCheck.ml b/src/core/QCheck.ml
index aa1b934..cce2e9d 100644
--- a/src/core/QCheck.ml
+++ b/src/core/QCheck.ml
@@ -42,6 +42,28 @@ let _opt_map_4 ~f a b c d = match a, b, c, d with
   | Some x, Some y, Some z, Some w -> Some (f x y z w)
   | _ -> None
 
+let _opt_map_5 ~f a b c d e = match a, b, c, d, e with
+  | Some x, Some y, Some z, Some u, Some v -> Some (f x y z u v)
+  | _ -> None
+
+let _opt_map_6 ~f a b c d e g = match a, b, c, d, e, g with
+  | Some a, Some b, Some c, Some d, Some e, Some g -> Some (f a b c d e g)
+  | _ -> None
+
+let _opt_map_7 ~f a b c d e g h = match a, b, c, d, e, g, h with
+  | Some a, Some b, Some c, Some d, Some e, Some g, Some h -> Some (f a b c d e g h)
+  | _ -> None
+
+let _opt_map_8 ~f a b c d e g h i = match a, b, c, d, e, g, h, i with
+  | Some a, Some b, Some c, Some d, Some e, Some g, Some h, Some i ->
+    Some (f a b c d e g h i)
+  | _ -> None
+
+let _opt_map_9 ~f a b c d e g h i j = match a, b, c, d, e, g, h, i, j with
+  | Some a, Some b, Some c, Some d, Some e, Some g, Some h, Some i, Some j ->
+    Some (f a b c d e g h i j)
+  | _ -> None
+
 let _opt_sum a b = match a, b with
   | Some _, _ -> a
   | None, _ -> b
@@ -283,6 +305,27 @@ module Gen = struct
 
   let char st = char_of_int (RS.int st 256)
 
+  let tup2 = pair
+
+  let tup3 = triple
+
+  let tup4 = quad
+
+  let tup5 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) : ('a * 'b * 'c * 'd * 'e) t =
+    (fun a b c d e -> (a, b, c, d, e)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5
+
+  let tup6 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) (g6 : 'f t) : ('a * 'b * 'c * 'd * 'e * 'f) t =
+    (fun a b c d e f -> (a, b, c, d, e, f)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5 <*> g6
+
+  let tup7 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) (g6 : 'f t) (g7 : 'g t) : ('a * 'b * 'c * 'd * 'e * 'f * 'g) t =
+    (fun a b c d e f g -> (a, b, c, d, e, f, g)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5 <*> g6 <*> g7
+
+  let tup8 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) (g6 : 'f t) (g7 : 'g t) (g8 : 'h t) : ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) t =
+    (fun a b c d e f g h -> (a, b, c, d, e, f, g, h)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5 <*> g6 <*> g7 <*> g8
+
+  let tup9 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) (g6 : 'f t) (g7 : 'g t) (g8 : 'h t) (g9 : 'i t) : ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) t =
+    (fun a b c d e f g h i -> (a, b, c, d, e, f, g, h, i)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5 <*> g6 <*> g7 <*> g8 <*> g9
+
   let printable_chars =
     let l = 126-32+1 in
     let s = Bytes.create l in
@@ -404,6 +447,121 @@ module Print = struct
   let quad a b c d (x,y,z,w) =
     Printf.sprintf "(%s, %s, %s, %s)" (a x) (b y) (c z) (d w)
 
+  let default = fun _ -> "<no printer>"
+
+  let tup2 p_a p_b (a, b) =
+    Printf.sprintf "(%s, %s)" (p_a a) (p_b b)
+
+  let tup2_opt p_a p_b (a, b) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    tup2 p_a p_b (a, b)
+
+  let tup3 p_a p_b (p_c) (a, b, c) =
+    Printf.sprintf "(%s, %s, %s)" (p_a a) (p_b b) (p_c c)
+
+  let tup3_opt p_a p_b p_c (a, b, c) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    tup3 p_a p_b p_c (a, b, c)
+
+  let tup4 p_a p_b p_c p_d (a, b, c, d) =
+    Printf.sprintf "(%s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+
+  let tup4_opt p_a p_b p_c p_d (a, b, c, d) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    tup4 p_a p_b p_c p_d (a, b, c, d)
+
+  let tup5 p_a p_b p_c p_d p_e (a, b, c, d, e) =
+    Printf.sprintf "(%s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e)
+
+  let tup5_opt p_a p_b p_c p_d p_e (a, b, c, d, e) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    tup5 p_a p_b p_c p_d p_e (a, b, c, d, e)
+
+  let tup6 p_a p_b p_c p_d p_e p_f (a, b, c, d, e, f) =
+    Printf.sprintf "(%s, %s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e) (p_f f)
+
+  let tup6_opt p_a p_b p_c p_d p_e p_f (a, b, c, d, e, f) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    let p_f = Option.value ~default p_f in
+    tup6 p_a p_b p_c p_d p_e p_f (a, b, c, d, e, f)
+
+  let tup7 p_a p_b p_c p_d p_e p_f p_g (a, b, c, d, e, f, g) =
+    Printf.sprintf "(%s, %s, %s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e) (p_f f)
+      (p_g g)
+
+  let tup7_opt p_a p_b p_c p_d p_e p_f p_g (a, b, c, d, e, f, g) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    let p_f = Option.value ~default p_f in
+    let p_g = Option.value ~default p_g in
+    tup7 p_a p_b p_c p_d p_e p_f p_g (a, b, c, d, e, f, g)
+
+  let tup8 p_a p_b p_c p_d p_e p_f p_g p_h (a, b, c, d, e, f, g, h) =
+    Printf.sprintf "(%s, %s, %s, %s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e) (p_f f)
+      (p_g g) (p_h h)
+
+  let tup8_opt p_a p_b p_c p_d p_e p_f p_g p_h (a, b, c, d, e, f, g, h) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    let p_f = Option.value ~default p_f in
+    let p_g = Option.value ~default p_g in
+    let p_h = Option.value ~default p_h in
+    tup8 p_a p_b p_c p_d p_e p_f p_g p_h (a, b, c, d, e, f, g, h)
+
+  let tup9 p_a p_b p_c p_d p_e p_f p_g p_h p_i (a, b, c, d, e, f, g, h, i) =
+    Printf.sprintf "(%s, %s, %s, %s, %s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e) (p_f f)
+      (p_g g) (p_h h)
+      (p_i i)
+
+  let tup9_opt p_a p_b p_c p_d p_e p_f p_g p_h p_i (a, b, c, d, e, f, g, h, i) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    let p_f = Option.value ~default p_f in
+    let p_g = Option.value ~default p_g in
+    let p_h = Option.value ~default p_h in
+    let p_i = Option.value ~default p_i in
+    tup9 p_a p_b p_c p_d p_e p_f p_g p_h p_i (a, b, c, d, e, f, g, h, i)
+
   let list pp l =
     let b = Buffer.create 25 in
     Buffer.add_char b '[';
@@ -613,6 +771,127 @@ module Shrink = struct
     b y (fun y' -> yield (x,y',z,w));
     c z (fun z' -> yield (x,y,z',w));
     d w (fun w' -> yield (x,y,z,w'))
+
+  let default = nil
+
+  let tup2 = pair
+
+  let tup2_opt a b =
+    let a = Option.value ~default a in
+    let b = Option.value ~default b in
+    tup2 a b
+
+  let tup3 = triple
+
+  let tup3_opt a b c =
+    let a = Option.value ~default a in
+    let b = Option.value ~default b in
+    let c = Option.value ~default c in
+    tup3 a b c
+
+  let tup4 = quad
+
+  let tup4_opt a b c d =
+    let a = Option.value ~default a in
+    let b = Option.value ~default b in
+    let c = Option.value ~default c in
+    let d = Option.value ~default d in
+    tup4 a b c d
+
+  let tup5 a b c d e (a', b', c', d', e') yield =
+    a a' (fun x -> yield (x,b',c',d',e'));
+    b b' (fun x -> yield (a',x,c',d',e'));
+    c c' (fun x -> yield (a',b',x,d',e'));
+    d d' (fun x -> yield (a',b',c',x,e'));
+    e e' (fun x -> yield (a',b',c',d',x))
+
+  let tup5_opt a b c d e =
+    let a = Option.value ~default a in
+    let b = Option.value ~default b in
+    let c = Option.value ~default c in
+    let d = Option.value ~default d in
+    let e = Option.value ~default e in
+    tup5 a b c d e
+
+  let tup6 a b c d e f (a', b', c', d', e', f') yield =
+    a a' (fun x -> yield (x,b',c',d',e',f'));
+    b b' (fun x -> yield (a',x,c',d',e',f'));
+    c c' (fun x -> yield (a',b',x,d',e',f'));
+    d d' (fun x -> yield (a',b',c',x,e',f'));
+    e e' (fun x -> yield (a',b',c',d',x,f'));
+    f f' (fun x -> yield (a',b',c',d',e',x))
+
+  let tup6_opt a b c d e f =
+    let a = Option.value ~default a in
+    let b = Option.value ~default b in
+    let c = Option.value ~default c in
+    let d = Option.value ~default d in
+    let e = Option.value ~default e in
+    let f = Option.value ~default f in
+    tup6 a b c d e f
+
+  let tup7 a b c d e f g (a', b', c', d', e', f', g') yield =
+    a a' (fun x -> yield (x,b',c',d',e',f',g'));
+    b b' (fun x -> yield (a',x,c',d',e',f',g'));
+    c c' (fun x -> yield (a',b',x,d',e',f',g'));
+    d d' (fun x -> yield (a',b',c',x,e',f',g'));
+    e e' (fun x -> yield (a',b',c',d',x,f',g'));
+    f f' (fun x -> yield (a',b',c',d',e',x,g'));
+    g g' (fun x -> yield (a',b',c',d',e',f',x))
+
+  let tup7_opt a b c d e f g =
+    let a = Option.value ~default a in
+    let b = Option.value ~default b in
+    let c = Option.value ~default c in
+    let d = Option.value ~default d in
+    let e = Option.value ~default e in
+    let f = Option.value ~default f in
+    let g = Option.value ~default g in
+    tup7 a b c d e f g
+
+  let tup8 a b c d e f g h (a', b', c', d', e', f', g', h') yield =
+    a a' (fun x -> yield (x,b',c',d',e',f',g',h'));
+    b b' (fun x -> yield (a',x,c',d',e',f',g',h'));
+    c c' (fun x -> yield (a',b',x,d',e',f',g',h'));
+    d d' (fun x -> yield (a',b',c',x,e',f',g',h'));
+    e e' (fun x -> yield (a',b',c',d',x,f',g',h'));
+    f f' (fun x -> yield (a',b',c',d',e',x,g',h'));
+    g g' (fun x -> yield (a',b',c',d',e',f',x,h'));
+    h h' (fun x -> yield (a',b',c',d',e',f',g',x))
+
+  let tup8_opt a b c d e f g h =
+    let a = Option.value ~default a in
+    let b = Option.value ~default b in
+    let c = Option.value ~default c in
+    let d = Option.value ~default d in
+    let e = Option.value ~default e in
+    let f = Option.value ~default f in
+    let g = Option.value ~default g in
+    let h = Option.value ~default h in
+    tup8 a b c d e f g h
+
+  let tup9 a b c d e f g h i (a', b', c', d', e', f', g', h', i') yield =
+    a a' (fun x -> yield (x,b',c',d',e',f',g',h',i'));
+    b b' (fun x -> yield (a',x,c',d',e',f',g',h',i'));
+    c c' (fun x -> yield (a',b',x,d',e',f',g',h',i'));
+    d d' (fun x -> yield (a',b',c',x,e',f',g',h',i'));
+    e e' (fun x -> yield (a',b',c',d',x,f',g',h',i'));
+    f f' (fun x -> yield (a',b',c',d',e',x,g',h',i'));
+    g g' (fun x -> yield (a',b',c',d',e',f',x,h',i'));
+    h h' (fun x -> yield (a',b',c',d',e',f',g',x,i'));
+    i i' (fun x -> yield (a',b',c',d',e',f',g',h',x))
+
+  let tup9_opt a b c d e f g h i =
+    let a = Option.value ~default a in
+    let b = Option.value ~default b in
+    let c = Option.value ~default c in
+    let d = Option.value ~default d in
+    let e = Option.value ~default e in
+    let f = Option.value ~default f in
+    let g = Option.value ~default g in
+    let h = Option.value ~default h in
+    let i = Option.value ~default i in
+    tup9 a b c d e f g h i
 end
 
 (** {2 Observe Values} *)
@@ -876,6 +1155,78 @@ let quad a b c d =
        (_opt_or d.shrink Shrink.nil))
     (Gen.quad a.gen b.gen c.gen d.gen)
 
+let tup2 a b=
+  make
+    ?small:(_opt_map_2 ~f:(fun a b (a', b') -> a a'+b b') a.small b.small)
+    ~print:(Print.tup2_opt a.print b.print)
+    ~shrink:(Shrink.pair (_opt_or a.shrink Shrink.nil) (_opt_or b.shrink Shrink.nil))
+    (Gen.tup2 a.gen b.gen)
+
+let tup3 a b c =
+  make
+    ?small:(_opt_map_3 ~f:(fun a b c (a', b', c') ->
+        a a'+b b'+c c') a.small b.small c.small)
+    ~print:(Print.tup3_opt a.print b.print c.print)
+    ~shrink:(Shrink.tup3_opt a.shrink b.shrink c.shrink)
+    (Gen.tup3 a.gen b.gen c.gen)
+
+let tup4 a b c d =
+  make
+    ?small:(_opt_map_4 ~f:(fun a b c d (a', b', c', d') ->
+        a a'+b b'+c c'+d d') a.small b.small c.small d.small)
+    ~print:(Print.tup4_opt a.print b.print c.print d.print)
+    ~shrink:(Shrink.tup4_opt a.shrink b.shrink c.shrink d.shrink)
+    (Gen.tup4 a.gen b.gen c.gen d.gen)
+
+let tup5 a b c d e =
+  make
+    ?small:(_opt_map_5 ~f:(fun a b c d e (a', b', c', d', e') ->
+        a a'+b b'+c c'+d d'+e e') a.small b.small c.small d.small e.small)
+    ~print:(Print.tup5_opt a.print b.print c.print d.print e.print)
+    ~shrink:(Shrink.tup5_opt a.shrink b.shrink c.shrink d.shrink e.shrink)
+    (Gen.tup5 a.gen b.gen c.gen d.gen e.gen)
+
+let tup6 a b c d e f =
+  make
+    ?small:(_opt_map_6 ~f:(fun a b c d e f (a', b', c', d', e', f') ->
+        a a'+b b'+c c'+d d'+e e'+f f') a.small b.small c.small d.small e.small f.small)
+    ~print:(Print.tup6_opt a.print b.print c.print d.print e.print f.print)
+    ~shrink:(Shrink.tup6_opt a.shrink b.shrink c.shrink d.shrink e.shrink f.shrink)
+    (Gen.tup6 a.gen b.gen c.gen d.gen e.gen f.gen)
+
+let tup7 a b c d e f g =
+  make
+    ?small:(_opt_map_7 ~f:(fun a b c d e f g (a', b', c', d', e', f', g') ->
+        a a'+b b'+c c'+d d'+e e'+f f'+g g')
+        a.small b.small c.small d.small e.small f.small g.small)
+    ~print:(Print.tup7_opt
+              a.print b.print c.print d.print e.print f.print g.print)
+    ~shrink:(Shrink.tup7_opt
+               a.shrink b.shrink c.shrink d.shrink e.shrink f.shrink g.shrink)
+    (Gen.tup7 a.gen b.gen c.gen d.gen e.gen f.gen g.gen)
+
+let tup8 a b c d e f g h =
+  make
+    ?small:(_opt_map_8 ~f:(fun a b c d e f g h (a', b', c', d', e', f', g', h') ->
+        a a'+b b'+c c'+d d'+e e'+f f'+g g'+h h')
+        a.small b.small c.small d.small e.small f.small g.small h.small)
+    ~print:(Print.tup8_opt
+              a.print b.print c.print d.print e.print f.print g.print h.print)
+    ~shrink:(Shrink.tup8_opt
+               a.shrink b.shrink c.shrink d.shrink e.shrink f.shrink g.shrink h.shrink)
+    (Gen.tup8 a.gen b.gen c.gen d.gen e.gen f.gen g.gen h.gen)
+
+let tup9 a b c d e f g h i =
+  make
+    ?small:(_opt_map_9 ~f:(fun a b c d e f g h i (a', b', c', d', e', f', g', h', i') ->
+        a a'+b b'+c c'+d d'+e e'+f f'+g g'+h h'+i i')
+        a.small b.small c.small d.small e.small f.small g.small h.small i.small)
+    ~print:(Print.tup9_opt
+              a.print b.print c.print d.print e.print f.print g.print h.print i.print)
+    ~shrink:(Shrink.tup9_opt
+               a.shrink b.shrink c.shrink d.shrink e.shrink f.shrink g.shrink h.shrink i.shrink)
+    (Gen.tup9 a.gen b.gen c.gen d.gen e.gen f.gen g.gen h.gen i.gen)
+
 let option ?ratio a =
   let g = Gen.opt ?ratio a.gen
   and shrink = _opt_map a.shrink ~f:Shrink.option
@@ -1329,13 +1680,13 @@ module Test = struct
 
   let make_cell ?if_assumptions_fail
       ?count ?long_factor ?max_gen
-  ?max_fail ?small:_removed_in_qcheck_2 ?name arb law
+  ?max_fail ?small:_removed_in_qcheck_2 ?retries ?name arb law
   =
   let {gen; shrink; print; collect; stats; _} = arb in
-  QCheck2.Test.make_cell_from_QCheck1 ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ~gen ?shrink ?print ?collect ~stats law
+  QCheck2.Test.make_cell_from_QCheck1 ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?retries ?name ~gen ?shrink ?print ?collect ~stats law
 
-  let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?name arb law =
-    QCheck2.Test.Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?name arb law)
+  let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?retries ?name arb law =
+    QCheck2.Test.Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?small ?retries ?name arb law)
 
   let fail_report = QCheck2.Test.fail_report
 
diff --git a/src/core/QCheck.mli b/src/core/QCheck.mli
index e86226c..ccd39b1 100644
--- a/src/core/QCheck.mli
+++ b/src/core/QCheck.mli
@@ -293,12 +293,13 @@ module Gen : sig
       @since 0.5.2 *)
 
   val int_bound : int -> int t
-  (** Uniform integer generator producing integers within [0... bound].
+  (** Uniform integer generator producing integers between [0] and [bound]
+      (inclusive).
       For [bound < 2^{30} - 1] uses [Random.State.int] for integer generation.
       @raise Invalid_argument if the argument is negative. *)
 
   val int_range : int -> int -> int t
-  (** Uniform integer generator producing integers within [low,high].
+  (** Uniform integer generator producing integers within [low,high] (inclusive).
       @raise Invalid_argument if [low > high]. *)
 
   val graft_corners : 'a t -> 'a list -> unit -> 'a t
@@ -353,10 +354,34 @@ module Gen : sig
   (** Generates quadruples.
       @since 0.5.1 *)
 
+   (** {3 Tuple of generators} *)
+
+  (** {4 Shrinks on [gen1], then [gen2], then ... } *)
+
+  val tup2 : 'a t -> 'b t -> ('a * 'b) t
+
+  val tup3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+
+  val tup4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
+
+  val tup5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t
+
+  val tup6 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t ->
+    ('a * 'b * 'c * 'd * 'e * 'f) t
+
+  val tup7 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g) t
+
+  val tup8 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) t
+
+  val tup9 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t -> 'i t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) t
+
   val char : char t
   (** Generates characters upto character code 255. *)
 
-  val printable : char t (** Generates printable characters. *)
+  val printable : char t (** Generates printable ascii characters in the range 32 to 127 *)
 
   val numeral : char t (** Generates numeral characters. *)
 
@@ -567,6 +592,34 @@ module Print : sig
   val comap : ('a -> 'b) -> 'b t -> 'a t
   (** [comap f p] maps [p], a printer of type ['b], to a printer of type ['a] by
       first converting a printed value using [f : 'a -> 'b]. *)
+
+  val tup2 : 'a t -> 'b t -> ('a * 'b) t
+  (** 2-tuple printer. Expects printers for each component. *)
+
+  val tup3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+  (** 3-tuple printer. Expects printers for each component. *)
+
+  val tup4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
+  (** 4-tuple printer. Expects printers for each component. *)
+
+  val tup5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t
+  (** 5-tuple printer. Expects printers for each component. *)
+
+  val tup6 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t ->
+    ('a * 'b * 'c * 'd * 'e * 'f) t
+  (** 6-tuple printer. Expects printers for each component. *)
+
+  val tup7 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g) t
+  (** 7-tuple printer. Expects printers for each component. *)
+
+  val tup8 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) t
+  (** 8-tuple printer. Expects printers for each component. *)
+
+  val tup9 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t -> 'i t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) t
+  (** 9-tuple printer. Expects printers for each component. *)
 end
 
 (** {2 Iterators}
@@ -682,6 +735,38 @@ module Shrink : sig
 
   val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
   (** Similar to {!pair} *)
+
+  val tup2 : 'a t -> 'b t -> ('a * 'b) t
+  (** [tup2 a b] uses [a] to shrink the first element of tuples,
+      then tries to shrink the second element using [b].
+      It is often better, when generating tuples, to put the "simplest"
+      element first (atomic type rather than list, etc.) because it will be
+      shrunk earlier. In particular, putting functions last might help. *)
+
+  val tup3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+  (** Similar to {!tup2} *)
+
+  val tup4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
+  (** Similar to {!tup2} *)
+
+  val tup5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t
+  (** Similar to {!tup2} *)
+
+  val tup6 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t ->
+    ('a * 'b * 'c * 'd * 'e * 'f) t
+  (** Similar to {!tup2} *)
+
+  val tup7 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g) t
+  (** Similar to {!tup2} *)
+
+  val tup8 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) t
+  (** Similar to {!tup2} *)
+
+  val tup9 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t -> 'i t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) t
+  (** Similar to {!tup2} *)
 end
 
 (** {2 Observe Values} *)
@@ -904,13 +989,14 @@ module Test : sig
   val make_cell :
     ?if_assumptions_fail:([`Fatal | `Warning] * float) ->
     ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int ->
-    ?small:('a -> int) -> ?name:string -> 'a arbitrary -> ('a -> bool) ->
-    'a cell
+    ?small:('a -> int) -> ?retries:int -> ?name:string ->
+    'a arbitrary -> ('a -> bool) -> 'a cell
   (** [make_cell arb prop] builds a test that checks property [prop] on instances
       of the generator [arb].
       @param name the name of the test.
       @param count number of test cases to run, counting only
         the test cases which satisfy preconditions.
+      @param retries number of times to retry the tested property while shrinking.
       @param long_factor the factor by which to multiply count, max_gen and
         max_fail when running a long test (default: 1).
       @param max_gen maximum number of times the generation function
@@ -951,7 +1037,8 @@ module Test : sig
   val make :
     ?if_assumptions_fail:([`Fatal | `Warning] * float) ->
     ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int ->
-    ?small:('a -> int) -> ?name:string -> 'a arbitrary -> ('a -> bool) -> t
+    ?small:('a -> int) -> ?retries:int -> ?name:string -> 'a arbitrary ->
+    ('a -> bool) -> t
   (** [make arb prop] builds a test that checks property [prop] on instances
       of the generator [arb].
       See {!make_cell} for a description of the parameters.
@@ -973,7 +1060,8 @@ module Test : sig
     ?rand:Random.State.t -> 'a cell -> 'a TestResult.t
 
   val check_cell_exn :
-    ?long:bool -> ?call:'a callback -> ?step:'a step ->
+    ?long:bool -> ?call:'a callback ->
+    ?step:'a step -> ?handler:'a handler ->
     ?rand:Random.State.t -> 'a cell -> unit
 
   val check_exn : ?long:bool -> ?rand:Random.State.t -> t -> unit
@@ -1109,19 +1197,21 @@ val char : char arbitrary
     valid latin-1). *)
 
 val printable_char : char arbitrary
-(** Uniformly distributed over a subset of chars. *)
-(* FIXME: describe which subset. *)
+(** Uniformly distributed over a subset of printable ascii chars.
+    Ascii character codes 32 to 127.
+  *)
 
 val numeral_char : char arbitrary
 (** Uniformly distributed over ['0'..'9']. *)
 
 val string_gen_of_size : int Gen.t -> char Gen.t -> string arbitrary
+(** Builds a string generator from a (non-negative) size generator and a character generator. *)
 
 val string_gen : char Gen.t -> string arbitrary
-(** Generates strings with a distribution of length of [small_nat]. *)
+(** Generates strings with a distribution of length of {!Gen.nat}. *)
 
 val string : string arbitrary
-(** Generates strings with a distribution of length of [small_nat]
+(** Generates strings with a distribution of length of {!Gen.nat}
     and distribution of characters of [char]. *)
 
 val small_string : string arbitrary
@@ -1132,32 +1222,34 @@ val small_list : 'a arbitrary -> 'a list arbitrary
     @since 0.5.3 *)
 
 val string_of_size : int Gen.t -> string arbitrary
-(** Generates strings with distribution of characters if [char]. *)
+(** Generates strings with distribution of characters of [char]. *)
 
 val printable_string : string arbitrary
-(** Generates strings with a distribution of length of [small_nat]
+(** Generates strings with a distribution of length of {!Gen.nat}
     and distribution of characters of [printable_char]. *)
 
 val printable_string_of_size : int Gen.t -> string arbitrary
 (** Generates strings with distribution of characters of [printable_char]. *)
 
 val small_printable_string : string arbitrary
+(** Generates strings with a length of [small_nat]
+    and distribution of characters of [printable_char]. *)
 
 val numeral_string : string arbitrary
-(** Generates strings with a distribution of length of [small_nat]
+(** Generates strings with a distribution of length of {!Gen.nat}
     and distribution of characters of [numeral_char]. *)
 
 val numeral_string_of_size : int Gen.t -> string arbitrary
 (** Generates strings with a distribution of characters of [numeral_char]. *)
 
 val list : 'a arbitrary -> 'a list arbitrary
-(** Generates lists with length generated by [small_nat]. *)
+(** Generates lists with length generated by {!Gen.nat}. *)
 
 val list_of_size : int Gen.t -> 'a arbitrary -> 'a list arbitrary
 (** Generates lists with length from the given distribution. *)
 
 val array : 'a arbitrary -> 'a array arbitrary
-(** Generates arrays with length generated by [small_nat]. *)
+(** Generates arrays with length generated by {!Gen.nat}. *)
 
 val array_of_size : int Gen.t -> 'a arbitrary -> 'a array arbitrary
 (** Generates arrays with length from the given distribution. *)
@@ -1174,13 +1266,108 @@ val quad : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> ('a *
 (** Combines four generators into a generator of 4-tuples.
     Order matters for shrinking, see {!Shrink.pair} and the likes *)
 
+(** {3 Tuple of generators} *)
+
+(** {4 Shrinks on [gen1], then [gen2], then ... } *)
+
+val tup2 :
+  'a arbitrary ->
+  'b arbitrary ->
+  ('a * 'b) arbitrary
+(** Combines two generators into a 2-tuple generator.
+    Order of elements can matter (w.r.t shrinking, see {!Shrink.tup2})
+    Prints as many elements as available printers *)
+
+val tup3 :
+  'a arbitrary ->
+  'b arbitrary ->
+  'c arbitrary ->
+  ('a * 'b * 'c) arbitrary
+(** Combines three generators into a 3-tuple generator.
+    Order of elements can matter (w.r.t shrinking, see {!Shrink.tup2})
+    Prints as many elements as available printers *)
+
+val tup4 :
+  'a arbitrary ->
+  'b arbitrary ->
+  'c arbitrary ->
+  'd arbitrary ->
+  ('a * 'b * 'c * 'd) arbitrary
+(** Combines four generators into a 4-tuple generator.
+    Order of elements can matter (w.r.t shrinking, see {!Shrink.tup2})
+    Prints as many elements as available printers *)
+
+val tup5 : 'a arbitrary ->
+  'b arbitrary ->
+  'c arbitrary ->
+  'd arbitrary ->
+  'e arbitrary ->
+  ('a * 'b * 'c * 'd * 'e) arbitrary
+(** Combines five generators into a 5-tuple generator.
+    Order of elements can matter (w.r.t shrinking, see {!Shrink.tup2})
+    Prints as many elements as available printers *)
+
+val tup6 :
+  'a arbitrary ->
+  'b arbitrary ->
+  'c arbitrary ->
+  'd arbitrary ->
+  'e arbitrary ->
+  'f arbitrary ->
+  ('a * 'b * 'c * 'd * 'e * 'f) arbitrary
+(** Combines six generators into a 6-tuple generator.
+    Order of elements can matter (w.r.t shrinking, see {!Shrink.tup2})
+    Prints as many elements as available printers *)
+
+val tup7 :
+  'a arbitrary ->
+  'b arbitrary ->
+  'c arbitrary ->
+  'd arbitrary ->
+  'e arbitrary ->
+  'f arbitrary ->
+  'g arbitrary ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g) arbitrary
+(** Combines seven generators into a 7-tuple generator.
+    Order of elements can matter (w.r.t shrinking, see {!Shrink.tup2})
+    Prints as many elements as available printers *)
+
+val tup8 :
+  'a arbitrary ->
+  'b arbitrary ->
+  'c arbitrary ->
+  'd arbitrary ->
+  'e arbitrary ->
+  'f arbitrary ->
+  'g arbitrary ->
+  'h arbitrary ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) arbitrary
+(** Combines eight generators into a 8-tuple generator.
+    Order of elements can matter (w.r.t shrinking, see {!Shrink.tup2})
+    Prints as many elements as available printers *)
+
+val tup9 :
+  'a arbitrary ->
+  'b arbitrary ->
+  'c arbitrary ->
+  'd arbitrary ->
+  'e arbitrary ->
+  'f arbitrary ->
+  'g arbitrary ->
+  'h arbitrary ->
+  'i arbitrary ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) arbitrary
+(** Combines nine generators into a 9-tuple generator.
+    Order of elements can matter (w.r.t shrinking, see {!Shrink.tup2})
+    Prints as many elements as available printers *)
+
 val option : ?ratio:float -> 'a arbitrary -> 'a option arbitrary
 (** Choose between returning Some random value with optional ratio, or None. *)
 
 val fun1_unsafe : 'a arbitrary -> 'b arbitrary -> ('a -> 'b) arbitrary
 (** Generator of functions of arity 1.
     The functions are always pure and total functions:
-    - when given the same argument (as decided by Pervasives.(=)), it returns the same value
+    - when given the same argument (as decided by Stdlib.(=)), it returns the same value
     - it never does side effects, like printing or never raise exceptions etc.
       The functions generated are really printable.
 
diff --git a/src/core/QCheck2.ml b/src/core/QCheck2.ml
index a398baa..f98c64b 100644
--- a/src/core/QCheck2.ml
+++ b/src/core/QCheck2.ml
@@ -600,6 +600,27 @@ module Gen = struct
   let quad (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) : ('a * 'b * 'c * 'd) t =
     (fun a b c d -> (a, b, c, d)) <$> g1 <*> g2 <*> g3 <*> g4
 
+  let tup2 = pair
+
+  let tup3 = triple
+
+  let tup4 = quad
+
+  let tup5 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) : ('a * 'b * 'c * 'd * 'e) t =
+    (fun a b c d e -> (a, b, c, d, e)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5
+
+  let tup6 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) (g6 : 'f t) : ('a * 'b * 'c * 'd * 'e * 'f) t =
+    (fun a b c d e f -> (a, b, c, d, e, f)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5 <*> g6
+
+  let tup7 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) (g6 : 'f t) (g7 : 'g t) : ('a * 'b * 'c * 'd * 'e * 'f * 'g) t =
+    (fun a b c d e f g -> (a, b, c, d, e, f, g)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5 <*> g6 <*> g7
+
+  let tup8 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) (g6 : 'f t) (g7 : 'g t) (g8 : 'h t) : ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) t =
+    (fun a b c d e f g h -> (a, b, c, d, e, f, g, h)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5 <*> g6 <*> g7 <*> g8
+
+  let tup9 (g1 : 'a t) (g2 : 'b t) (g3 : 'c t) (g4 : 'd t) (g5 : 'e t) (g6 : 'f t) (g7 : 'g t) (g8 : 'h t) (g9 : 'i t) : ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) t =
+    (fun a b c d e f g h i -> (a, b, c, d, e, f, g, h, i)) <$> g1 <*> g2 <*> g3 <*> g4 <*> g5 <*> g6 <*> g7 <*> g8 <*> g9
+
   (** Don't reuse {!int_range} which is much less performant (many more checks because of the possible range and origins). As a [string] generator may call this hundreds or even thousands of times for a single value, it's worth optimizing. *)
   let char : char t = fun st ->
     let c = RS.int st 256 in
@@ -768,6 +789,121 @@ module Print = struct
   let contramap f p x = p (f x)
 
   let comap = contramap
+
+  let default = fun _ -> "<no printer>"
+
+  let tup2 p_a p_b (a, b) =
+    Printf.sprintf "(%s, %s)" (p_a a) (p_b b)
+
+  let tup2_opt p_a p_b (a, b) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    tup2 p_a p_b (a, b)
+
+  let tup3 p_a p_b (p_c) (a, b, c) =
+    Printf.sprintf "(%s, %s, %s)" (p_a a) (p_b b) (p_c c)
+
+  let tup3_opt p_a p_b p_c (a, b, c) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    tup3 p_a p_b p_c (a, b, c)
+
+  let tup4 p_a p_b p_c p_d (a, b, c, d) =
+    Printf.sprintf "(%s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+
+  let tup4_opt p_a p_b p_c p_d (a, b, c, d) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    tup4 p_a p_b p_c p_d (a, b, c, d)
+
+  let tup5 p_a p_b p_c p_d p_e (a, b, c, d, e) =
+    Printf.sprintf "(%s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e)
+
+  let tup5_opt p_a p_b p_c p_d p_e (a, b, c, d, e) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    tup5 p_a p_b p_c p_d p_e (a, b, c, d, e)
+
+  let tup6 p_a p_b p_c p_d p_e p_f (a, b, c, d, e, f) =
+    Printf.sprintf "(%s, %s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e) (p_f f)
+
+  let tup6_opt p_a p_b p_c p_d p_e p_f (a, b, c, d, e, f) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    let p_f = Option.value ~default p_f in
+    tup6 p_a p_b p_c p_d p_e p_f (a, b, c, d, e, f)
+
+  let tup7 p_a p_b p_c p_d p_e p_f p_g (a, b, c, d, e, f, g) =
+    Printf.sprintf "(%s, %s, %s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e) (p_f f)
+      (p_g g)
+
+  let tup7_opt p_a p_b p_c p_d p_e p_f p_g (a, b, c, d, e, f, g) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    let p_f = Option.value ~default p_f in
+    let p_g = Option.value ~default p_g in
+    tup7 p_a p_b p_c p_d p_e p_f p_g (a, b, c, d, e, f, g)
+
+  let tup8 p_a p_b p_c p_d p_e p_f p_g p_h (a, b, c, d, e, f, g, h) =
+    Printf.sprintf "(%s, %s, %s, %s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e) (p_f f)
+      (p_g g) (p_h h)
+
+  let tup8_opt p_a p_b p_c p_d p_e p_f p_g p_h (a, b, c, d, e, f, g, h) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    let p_f = Option.value ~default p_f in
+    let p_g = Option.value ~default p_g in
+    let p_h = Option.value ~default p_h in
+    tup8 p_a p_b p_c p_d p_e p_f p_g p_h (a, b, c, d, e, f, g, h)
+
+  let tup9 p_a p_b p_c p_d p_e p_f p_g p_h p_i (a, b, c, d, e, f, g, h, i) =
+    Printf.sprintf "(%s, %s, %s, %s, %s, %s, %s, %s, %s)"
+      (p_a a) (p_b b)
+      (p_c c) (p_d d)
+      (p_e e) (p_f f)
+      (p_g g) (p_h h)
+      (p_i i)
+
+  let tup9_opt p_a p_b p_c p_d p_e p_f p_g p_h p_i (a, b, c, d, e, f, g, h, i) =
+    let p_a = Option.value ~default p_a in
+    let p_b = Option.value ~default p_b in
+    let p_c = Option.value ~default p_c in
+    let p_d = Option.value ~default p_d in
+    let p_e = Option.value ~default p_e in
+    let p_f = Option.value ~default p_f in
+    let p_g = Option.value ~default p_g in
+    let p_h = Option.value ~default p_h in
+    let p_i = Option.value ~default p_i in
+    tup9 p_a p_b p_c p_d p_e p_f p_g p_h p_i (a, b, c, d, e, f, g, h, i)
 end
 
 (** {2 Observe Values} *)
@@ -1225,6 +1361,7 @@ module Test = struct
     long_factor : int; (* multiplicative factor for long test count *)
     max_gen : int; (* max number of instances to generate (>= count) *)
     max_fail : int; (* max number of failures *)
+    retries : int; (* max number of retries during shrinking *)
     law : 'a -> bool; (* the law to check *)
     gen : 'a Gen.t; (* how to generate/shrink instances *)
     print : 'a Print.t option; (* how to print values *)
@@ -1273,7 +1410,7 @@ module Test = struct
 
   let make_cell ?(if_assumptions_fail=default_if_assumptions_fail)
       ?(count) ?(long_factor=1) ?max_gen
-      ?(max_fail=1) ?(name=fresh_name()) ?print ?collect ?(stats=[]) gen law
+      ?(max_fail=1) ?(retries=1) ?(name=fresh_name()) ?print ?collect ?(stats=[]) gen law
     =
     let count = global_count count in
     let max_gen = match max_gen with None -> count + 200 | Some x->x in
@@ -1285,6 +1422,7 @@ module Test = struct
       stats;
       max_gen;
       max_fail;
+      retries;
       name;
       count;
       long_factor;
@@ -1294,7 +1432,7 @@ module Test = struct
 
   let make_cell_from_QCheck1 ?(if_assumptions_fail=default_if_assumptions_fail)
       ?(count) ?(long_factor=1) ?max_gen
-      ?(max_fail=1) ?(name=fresh_name()) ~gen ?shrink ?print ?collect ~stats law
+      ?(max_fail=1) ?(retries=1) ?(name=fresh_name()) ~gen ?shrink ?print ?collect ~stats law
     =
     let count = global_count count in
     (* Make a "fake" QCheck2 arbitrary with no shrinking *)
@@ -1308,6 +1446,7 @@ module Test = struct
       stats;
       max_gen;
       max_fail;
+      retries;
       name;
       count;
       long_factor;
@@ -1315,8 +1454,8 @@ module Test = struct
       qcheck1_shrink = shrink;
     }
 
-  let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ?print ?collect ?stats gen law =
-    Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?name ?print ?collect ?stats gen law)
+  let make ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?retries ?name ?print ?collect ?stats gen law =
+    Test (make_cell ?if_assumptions_fail ?count ?long_factor ?max_gen ?max_fail ?retries ?name ?print ?collect ?stats gen law)
 
   let test_get_count (Test cell) = get_count cell
 
@@ -1407,9 +1546,33 @@ module Test = struct
     | Run_ok
     | Run_fail of string list
 
-  let run_law law x =
+  (* run_law is a helper function for testing a property [law] on a
+     generated input [x].
+
+     When passed a ~retries number n>1, the tested property is checked
+     n times for each shrunk input candidate. The default value is 1,
+     thus causing no change in behaviour.
+
+     Retrying a property can be useful when testing non-deterministic
+     code with QCheck, e.g., for multicore execution. The idea is
+     described in
+        'Testing a Database for Race Conditions with QuickCheck'
+        Hughes and Bolinder, Erlang 2011, Sec.6:
+
+     "As we explained in section 4, we ensure that tests fail when
+     races are present simply by repeating each test a large number of
+     times, and by running on a dual core machine. We obtained the
+     minimal failing cases in the previous section by repeating each
+     test 100 times during shrinking: thus we stopped shrinking a test
+     case only when all of its candidate shrinkings passed 100 tests
+     in a row."  *)
+  let run_law ~retries law x =
+    let rec loop i = match law x with
+      | false -> Run_fail []
+      | true ->
+        if i<=1 then Run_ok else loop (i-1) in
     try
-      if law x then Run_ok else Run_fail []
+      loop retries
     with User_fail msg -> Run_fail [msg]
 
   (* QCheck1-compatibility code *)
@@ -1439,7 +1602,7 @@ module Test = struct
                try
                  incr count;
                  st.handler st.test.name st.test (Shrinking (steps, !count, x));
-                 begin match run_law st.test.law x with
+                 begin match run_law ~retries:st.test.retries st.test.law x with
                  | Run_fail m when not is_err -> Some (Tree.pure x, Shrink_fail, m)
                  | _ -> None
                  end
@@ -1454,7 +1617,7 @@ module Test = struct
              try
                incr count;
                st.handler st.test.name st.test (Shrinking (steps, !count, x));
-               begin match run_law st.test.law x with
+               begin match run_law ~retries:st.test.retries st.test.law x with
                  | Run_fail m when not is_err -> Some (x_tree, Shrink_fail, m)
                  | _ -> None
                end
@@ -1532,7 +1695,7 @@ module Test = struct
     let res =
       try
         state.handler state.test.name state.test (Testing input);
-        begin match run_law state.test.law input with
+        begin match run_law ~retries:1 state.test.law input with
           | Run_ok ->
             (* one test ok *)
             decr_count state;
@@ -1768,8 +1931,8 @@ module Test = struct
     | R.Failed_other {msg} ->
       raise (Test_fail (cell.name, [msg]))
 
-  let check_cell_exn ?long ?call ?step ?rand cell =
-    let res = check_cell ?long ?call ?step ?rand cell in
+  let check_cell_exn ?long ?call ?step ?handler ?rand cell =
+    let res = check_cell ?long ?call ?step ?handler ?rand cell in
     check_result cell res
 
   let check_exn ?long ?rand (Test cell) = check_cell_exn ?long ?rand cell
diff --git a/src/core/QCheck2.mli b/src/core/QCheck2.mli
index 1184365..b7b3592 100644
--- a/src/core/QCheck2.mli
+++ b/src/core/QCheck2.mli
@@ -626,6 +626,26 @@ module Gen : sig
       @since 0.5.1
   *)
 
+  (** {3 Tuple of generators} *)
+
+  (** {4 Shrinks on [gen1], then [gen2], then ... } *)
+
+  val tup2 : 'a t -> 'b t -> ('a * 'b) t
+
+  val tup3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+
+  val tup4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
+
+  val tup5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t
+
+  val tup6 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> ('a * 'b * 'c * 'd * 'e * 'f) t
+
+  val tup7 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> ('a * 'b * 'c * 'd * 'e * 'f * 'g) t
+
+  val tup8 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t -> ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) t
+
+  val tup9 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t -> 'i t -> ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) t
+
   (** {3 Convert a structure of generator to a generator of structure} *)
 
   val flatten_l : 'a t list -> 'a list t
@@ -1036,6 +1056,34 @@ module Print : sig
 
   val comap : ('b -> 'a) -> 'a t -> 'b t
   (** @deprecated use {!contramap} instead. *)
+
+  val tup2 : 'a t -> 'b t -> ('a * 'b) t
+  (** 2-tuple printer. Expects printers for each component. *)
+
+  val tup3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+  (** 3-tuple printer. Expects printers for each component. *)
+
+  val tup4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
+  (** 4-tuple printer. Expects printers for each component. *)
+
+  val tup5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t
+  (** 5-tuple printer. Expects printers for each component. *)
+
+  val tup6 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t ->
+    ('a * 'b * 'c * 'd * 'e * 'f) t
+  (** 6-tuple printer. Expects printers for each component. *)
+
+  val tup7 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g) t
+  (** 7-tuple printer. Expects printers for each component. *)
+
+  val tup8 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) t
+  (** 8-tuple printer. Expects printers for each component. *)
+
+  val tup9 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t -> 'h t -> 'i t ->
+    ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) t
+  (** 9-tuple printer. Expects printers for each component. *)
 end
 
 (** Shrinking helper functions. *)
@@ -1537,8 +1585,8 @@ module Test : sig
      
   val make_cell :
     ?if_assumptions_fail:([`Fatal | `Warning] * float) ->
-    ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?name:string ->
-    ?print:'a Print.t -> ?collect:('a -> string) -> ?stats:('a stat list) ->
+    ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?retries:int ->
+    ?name:string -> ?print:'a Print.t -> ?collect:('a -> string) -> ?stats:('a stat list) ->
      'a Gen.t -> ('a -> bool) ->
     'a cell
   (** [make_cell gen prop] builds a test that checks property [prop] on instances
@@ -1553,6 +1601,7 @@ module Test : sig
         preconditions (should be >= count).
       @param max_fail maximum number of failures before we stop generating
         inputs. This is useful if shrinking takes too much time.
+      @param retries number of times to retry the tested property while shrinking.
       @param if_assumptions_fail the minimum
         fraction of tests that must satisfy the precondition for a success
         to be considered valid.
@@ -1568,7 +1617,7 @@ module Test : sig
   val make_cell_from_QCheck1 :
     ?if_assumptions_fail:([`Fatal | `Warning] * float) ->
     ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int ->
-    ?name:string -> gen:(Random.State.t -> 'a) -> ?shrink:('a -> ('a -> unit) -> unit) ->
+    ?retries:int -> ?name:string -> gen:(Random.State.t -> 'a) -> ?shrink:('a -> ('a -> unit) -> unit) ->
     ?print:('a -> string) -> ?collect:('a -> string) -> stats:'a stat list -> ('a -> bool) ->
     'a cell
   (** ⚠️ Do not use, this is exposed for internal reasons only. ⚠️ 
@@ -1598,8 +1647,8 @@ module Test : sig
 
   val make :
     ?if_assumptions_fail:([`Fatal | `Warning] * float) ->
-    ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?name:string ->
-    ?print:('a Print.t) -> ?collect:('a -> string) -> ?stats:('a stat list) ->
+    ?count:int -> ?long_factor:int -> ?max_gen:int -> ?max_fail:int -> ?retries:int ->
+    ?name:string -> ?print:('a Print.t) -> ?collect:('a -> string) -> ?stats:('a stat list) ->
     'a Gen.t -> ('a -> bool) -> t
   (** [make gen prop] builds a test that checks property [prop] on instances
       of the generator [gen].
@@ -1692,7 +1741,8 @@ module Test : sig
   *)
 
   val check_cell_exn :
-    ?long:bool -> ?call:'a callback -> ?step:'a step ->
+    ?long:bool -> ?call:'a callback ->
+    ?step:'a step -> ?handler:'a handler ->
     ?rand:Random.State.t -> 'a cell -> unit
   (** Same as {!check_cell} but calls  {!check_result} on the result.
       @raise Test_error if [res = Error _]
diff --git a/src/ppx_deriving_qcheck/QCheck_generators.ml b/src/ppx_deriving_qcheck/QCheck_generators.ml
new file mode 100644
index 0000000..b3cf4bb
--- /dev/null
+++ b/src/ppx_deriving_qcheck/QCheck_generators.ml
@@ -0,0 +1,96 @@
+open Ppxlib
+
+(** This module contains all generators from QCheck used to
+    derive a type declaration *)
+
+(** {2. Type} *)
+
+let ty = Ldot (Ldot (Lident "QCheck", "Gen"), "t")
+
+(** {2. Primitive generators} *)
+
+let unit loc = [%expr QCheck.Gen.unit]
+
+let int loc = [%expr QCheck.Gen.int]
+
+let string loc = [%expr QCheck.Gen.string]
+
+let char loc = [%expr QCheck.Gen.char]
+
+let bool loc = [%expr QCheck.Gen.bool]
+
+let float loc = [%expr QCheck.Gen.float]
+
+let int32 loc = [%expr QCheck.Gen.ui32]
+
+let int64 loc = [%expr QCheck.Gen.ui64]
+
+let option ~loc e = [%expr QCheck.Gen.opt [%e e]]
+
+let list ~loc e = [%expr QCheck.Gen.list [%e e]]
+
+let array ~loc e = [%expr QCheck.Gen.array [%e e]]
+
+(** {2. Generator combinators} *)
+
+let pure ~loc x = [%expr QCheck.Gen.pure [%e x]] 
+
+let frequency ~loc l =
+  match l with
+  | [%expr [([%e? _], [%e? x])]] -> x
+  | _ ->
+     [%expr QCheck.Gen.frequency [%e l]]
+
+let map ~loc pat expr gen =
+  [%expr QCheck.Gen.map (fun [%p pat] -> [%e expr]) [%e gen]]
+
+let pair ~loc a b =
+  [%expr QCheck.Gen.pair [%e a] [%e b]]
+
+let triple ~loc a b c =
+  [%expr QCheck.Gen.triple [%e a] [%e b] [%e c]]
+
+let quad ~loc a b c d=
+  [%expr QCheck.Gen.quad [%e a] [%e b] [%e c] [%e d]]
+
+let sized ~loc e =
+  [%expr QCheck.Gen.sized @@ [%e e]]
+
+let fix ~loc e =
+  [%expr QCheck.Gen.fix [%e e]]
+
+(** Observable generators *)
+module Observable = struct
+  (** {2. Primitive generators} *)
+  let unit loc = [%expr QCheck.Observable.unit]
+
+  let int loc = [%expr QCheck.Observable.int]
+
+  let string loc = [%expr QCheck.Observable.string]
+
+  let char loc = [%expr QCheck.Observable.char]
+
+  let bool loc = [%expr QCheck.Observable.bool]
+
+  let float loc = [%expr QCheck.Observable.float]
+
+  let int32 loc = [%expr QCheck.Observable.int32]
+
+  let int64 loc = [%expr QCheck.Observable.int64]
+
+  let option ~loc e = [%expr QCheck.Observable.option [%e e]]
+
+  let list ~loc e = [%expr QCheck.Observable.list [%e e]]
+
+  let array ~loc e = [%expr QCheck.Observable.array [%e e]]
+
+  (** {2. Observable combinators} *)
+  let pair ~loc a b =
+  [%expr QCheck.Observable.pair [%e a] [%e b]]
+
+  let triple ~loc a b c =
+    [%expr QCheck.Observable.triple [%e a] [%e b] [%e c]]
+
+  let quad ~loc a b c d=
+    [%expr QCheck.Observable.quad [%e a] [%e b] [%e c] [%e d]]
+end
diff --git a/src/ppx_deriving_qcheck/README.md b/src/ppx_deriving_qcheck/README.md
new file mode 100644
index 0000000..333c90f
--- /dev/null
+++ b/src/ppx_deriving_qcheck/README.md
@@ -0,0 +1,331 @@
+# ppx_deriving_qcheck
+
+## Generator
+Derive `QCheck.Gen.t` from a type declaration
+
+```ocaml
+type tree = Leaf of int | Node of tree * tree
+[@@deriving qcheck]
+
+let rec rev tree = match tree with
+| Leaf _ -> tree
+| Node (left, right) -> Node (rev right, rev left)
+
+let test =
+  QCheck.Test.make
+    ~name:"tree -> rev (rev tree) = tree"
+	(QCheck.make gen_tree)
+	(fun tree -> rev (rev tree) = tree)
+```
+
+For `type tree` we derive two generators:
+- `val gen_tree : tree Gen.t` and
+- `val gen_tree_sized : int -> tree Gen.t`
+
+For non-recursive types the latter is however not derived.
+
+For types with the name `t` (i.e. `type t = ...`) which is a common idiom in OCaml code,
+the deriver omits the name from the derived generators,
+thus producing `val gen : t Gen.t` and optionally `val gen_sized : int -> t Gen.t`.
+
+### Overwrite generator
+If you wan't to specify your own `generator` for any type you can
+add an attribute to the type:
+
+```ocaml
+type t = (int : [@gen QCheck.Gen.(0 -- 10)])
+[@@deriving qcheck]
+
+(* produces ==> *)
+
+let gen : t QCheck.Gen.t = QCheck.Gen.(0 -- 10)
+```
+
+This attribute has 2 advantages:
+* Use your own generator for a specific type (see above)
+* There is no generator available for the type
+  ```ocaml
+  type my_foo =
+  | Foo of my_other_type
+  | Bar of bool
+  [@@deriving qcheck]
+  ^^^^^^^^^^^^^^^^
+  Error: Unbound value gen_my_other_type
+  
+  (* Possible fix *)
+  let gen_my_other_type = (* add your implementation here *)
+  
+  type my_foo =
+  | Foo of my_other_type [@gen gen_my_other_type]
+  | Bar of bool
+  [@@deriving qcheck]
+  ```
+
+## How to use
+
+Add to your OCaml libraries with dune
+```ocaml
+...
+(preprocess (pps ppx_deriving_qcheck)))
+...
+```
+
+## Supported types
+
+### Primitive types
+
+* Unit
+```ocaml
+type t = unit [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.unit
+```
+
+* Bool
+```ocaml
+type t = bool [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.bool
+```
+
+* Integer
+```ocaml
+type t = int [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.int
+```
+
+* Float
+```ocaml
+type t = float [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.float
+```
+
+* String
+```ocaml
+type t = string [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.string
+```
+
+* Char
+```ocaml
+type t = char [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.char
+```
+
+* Option
+```ocaml
+type 'a t = 'a option [@@deriving qcheck]
+
+(* ==> *)
+
+let gen gen_a = QCheck.Gen.option gen_a
+```
+
+* List
+```ocaml
+type 'a t = 'a list [@@deriving qcheck]
+
+(* ==> *)
+
+let gen gen_a = QCheck.Gen.list gen_a
+```
+
+* Array
+```ocaml
+type 'a t = 'a array [@@deriving qcheck]
+
+(* ==> *)
+
+let gen gen_a = QCheck.Gen.array gen_a
+```
+
+### Tuples of size `n`
+
+* n = 2
+```ocaml
+type t = int * int [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.pair QCheck.Gen.int QCheck.Gen.int
+```
+
+* n = 3
+```ocaml
+type t = int * int * int [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.triple QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int
+```
+
+* n = 4
+```ocaml
+type t = int * int * int * int [@@deriving qcheck]
+
+(* ==> *)
+
+let gen = QCheck.Gen.quad QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int
+```
+
+* n > 4, tuples are split between pairs, for instance n = 8
+```ocaml
+type t = int * int * int * int * int * int * int * int [@@deriving qcheck]
+
+(* ==> *)
+
+let gen =
+  QCheck.Gen.pair
+    (QCheck.Gen.quad QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int)
+    (QCheck.Gen.quad QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int)
+```
+
+## Records
+```ocaml
+type service = {
+	service_name : string;
+	port : int;
+	protocol : string;
+} [@@deriving qcheck]
+
+(* ==> *)
+
+let gen_service =
+  QCheck.Gen.map
+    (fun (gen0, gen1, gen2) ->
+      { service_name = gen0; port = gen1; protocol = gen2 })
+    (QCheck.Gen.triple QCheck.Gen.string QCheck.Gen.int QCheck.Gen.string)
+```
+
+## Variants
+* Variants
+```ocaml
+type color = Red | Blue | Green
+[@@deriving qcheck]
+
+(* ==> *)
+
+let gen_color =
+  QCheck.Gen.frequency
+    [(1, (QCheck.Gen.pure Red));
+     (1, (QCheck.Gen.pure Blue));
+     (1, (QCheck.Gen.pure Green))]
+```
+
+* Polymorphic variants
+```ocaml
+type color = [ `Red | `Blue | `Green ]
+[@@deriving qcheck]
+
+(* ==> *)
+
+let gen_color =
+  (QCheck.Gen.frequency
+    [(1, (QCheck.Gen.pure `Red));
+     (1, (QCheck.Gen.pure `Blue));
+     (1, (QCheck.Gen.pure `Green))] : color QCheck.Gen.t)
+```
+
+## Recursive variants
+* Recursive variants
+```ocaml
+type tree = Leaf of int | Node of tree * tree
+[@@deriving qcheck]
+
+(* ==> *)
+
+let rec gen_tree_sized n =
+  match n with
+  | 0 -> QCheck.Gen.map (fun gen0 -> Leaf gen0) QCheck.Gen.int
+  | n ->
+    QCheck.Gen.frequency
+      [(1, (QCheck.Gen.map (fun gen0 -> Leaf gen0) QCheck.Gen.int));
+       (1,
+		   (QCheck.Gen.map (fun (gen0, gen1) -> Node (gen0, gen1))
+             (QCheck.Gen.pair (self (n / 2)) (self (n / 2)))))]))
+
+let gen_tree = QCheck.Gen.sized @@ gen_tree_sized
+```
+
+* Recursive polymorphic variants
+```ocaml
+type tree = [ `Leaf of int | `Node of tree * tree ]
+[@@deriving qcheck]
+
+(* ==> *)
+
+let gen_tree =
+  (QCheck.Gen.sized @@ QCheck.Gen.fix (fun self -> function
+  | 0 ->
+    QCheck.Gen.frequency [
+	  ( 1, QCheck.Gen.map (fun gen0 -> `Leaf gen0) QCheck.Gen.int);
+    ]
+  | n ->
+    QCheck.Gen.frequency [
+      ( 1, QCheck.Gen.map (fun gen0 -> `Leaf gen0) QCheck.Gen.int);
+      ( 1,
+           QCheck.Gen.map (fun gen0 -> `Node gen0)
+             (QCheck.Gen.map
+               (fun (gen0, gen1) -> (gen0, gen1))
+                 (QCheck.Gen.pair (self (n / 2)) (self (n / 2)))))
+                      ])
+            : tree QCheck.Gen.t)
+```
+
+## Mutual recursive types
+```ocaml
+type tree = Node of (int * forest)
+and forest = Nil | Cons of (tree * forest)
+[@@deriving qcheck]
+
+(* ==> *)
+
+let rec gen_tree () =
+  QCheck.Gen.frequency
+    [(1,
+      (QCheck.Gen.map (fun gen0 -> Node gen0)
+        (QCheck.Gen.map (fun (gen0, gen1) -> (gen0, gen1))
+          (QCheck.Gen.pair QCheck.Gen.int (gen_forest ())))))]
+
+and gen_forest () =
+  QCheck.Gen.sized @@
+    (QCheck.Gen.fix
+      (fun self -> function
+        | 0 -> QCheck.Gen.frequency [(1, (QCheck.Gen.pure Nil))]
+        | n ->
+          QCheck.Gen.frequency
+            [(1, (QCheck.Gen.pure Nil));
+             (1,
+                 (QCheck.Gen.map (fun gen0 -> Cons gen0)
+                   (QCheck.Gen.map (fun (gen0, gen1) -> (gen0, gen1))
+                     (QCheck.Gen.pair (gen_tree ()) (self (n / 2))))))]))
+
+let gen_tree = gen_tree ()
+
+let gen_forest = gen_forest ()
+```
+
+## Unsupported types
+
+### GADT
+Deriving a GADT currently produces an ill-typed generator.
+
+### Let us know
+If you encounter a unsupported type (that should be), please let us know by creating
+an issue.
diff --git a/src/ppx_deriving_qcheck/args.ml b/src/ppx_deriving_qcheck/args.ml
new file mode 100644
index 0000000..084a8a1
--- /dev/null
+++ b/src/ppx_deriving_qcheck/args.ml
@@ -0,0 +1,24 @@
+open Ppxlib
+
+(** [curry_args args body] adds parameter to [body]
+
+    e.g.:
+    curry_args [gen_a; gen_b] () => fun gen_a -> fun gen_b -> ()
+*)
+let rec curry_args ~loc args body =
+  match args with
+  | [] -> body
+  | x :: xs -> [%expr fun [%p x] -> [%e curry_args ~loc xs body]]
+
+(** [apply_args args body] applies parameters to [body]
+
+    e.g.:
+    apply_args [gen_a; gen_b] f => f gen_a gen_b
+*)
+let apply_args ~loc args body =
+  let rec aux acc = function
+    | [] -> acc
+    | [arg] -> [%expr [%e acc] [%e arg]]
+    | arg :: args -> aux [%expr [%e acc] [%e arg]] args
+  in
+  aux body args
diff --git a/src/ppx_deriving_qcheck/attributes.ml b/src/ppx_deriving_qcheck/attributes.ml
new file mode 100644
index 0000000..cb26433
--- /dev/null
+++ b/src/ppx_deriving_qcheck/attributes.ml
@@ -0,0 +1,19 @@
+open Ppxlib
+
+(** [find_first_attribute xs name] returns the first attribute found in [xs]
+    named [name] *)
+let find_attribute_opt xs name =
+  List.find_opt (fun attribute -> attribute.attr_name.txt = name) xs
+
+let get_expr_payload x =
+  match x.attr_payload with
+  | PStr [ { pstr_desc = Pstr_eval (e, _); _ } ] -> Some [%expr [%e e]]
+  | _ -> None
+
+let gen ct =
+  Option.fold ~none:None ~some:get_expr_payload
+  @@ find_attribute_opt ct.ptyp_attributes "gen"
+
+let weight xs =
+  Option.fold ~none:None ~some:get_expr_payload
+  @@ find_attribute_opt xs "weight"
diff --git a/src/ppx_deriving_qcheck/attributes.mli b/src/ppx_deriving_qcheck/attributes.mli
new file mode 100644
index 0000000..f8bd41e
--- /dev/null
+++ b/src/ppx_deriving_qcheck/attributes.mli
@@ -0,0 +1,28 @@
+open Ppxlib
+(** This file handles every attributes to be found in a core_type definition *)
+
+val gen : core_type -> expression option
+(** [gen loc ct] look for an attribute "gen" in [ct]
+
+    example:
+    {[
+    type t =
+    | A of int
+    | B of (int [@gen QCheck.int32])
+    ]}
+
+    It allows the user to specify which generator he wants for a specific type.
+    Returns the generator as an expression and returns None if no attribute
+    is present *)
+
+val weight : attributes -> expression option
+(** [weight loc ct] look for an attribute "weight" in [ct]
+
+    example:
+    {[
+    type t =
+    | A [@weight 5]
+    | B [@weight 6]
+    | C
+    ]}
+    It allows the user to specify the weight of a type case. *)
diff --git a/src/ppx_deriving_qcheck/dune b/src/ppx_deriving_qcheck/dune
new file mode 100644
index 0000000..fbff5b0
--- /dev/null
+++ b/src/ppx_deriving_qcheck/dune
@@ -0,0 +1,7 @@
+(library
+ (name ppx_deriving_qcheck)
+ (public_name ppx_deriving_qcheck)
+ (libraries ppxlib)
+ (preprocess (pps ppxlib.metaquot))
+ (ppx_runtime_libraries qcheck-core)
+ (kind ppx_deriver))
diff --git a/src/ppx_deriving_qcheck/ppx_deriving_qcheck.ml b/src/ppx_deriving_qcheck/ppx_deriving_qcheck.ml
new file mode 100644
index 0000000..0de8f51
--- /dev/null
+++ b/src/ppx_deriving_qcheck/ppx_deriving_qcheck.ml
@@ -0,0 +1,526 @@
+open Ppxlib
+module G = QCheck_generators
+module O = G.Observable
+
+(** {1. ppx_deriving_qcheck} *)
+
+(** ppx_deriving_qcheck is a ppx deriver for QCheck generators. It does a
+    traversal map on type declarations annoted with [QCheck].
+
+    Example:
+    {[
+    module Tree : sig
+      type t
+
+      val gen : t QCheck.Gen.t
+    end = struct
+      type t = Leaf | Node of int * t * t
+      [@@deriving qcheck]
+    end
+    ]}
+*)
+
+(** {2. Misc. helpers} *)
+
+(** [name s] produces the generator name based on [s] *)
+let name ?(sized = false) s =
+  let prefix = "gen" in
+  (match s with "t" -> prefix | s -> prefix ^ "_" ^ s) ^
+    (if sized then "_sized" else "")
+
+(** [pat ~loc s] creates a pattern for a generator based on {!name}. *)
+let pat ~loc ?sized s =
+  let (module A) = Ast_builder.make loc in
+  let s = name ?sized s in
+  A.pvar s
+
+(** {2. Recursive generators} *)
+
+(** Recursive generators must be treated separatly:
+
+    {[
+    type 'a list = Cons of 'a * 'a list | Nil
+    ]}
+
+    becomes:
+
+    {[
+    let rec gen_list_sized gen_a n =
+      match n with
+      | 0 -> pure Nil
+      | n -> map2 (fun x xs -> Cons (x, xs) gen_a (gen_list_sized gen_a (n/2))
+
+    let gen_list_sized gen_a = sized @@ (gen_list_sized gen_a)
+    ]}
+
+    In the basic derivation {[ 'a list ]} would be translated to {[gen_list]}.
+    However, we want the generator to call itsef.
+ *)
+
+module Env = struct
+  (** [env] contains:
+      - the list of recursive types during the derivation
+      - the list of types to derive (i.e. mutual types)
+      - the current type to derive *)
+  type env = {
+      rec_types : string list;
+      curr_types : string list;
+      curr_type : string;
+    }
+
+  let is_rec env x = List.mem x env.rec_types
+end
+
+let rec longident_to_str = function
+  | Lident s -> s
+  | Ldot (lg, s) -> Printf.sprintf "%s.%s" (longident_to_str lg) s
+  | Lapply (lg1, lg2) ->
+      Printf.sprintf "%s %s" (longident_to_str lg1) (longident_to_str lg2)
+
+let rec is_rec_typ env = function
+  | { ptyp_desc = Ptyp_constr ({ txt = x; _ }, _); _ } ->
+     List.exists (fun typ_name -> longident_to_str x = typ_name) env.Env.curr_types
+  | { ptyp_desc = Ptyp_tuple xs; _ } -> List.exists (is_rec_typ env) xs
+  | { ptyp_desc = Ptyp_variant (rws, _, _); _ } ->
+     List.exists (is_rec_row_field env) rws
+  | _ -> false
+
+and is_rec_row_field env rw =
+  match rw.prf_desc with
+  | Rtag (lab, _, cts) ->
+     List.exists (fun typ_name -> lab.txt = typ_name) env.Env.curr_types ||
+       List.exists (is_rec_typ env) cts
+  | Rinherit ct -> is_rec_typ env ct
+
+let is_rec_constr_decl env cd =
+  match cd.pcd_args with
+  | Pcstr_tuple cts -> List.exists (is_rec_typ env) cts
+  | _ -> false
+
+(** [is_rec_type_decl env typ] looks for elements of [env.curr_types]
+    recursively in [typ]. *)
+let is_rec_type_decl env typ =
+  let in_type_kind =
+    match typ.ptype_kind with
+    | Ptype_variant cstrs -> List.exists (is_rec_constr_decl env) cstrs
+    | _ -> false
+  in
+  let in_manifest =
+    match typ.ptype_manifest with
+    | Some x -> is_rec_typ env x
+    | None -> false
+  in
+  in_type_kind || in_manifest
+
+
+(** is_n_used looks for `n` (size indication) in an expression.
+
+    For instance:
+    {[
+    type foo = A of bar | B of bar
+    and bar = Any
+    [@@deriving qcheck]
+
+    let rec gen_sized_foo n =
+      let open QCheck.Gen in
+      frequency [
+        (map (fun x -> A x) gen_bar);
+        (map (fun x -> B x) gen_bar);
+        ]
+    and gen_bar = p
+      let open QCheck.Gen in
+      pure Any
+    ]}
+
+    The type [foo] is recursive because it has a dependency to [bar] but does
+    not use the fuel as there is no "leaves" for this type.
+
+    We begin by looking for occurences of variables `n`, iff we did not find
+    any occurences, we replace `n` by `_n` in the generator's parameters. Thus,
+    avoiding an unused variable.
+ *)
+exception N_is_used
+
+class is_n_used (expr : expression) =
+object(self)
+  inherit Ast_traverse.map as super
+
+  method! expression expr =
+    match expr with
+    | [%expr n ] ->
+       raise N_is_used
+    | _ -> super#expression expr
+
+  method go () =
+    match self#expression expr |> ignore with
+    | exception N_is_used -> true
+    | () -> false
+end
+
+let is_n_used expr = (new is_n_used expr)#go ()
+
+(** {2. Generator constructors} *)
+
+(** [gen_longident lg args] creates a generator using [lg].
+
+    The longident can either be a:
+    - Lident s: We transform to gen_s (or gen if s = "t")
+    - Ldot (lg, s): We transform to qualified generator (e.g. B.gen)
+*)
+let gen_longident ~loc ~env lg args =
+  let (module A) = Ast_builder.make loc in
+  match lg with
+  | Lident s ->
+     if Env.is_rec env s then
+       name ~sized:true s |> A.evar |>
+         Args.apply_args ~loc args |>
+         Args.apply_args ~loc [ [%expr (n / 2)] ]
+     else
+       name s |> A.evar |> Args.apply_args ~loc args
+  | Ldot (lg, s) ->
+     A.(pexp_ident (Located.mk @@ Ldot (lg, name s))) |>
+       Args.apply_args ~loc args
+  | Lapply (_, _) -> raise (Invalid_argument "gen received an Lapply")
+
+(** [gen_sized typ_name is_rec to_gen xs] uses [is_rec] to determine recursive
+    nodes in [xs].
+
+    If no recursive node is found, the type is _not_ recursive, we build a
+    generator using frequency.
+
+    However, if recursive nodes are found, we build a tree like generator using
+    {!gen_sized}.
+
+    The function is generalized for variants and polymorphic variants:
+
+    {[
+    type t = Leaf | Node of int * t * t
+
+    (* or *)
+
+    type t = [`Leaf | `Node of int * t * t]
+    ]}
+
+    Therefore, [is_rec] and [to_gen] are different for variants and polymorphic
+    variants. *)
+let gen_sized ~loc (is_rec : 'a -> bool) (to_gen : 'a -> expression) (xs : 'a list) =
+  let (module A) = Ast_builder.make loc in
+  let leaves =
+    List.filter (fun x -> not (is_rec x)) xs |> List.map to_gen
+  in
+  let nodes = List.filter is_rec xs in
+
+  if List.length nodes = 0 then
+    G.frequency ~loc (A.elist leaves)
+  else if List.length leaves = 0 then
+    let nodes = List.map to_gen nodes in
+    G.frequency ~loc (A.elist nodes)
+  else
+    let nodes = List.map to_gen nodes in
+    let leaves = A.elist leaves |> G.frequency ~loc
+    and nodes = A.elist (leaves @ nodes) |> G.frequency ~loc in
+    [%expr
+        match n with
+        | 0 -> [%e leaves]
+        | _ -> [%e nodes]
+    ]
+
+(** [gen_tuple ~loc ?f tys] transforms list of type [tys] into a tuple generator.
+
+    [f] can be used to transform tuples, for instance:
+    {[
+    type t = Foo of int * int
+    ]}
+
+    Without [f]:
+    {[
+    let gen = QCheck.Gen.(map (fun (x, y) -> (x, y)) (pair int int))
+    ]}
+
+    With [f], building Foo:
+    {[
+    let gen = QCheck.Gen.(map (fun (x, y) -> Foo (x, y)) (pair int int))
+    ]}
+*)
+let gen_tuple ~loc ?(f = fun x -> x) tys =
+  let tuple = Tuple.from_list tys in
+  let gen = Tuple.to_gen ~loc tuple in
+  let expr = Tuple.to_expr ~loc tuple |> f in
+  let pat = Tuple.to_pat ~loc tuple in
+  G.map ~loc pat expr gen
+
+(** [gen_record loc gens ?f label_decls] transforms [gens] and [label_decls] to
+    a record generator.
+
+    Similarly to {!gen_tuple}, we can use [f] to transform records, for instance:
+    {[
+    type t = Foo of { left : int; right : int }
+    ]}
+
+    Without [f]:
+    {[
+    let gen = QCheck.Gen.(map (fun (x, y) -> {left = x; right = y}) (pair int int))
+    ]}
+
+    With [f], building Foo:
+    {[
+    let gen = QCheck.Gen.(map (fun (x, y) -> Foo {left = x; right = y}) (pair int int))
+    ]}
+
+*)
+let gen_record ~loc ~gens ?(f = fun x -> x) xs =
+  let (module A) = Ast_builder.make loc in
+  let tuple = Tuple.from_list gens in
+  let gen = Tuple.to_gen ~loc tuple in
+  let pat = Tuple.to_pat ~loc tuple in
+  (* TODO: this should be handled in {!Tuple} *)
+  let gens =
+    List.mapi
+      (fun i _ ->
+        let s = Printf.sprintf "gen%d" i in
+        A.evar s)
+      gens
+  in
+  let fields =
+    List.map2
+      (fun { pld_name; _ } value ->
+        (A.Located.mk @@ Lident pld_name.txt, value))
+      xs gens
+  in
+  let expr = A.pexp_record fields None |> f in
+
+  G.map ~loc pat expr gen
+
+(** {2. Core derivation} *)
+
+(** [gen_from_type typ] performs the AST traversal and derivation to qcheck generators *)
+let rec gen_from_type ~loc ~env typ =
+  Option.value (Attributes.gen typ)
+    ~default:
+      (match typ with
+      | [%type: unit] -> G.unit loc
+      | [%type: int] -> G.int loc
+      | [%type: string] | [%type: String.t] -> G.string loc
+      | [%type: char] -> G.char loc
+      | [%type: bool] -> G.bool loc
+      | [%type: float] -> G.float loc
+      | [%type: int32] | [%type: Int32.t] -> G.int32 loc
+      | [%type: int64] | [%type: Int64.t] -> G.int64 loc
+      | [%type: [%t? typ] option] -> G.option ~loc (gen_from_type ~loc ~env typ)
+      | [%type: [%t? typ] list] -> G.list ~loc (gen_from_type ~loc ~env typ)
+      | [%type: [%t? typ] array] -> G.array ~loc (gen_from_type ~loc ~env typ)
+      | { ptyp_desc = Ptyp_tuple typs; _ } ->
+          let tys = List.map (gen_from_type ~loc ~env) typs in
+          gen_tuple ~loc tys
+      | { ptyp_desc = Ptyp_constr ({ txt = ty; _ }, args); _ } ->
+          let args = List.map (gen_from_type ~loc ~env) args in
+          gen_longident ~loc ~env ty args
+      | { ptyp_desc = Ptyp_var s; _ } ->
+          gen_longident ~loc ~env (Lident s) []
+      | { ptyp_desc = Ptyp_variant (rws, _, _); _ } ->
+          gen_from_variant ~loc ~env rws
+      | { ptyp_desc = Ptyp_arrow (_, left, right); _ } ->
+          gen_from_arrow ~loc ~env left right
+      | _ ->
+          Ppxlib.Location.raise_errorf ~loc
+            "This type is not supported in ppx_deriving_qcheck")
+
+and gen_from_constr ~loc ~env { pcd_name; pcd_args; pcd_attributes; _ } =
+  let (module A) = Ast_builder.make loc in
+  let constr_decl =
+    A.constructor_declaration ~name:pcd_name ~args:pcd_args ~res:None
+  in
+  let mk_constr expr = A.econstruct constr_decl (Some expr) in
+  let weight = Attributes.weight pcd_attributes in
+  let gen =
+    match pcd_args with
+    | Pcstr_tuple [] | Pcstr_record [] ->
+        G.pure ~loc @@ A.econstruct constr_decl None
+    | Pcstr_tuple xs ->
+        let tys = List.map (gen_from_type ~loc ~env) xs in
+        gen_tuple ~loc ~f:mk_constr tys
+    | Pcstr_record xs ->
+        let tys = List.map (fun x -> gen_from_type ~loc ~env x.pld_type) xs in
+        gen_record ~loc ~f:mk_constr ~gens:tys xs
+  in
+
+  A.pexp_tuple [ Option.value ~default:[%expr 1] weight; gen ]
+
+and gen_from_variant ~loc ~env rws =
+  let (module A) = Ast_builder.make loc in
+  let is_rec = is_rec_row_field env in
+  let to_gen (row : row_field) : expression =
+    let w =
+      Attributes.weight row.prf_attributes |> Option.value ~default:[%expr 1]
+    in
+    let gen =
+      match row.prf_desc with
+      | Rinherit typ -> gen_from_type ~loc ~env typ
+      | Rtag (label, _, []) -> G.pure ~loc @@ A.pexp_variant label.txt None
+      | Rtag (label, _, typs) ->
+          let f expr = A.pexp_variant label.txt (Some expr) in
+          gen_tuple ~loc ~f (List.map (gen_from_type ~loc ~env) typs)
+    in
+    [%expr [%e w], [%e gen]]
+  in
+  let gen = gen_sized ~loc is_rec to_gen rws in
+  let typ_t = A.ptyp_constr (A.Located.mk @@ Lident env.curr_type) [] in
+  let typ_gen = A.Located.mk G.ty in
+  let typ = A.ptyp_constr typ_gen [ typ_t ] in
+  [%expr ([%e gen] : [%t typ])]
+
+and gen_from_arrow ~loc ~env left right =
+  let rec observable = function
+    | [%type: unit] -> O.unit loc
+    | [%type: bool] -> O.bool loc
+    | [%type: int] -> O.int loc
+    | [%type: float] -> O.float loc
+    | [%type: string] -> O.string loc
+    | [%type: char] -> O.char loc
+    | [%type: [%t? typ] option] -> O.option ~loc (observable typ)
+    | [%type: [%t? typ] array] -> O.array ~loc (observable typ)
+    | [%type: [%t? typ] list] -> O.list ~loc (observable typ)
+    | { ptyp_desc = Ptyp_tuple xs; _ } ->
+        let obs = List.map observable xs in
+        Tuple.from_list obs |> Tuple.to_obs ~loc
+    | { ptyp_loc = loc; _ } ->
+        Ppxlib.Location.raise_errorf ~loc
+          "This type is not supported in ppx_deriving_qcheck"
+  in
+  let rec aux = function
+    | { ptyp_desc = Ptyp_arrow (_, x, xs); _ } ->
+        let res, xs = aux xs in
+        let obs = observable x in
+        (res, [%expr [%e obs] @-> [%e xs]])
+    | x -> (gen_from_type ~loc ~env x, [%expr o_nil])
+  in
+  let x, obs = aux right in
+  (* TODO: export this in qcheck_generators for https://github.com/c-cube/qcheck/issues/190 *)
+  let arb = [%expr QCheck.make [%e x]] in
+  [%expr
+    QCheck.fun_nary QCheck.Tuple.([%e observable left] @-> [%e obs]) [%e arb]
+    |> QCheck.gen]
+
+(** [gen_from_type_declaration loc td] creates a generator from the type declaration.
+
+    It returns either `Recursive or `Normal.
+
+    - `Normal of expression:
+    The derived generator is not recursive, we return only the generator.
+
+    - `Recursive of expression * expression
+    The derived generator was recursive (i.e. val gen : n -> t Gen.t), we return
+    the sized generator version, and a normal generator using this last with
+    [Gen.sized].
+*)
+let gen_from_type_declaration ~loc ~env td =
+  let (module A) = Ast_builder.make loc in
+  let ty = env.Env.curr_type in
+  let is_rec = Env.is_rec env ty in
+
+  let args =
+    List.map
+      (fun (typ, _) ->
+        match typ.ptyp_desc with
+        | Ptyp_var s -> (pat ~loc s, name s |> A.evar)
+        | _ -> assert false)
+      td.ptype_params
+  in
+  let (args_pat, args_expr) = List.split args in
+
+  let gen =
+    match td.ptype_kind with
+    | Ptype_variant xs ->
+        let is_rec cd = is_rec_constr_decl env cd in
+        gen_sized ~loc is_rec (gen_from_constr ~loc ~env) xs
+    | Ptype_record xs ->
+        let gens = List.map (fun x -> gen_from_type ~loc ~env x.pld_type) xs in
+        gen_record ~loc ~gens xs
+    | _ ->
+        let typ = Option.get td.ptype_manifest in
+        gen_from_type ~loc ~env typ
+  in
+
+  let pat_gen = pat ~loc ty in
+  if not is_rec then
+    let gen = Args.curry_args ~loc args_pat gen in
+    `Normal [%stri let [%p pat_gen] = [%e gen]]
+  else
+    let args =
+      if is_n_used gen then args_pat @ [A.pvar "n"]
+      else args_pat @ [A.pvar "_n"]
+    in
+    let gen = Args.curry_args ~loc args gen in
+    let pat_gen_sized = pat ~loc ~sized:true ty in
+    let gen_sized = name ~sized:true ty |> A.evar in
+    let gen_normal =
+      Args.curry_args ~loc args_pat
+        (G.sized ~loc (Args.apply_args ~loc args_expr gen_sized))
+    in
+    `Recursive (
+        [%stri let rec [%p pat_gen_sized] = [%e gen]],
+        [%stri let [%p pat_gen] = [%e gen_normal]]
+      )
+
+let mutually_recursive_gens ~loc gens =
+  let (module A) = Ast_builder.make loc in
+  let to_mutualize_gens =
+    List.map (function
+        | `Recursive (x, _) -> x
+        | `Normal x -> x) gens
+  in
+  let normal_gens =
+    List.filter_map (function
+        | `Recursive (_, x) -> Some x
+        | `Normal _ -> None) gens
+  in
+  let gens =
+    List.map (function
+        | [%stri let [%p? pat] = [%e? expr]]
+          | [%stri let rec [%p? pat] = [%e? expr]] ->
+           A.value_binding ~pat ~expr
+        | _ -> assert false) to_mutualize_gens
+  in
+  let mutual_gens = A.pstr_value Recursive gens in
+  mutual_gens :: normal_gens
+
+(** [derive_gen ~loc xs] creates generators for type declaration in [xs]. *)
+let derive_gen ~loc (xs : rec_flag * type_declaration list) : structure =
+  let open Env in
+  let add_if_rec env typ x =
+    if is_rec_type_decl env typ then
+      { env with rec_types = x :: env.rec_types}
+    else env
+  in
+  match xs with
+  | (_, [ x ]) ->
+     let typ_name = x.ptype_name.txt in
+     let env = { curr_type = typ_name; rec_types = []; curr_types = [typ_name] } in
+     let env = add_if_rec env x typ_name in
+     (match gen_from_type_declaration ~loc ~env x with
+      | `Recursive (gen_sized, gen) -> [gen_sized; gen]
+      | `Normal gen -> [gen])
+  | _, xs ->
+     let typ_names = List.map (fun x -> x.ptype_name.txt) xs in
+     let env = { curr_type = ""; rec_types = []; curr_types = typ_names } in
+     let env =
+       List.fold_left
+         (fun env x -> add_if_rec env x x.ptype_name.txt)
+         env xs
+     in
+     let gens =
+       List.map (fun x ->
+           let env = { env with curr_type = x.ptype_name.txt }in
+           gen_from_type_declaration ~loc ~env x) xs
+     in
+     mutually_recursive_gens ~loc gens
+
+(** {2. Ppxlib machinery} *)
+
+let create_gen ~ctxt (decls : rec_flag * type_declaration list) : structure =
+  let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+  derive_gen ~loc decls
+
+let gen_expander = Deriving.Generator.V2.make_noarg create_gen
+
+let _ = Deriving.add "qcheck" ~str_type_decl:gen_expander
diff --git a/src/ppx_deriving_qcheck/ppx_deriving_qcheck.mli b/src/ppx_deriving_qcheck/ppx_deriving_qcheck.mli
new file mode 100644
index 0000000..1d2fe7c
--- /dev/null
+++ b/src/ppx_deriving_qcheck/ppx_deriving_qcheck.mli
@@ -0,0 +1,4 @@
+open Ppxlib
+
+val derive_gen : loc:location -> rec_flag * type_declaration list -> structure
+(** [derive_gen loc xs] derives a generator for each type_declaration in [xs] *)
diff --git a/src/ppx_deriving_qcheck/tuple.ml b/src/ppx_deriving_qcheck/tuple.ml
new file mode 100644
index 0000000..8919415
--- /dev/null
+++ b/src/ppx_deriving_qcheck/tuple.ml
@@ -0,0 +1,135 @@
+open Ppxlib
+module G = QCheck_generators
+module O = G.Observable
+
+(** {1. Tuple } *)
+
+(** This module implements nested tuples based on QCheck tuples generators (or observables):
+    - [Gen.pair]
+    - [Gen.triple]
+    - [Gen.quad]
+
+    It can be used to nest large tuples in a generator.
+    - e.g.
+    {[
+    type t = int * int * int
+    ]}
+
+    Lets say QCheck does not have combinator to generate a triple. One has to write:
+
+    {[
+    let gen = QCheck.Gen.(map (fun ((x, y), z) -> (x, y, z) (pair (pair int int) int))
+    ]}
+
+    We copy this nesting mechanism with this module.
+ *)
+
+type 'a t =
+  | Pair of 'a t * 'a t
+  | Triple of 'a * 'a * 'a
+  | Quad of 'a * 'a * 'a * 'a
+  | Elem of 'a
+
+(** [from_list l] builds an {!'a t}, if len of [l] is greater than 4, the list
+    is split into a [Pair] of generators. *)
+let rec from_list = function
+  | [ a; b; c; d ] -> Quad (a, b, c, d)
+  | [ a; b; c ] -> Triple (a, b, c)
+  | [ a; b ] -> Pair (Elem a, Elem b)
+  | [ a ] -> Elem a
+  | l ->
+     let n = List.length l / 2 in
+     let i = ref 0 in
+     let l1 =
+       List.filter
+         (fun _ ->
+           let x = !i in
+           i := x + 1;
+           x < n)
+            l
+     in
+     i := 0;
+     let l2 =
+       List.filter
+         (fun _ ->
+           let x = !i in
+           i := x + 1;
+           x >= n)
+         l
+     in
+     Pair (from_list l1, from_list l2)
+
+let rec to_list = function
+  | Quad (a, b, c, d) -> [ a; b; c; d ]
+  | Triple (a, b, c) -> [ a; b; c ]
+  | Pair (a, b) -> to_list a @ to_list b
+  | Elem a -> [ a ]
+
+(** [to_expr ~loc t] creates a tuple expression based on [t].
+    [t] is transformed to a list, and each element from the list becomes
+    a variable referencing a generator.
+
+    - e.g.
+    to_expr (Pair (_, _)) => (gen0, gen1)
+ *)
+let to_expr ~loc t =
+  let l = to_list t in
+  let (module A) = Ast_builder.make loc in
+  List.mapi
+    (fun i _ ->
+      let s = Printf.sprintf "gen%d" i in
+      A.evar s)
+    l
+  |> A.pexp_tuple
+
+(** [nest pair triple quad t] creates a generator expression for [t] using
+
+    - [pair] to combine Pair (_, _)
+    - [triple] to combine Triple (_, _, )
+    - [quad] to combine Quad (_, _, _, _)
+*)
+let rec nest ~pair ~triple ~quad = function
+  | Quad (a, b, c, d) -> quad a b c d
+  | Triple (a, b, c) -> triple a b c
+  | Pair (a, b) ->
+     pair
+       (nest ~pair ~triple ~quad a)
+       (nest ~pair ~triple ~quad b)
+  | Elem a -> a
+
+(** [to_gen t] creates a Gen.t with generators' combinators *)
+let to_gen ~loc t =
+  nest ~pair:(G.pair ~loc) ~triple:(G.triple ~loc) ~quad:(G.quad ~loc) t
+
+(** [to_obs t] creates a Obs.t with obsersvables' combinators *)
+let to_obs ~loc t =
+  nest ~pair:(O.pair ~loc) ~triple:(O.triple ~loc) ~quad:(O.quad ~loc) t
+
+let to_pat ~loc t =
+  let fresh_id =
+    let id = ref 0 in
+    fun () ->
+    let x = !id in
+    let () = id := x + 1 in
+    Printf.sprintf "gen%d" x
+  in
+  let (module A) = Ast_builder.make loc in
+  let rec aux = function
+    | Quad (_, _, _, _) ->
+       let a = A.pvar @@ fresh_id () in
+       let b = A.pvar @@ fresh_id () in
+       let c = A.pvar @@ fresh_id () in
+       let d = A.pvar @@ fresh_id () in
+       [%pat? [%p a], [%p b], [%p c], [%p d]]
+    | Triple (_, _, _) ->
+       let a = A.pvar @@ fresh_id () in
+       let b = A.pvar @@ fresh_id () in
+       let c = A.pvar @@ fresh_id () in
+       [%pat? [%p a], [%p b], [%p c]]
+    | Pair (a, b) ->
+       let a = aux a in
+       let b = aux b in
+       [%pat? [%p a], [%p b]]
+    | Elem _ -> A.pvar @@ fresh_id ()
+  in
+  aux t
diff --git a/src/runner/QCheck_base_runner.ml b/src/runner/QCheck_base_runner.ml
index ac66feb..a5edbce 100644
--- a/src/runner/QCheck_base_runner.ml
+++ b/src/runner/QCheck_base_runner.ml
@@ -219,28 +219,14 @@ let debug_shrinking_counter_example cell out x =
   | None -> Printf.fprintf out "<no printer provided>"
   | Some print -> Printf.fprintf out "%s" (print x)
 
-let debug_shrinking_choices_aux ~colors out name i cell x =
+let debug_shrinking_choices ~colors ~out ~name cell ~step x =
   Printf.fprintf out "\n~~~ %a %s\n\n"
     (Color.pp_str_c ~colors `Cyan) "Shrink" (String.make 69 '~');
   Printf.fprintf out
     "Test %s successfully shrunk counter example (step %d) to:\n\n%a\n%!"
-    name i
+    name step
     (debug_shrinking_counter_example cell) x
 
-let debug_shrinking_choices
-    ~colors ~debug_shrink ~debug_shrink_list name cell i x =
-  match debug_shrink with
-  | None -> ()
-  | Some out ->
-    begin match debug_shrink_list with
-      | [] ->
-        debug_shrinking_choices_aux ~colors out name i cell x
-      | l when List.mem name l ->
-        debug_shrinking_choices_aux ~colors out name i cell x
-      | _ -> ()
-    end
-
-
 let default_handler
   ~colors ~debug_shrink ~debug_shrink_list
   ~size ~out ~verbose c =
@@ -256,9 +242,20 @@ let default_handler
     in
     (* debug shrinking choices *)
     begin match r with
-      | QCheck2.Test.Shrunk (i, x) ->
-          debug_shrinking_choices
-          ~colors ~debug_shrink ~debug_shrink_list name cell i x
+      | QCheck2.Test.Shrunk (step, x) ->
+        begin match debug_shrink with
+          | None -> ()
+          | Some out ->
+            let go =
+              match debug_shrink_list with
+              | [] -> true
+              | test_list -> List.mem name test_list
+            in
+            if not go then ()
+            else
+              debug_shrinking_choices
+                ~colors ~out ~name cell ~step x
+        end
       | _ ->
         ()
     end;
diff --git a/src/runner/QCheck_base_runner.mli b/src/runner/QCheck_base_runner.mli
index cc52e1a..d0e23a5 100644
--- a/src/runner/QCheck_base_runner.mli
+++ b/src/runner/QCheck_base_runner.mli
@@ -87,6 +87,16 @@ type handler_gen =
 val default_handler : handler_gen
 (** The default handler used. *)
 
+val debug_shrinking_choices:
+  colors:bool ->
+  out:out_channel ->
+  name:string -> 'a QCheck2.Test.cell -> step:int -> 'a -> unit
+(** The function used by the default handler to debug shrinking choices.
+    This can be useful to outside users trying to reproduce some of the
+    base-runner behavior.
+
+    @since 0.19
+*)
 
 (** {2 Run a Suite of Tests and Get Results} *)
 
diff --git a/test/core/QCheck2_expect_test.ml b/test/core/QCheck2_expect_test.ml
index e6653e0..91e82e3 100644
--- a/test/core/QCheck2_expect_test.ml
+++ b/test/core/QCheck2_expect_test.ml
@@ -65,6 +65,10 @@ module Overall = struct
       ]
       (Gen.int_bound 120) (fun _ -> true)
 
+  let retries =
+    Test.make ~name:"with shrinking retries" ~retries:10 ~print:Print.int
+      Gen.small_nat (fun i -> Printf.printf "%i %!" i; i mod 3 <> 1)
+
   let bad_assume_warn =
     Test.make ~name:"WARN_unlikely_precond" ~count:2_000 ~print:Print.int
       Gen.int
@@ -79,6 +83,18 @@ module Overall = struct
       (fun x ->
          QCheck.assume (x mod 100 = 1);
          true)
+
+  let tests = [
+    passing;
+    failing;
+    error;
+    collect;
+    stats;
+    retries;
+    bad_assume_warn;
+    bad_assume_fail;
+  ]
+
 end
 
 (* positive tests of the various generators *)
@@ -130,6 +146,79 @@ module Generator = struct
       ~name:"tree_rev_is_involutive"
       IntTree.gen_tree
       (fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree)
+
+  let test_tup2 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1): x = (0, 1)"
+      Gen.(tup2 (pure 0) (pure 1))
+      (fun x -> x = (0, 1))
+
+  let test_tup3 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2): x = (0, 1, 2)"
+      Gen.(tup3 (pure 0) (pure 1) (pure 2))
+      (fun x -> x = (0, 1, 2))
+
+  let test_tup4 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3): x = (0, 1, 2, 3)"
+      Gen.(tup4 (pure 0) (pure 1) (pure 2) (pure 3))
+      (fun x -> x = (0, 1, 2, 3))
+
+  let test_tup5 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4): x = (0, 1, 2, 3, 4)"
+      Gen.(tup5 (pure 0) (pure 1) (pure 2) (pure 3) (pure 4))
+      (fun x -> x = (0, 1, 2, 3, 4))
+
+  let test_tup6 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4, 5): x = (0, 1, 2, 3, 4, 5)"
+      Gen.(tup6 (pure 0) (pure 1) (pure 2) (pure 3) (pure 4) (pure 5))
+      (fun x -> x = (0, 1, 2, 3, 4, 5))
+
+  let test_tup7 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4, 5, 6): x = (0, 1, 2, 3, 4, 5, 6)"
+      Gen.(tup7
+         (pure 0) (pure 1) (pure 2) (pure 3) (pure 4)
+         (pure 5) (pure 6))
+      (fun x -> x = (0, 1, 2, 3, 4, 5, 6))
+
+  let test_tup8 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4, 5, 6, 7): x = (0, 1, 2, 3, 4, 5, 6, 7)"
+      Gen.(tup8
+         (pure 0) (pure 1) (pure 2) (pure 3) (pure 4)
+         (pure 5) (pure 6) (pure 7))
+      (fun x -> x = (0, 1, 2, 3, 4, 5, 6, 7))
+
+  let test_tup9 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4, 5, 6, 7, 8): x = (0, 1, 2, 3, 4, 5, 6, 7, 8)"
+      Gen.(tup9
+         (pure 0) (pure 1) (pure 2) (pure 3) (pure 4)
+         (pure 5) (pure 6) (pure 7) (pure 8))
+      (fun x -> x = (0, 1, 2, 3, 4, 5, 6, 7, 8))
+
+  let tests = [
+    char_dist_issue_23;
+    char_test;
+    nat_test;
+    string_test;
+    list_test;
+    list_repeat_test;
+    array_repeat_test;
+    passing_tree_rev;
+    test_tup2;
+    test_tup3;
+    test_tup4;
+    test_tup5;
+    test_tup6;
+    test_tup7;
+    test_tup8;
+    test_tup9;
+  ]
 end
 
 (* negative tests that exercise shrinking behaviour *)
@@ -236,6 +325,91 @@ module Shrink = struct
     Test.make ~name:"tree contains only 42" ~print:IntTree.print_tree
       IntTree.gen_tree
       (fun tree -> IntTree.contains_only_n tree 42)
+
+  let test_tup2 =
+    Test.make
+      ~print:Print.(tup2 int int)
+      ~name:"forall (a, b) in nat: a < b"
+      Gen.(tup2 small_int small_int)
+      (fun (a, b) -> a < b)
+
+  let test_tup3 =
+    Test.make
+      ~print:Print.(tup3 int int int)
+      ~name:"forall (a, b, c) in nat: a < b < c"
+      Gen.(tup3 small_int small_int small_int)
+      (fun (a, b, c) -> a < b && b < c)
+
+  let test_tup4 =
+    Test.make
+      ~print:Print.(tup4 int int int int)
+      ~name:"forall (a, b, c, d) in nat: a < b < c < d"
+      Gen.(tup4 small_int small_int small_int small_int)
+      (fun (a, b, c, d) -> a < b && b < c && c < d)
+
+  let test_tup5 =
+    Test.make
+      ~print:Print.(tup5 int int int int int)
+      ~name:"forall (a, b, c, d, e) in nat: a < b < c < d < e"
+      Gen.(tup5 small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e) -> a < b && b < c && c < d && d < e)
+
+  let test_tup6 =
+    Test.make
+      ~print:Print.(tup6 int int int int int int)
+      ~name:"forall (a, b, c, d, e, f) in nat: a < b < c < d < e < f"
+      Gen.(tup6 small_int small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e, f) -> a < b && b < c && c < d && d < e && e < f)
+
+  let test_tup7 =
+    Test.make
+      ~print:Print.(tup7 int int int int int int int)
+      ~name:"forall (a, b, c, d, e, f, g) in nat: a < b < c < d < e < f < g"
+      Gen.(tup7 small_int small_int small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e, f, g) -> a < b && b < c && c < d && d < e && e < f && f < g)
+
+  let test_tup8 =
+    Test.make
+      ~print:Print.(tup8 int int int int int int int int)
+      ~name:"forall (a, b, c, d, e, f, g, h) in nat: a < b < c < d < e < f < g < h"
+      Gen.(tup8 small_int small_int small_int small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e, f, g, h) -> a < b && b < c && c < d && d < e && e < f && f < g && g < h)
+
+  let test_tup9 =
+    Test.make
+      ~print:Print.(tup9 int int int int int int int int int)
+      ~name:"forall (a, b, c, d, e, f, g, h, i) in nat: a < b < c < d < e < f < g < h < i"
+      Gen.(tup9 small_int small_int small_int small_int small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e, f, g, h, i) -> a < b && b < c && c < d && d < e && e < f && f < g && g < h && h < i)
+
+  let tests = [
+    (*test_fac_issue59;*)
+    big_bound_issue59;
+    long_shrink;
+    ints_arent_0_mod_3;
+    ints_are_0;
+    ints_smaller_209609;
+    nats_smaller_5001;
+    char_is_never_abcdef;
+    strings_are_empty;
+    string_never_has_000_char;
+    string_never_has_255_char;
+    lists_are_empty_issue_64;
+    list_shorter_10;
+    list_shorter_432;
+    list_shorter_4332;
+    list_equal_dupl;
+    list_unique_elems;
+    tree_contains_only_42;
+    test_tup2;
+    test_tup3;
+    test_tup4;
+    test_tup5;
+    test_tup6;
+    test_tup7;
+    test_tup8;
+    test_tup9;
+  ]
 end
 
 (* tests function generator and shrinker *)
@@ -313,6 +487,15 @@ module Function = struct
          let f = Fn.apply f in
          List.fold_left f acc (is @ js)
          = List.fold_left f (List.fold_left f acc is) is) (*Typo*)
+
+  let tests = [
+    fail_pred_map_commute;
+    fail_pred_strings;
+    prop_foldleft_foldright;
+    prop_foldleft_foldright_uncurry;
+    prop_foldleft_foldright_uncurry_funlast;
+    fold_left_test;
+  ]
 end
 
 (* tests of (inner) find_example(_gen) behaviour *)
@@ -337,6 +520,12 @@ module FindExample = struct
   let find_ex_uncaught_issue_99_2_succeed =
     Test.make ~name:"should_succeed_#99_2" ~count:10
       Gen.int (fun i -> i <= max_int)
+
+  let tests = [
+    find_ex;
+    find_ex_uncaught_issue_99_1_fail;
+    find_ex_uncaught_issue_99_2_succeed;
+  ]
 end
 
 (* tests of statistics and histogram display *)
@@ -401,62 +590,31 @@ module Stats = struct
   let tree_depth_test =
     let depth = ("depth", IntTree.depth) in
     Test.make ~name:"tree's depth" ~count:1000 ~stats:[depth] IntTree.gen_tree (fun _ -> true)
+
+  let tests =
+    [
+      bool_dist;
+      char_dist;
+      tree_depth_test
+    ]
+    @ string_len_tests
+    @ list_len_tests
+    @ array_len_tests
+    @ int_dist_tests
+
 end
 
 (* Calling runners *)
 
 let () = QCheck_base_runner.set_seed 1234
 let _ =
-  QCheck_base_runner.run_tests ~colors:false ([
-    Overall.passing;
-    Overall.failing;
-    Overall.error;
-    Overall.collect;
-    Overall.stats;
-    Overall.bad_assume_warn;
-    Overall.bad_assume_fail;
-    Generator.char_dist_issue_23;
-    Generator.char_test;
-    Generator.nat_test;
-    Generator.string_test;
-    Generator.list_test;
-    Generator.list_repeat_test;
-    Generator.array_repeat_test;
-    Generator.passing_tree_rev;
-    (*Shrink.test_fac_issue59;*)
-    Shrink.big_bound_issue59;
-    Shrink.long_shrink;
-    Shrink.ints_arent_0_mod_3;
-    Shrink.ints_are_0;
-    Shrink.ints_smaller_209609;
-    Shrink.nats_smaller_5001;
-    Shrink.char_is_never_abcdef;
-    Shrink.strings_are_empty;
-    Shrink.string_never_has_000_char;
-    Shrink.string_never_has_255_char;
-    Shrink.lists_are_empty_issue_64;
-    Shrink.list_shorter_10;
-    Shrink.list_shorter_432;
-    Shrink.list_shorter_4332;
-    Shrink.list_equal_dupl;
-    Shrink.list_unique_elems;
-    Shrink.tree_contains_only_42;
-    Function.fail_pred_map_commute;
-    Function.fail_pred_strings;
-    Function.prop_foldleft_foldright;
-    Function.prop_foldleft_foldright_uncurry;
-    Function.prop_foldleft_foldright_uncurry_funlast;
-    Function.fold_left_test;
-    FindExample.find_ex;
-    FindExample.find_ex_uncaught_issue_99_1_fail;
-    FindExample.find_ex_uncaught_issue_99_2_succeed;
-    Stats.bool_dist;
-    Stats.char_dist;
-    Stats.tree_depth_test  ]
-    @ Stats.string_len_tests
-    @ Stats.list_len_tests
-    @ Stats.array_len_tests
-    @ Stats.int_dist_tests)
+  QCheck_base_runner.run_tests ~colors:false (
+    Overall.tests @
+    Generator.tests @
+    Shrink.tests @
+    Function.tests @
+    FindExample.tests @
+    Stats.tests)
 
 let () = QCheck_base_runner.set_seed 153870556
 let _  = QCheck_base_runner.run_tests ~colors:false [Stats.int_dist_empty_bucket]
diff --git a/test/core/QCheck_expect_test.ml b/test/core/QCheck_expect_test.ml
index 6282d76..b642e6f 100644
--- a/test/core/QCheck_expect_test.ml
+++ b/test/core/QCheck_expect_test.ml
@@ -67,6 +67,10 @@ module Overall = struct
          ])
       (fun _ -> true)
 
+  let retries =
+    Test.make ~name:"with shrinking retries" ~retries:10
+      small_nat (fun i -> Printf.printf "%i %!" i; i mod 3 <> 1)
+
   let bad_assume_warn =
     Test.make ~name:"WARN_unlikely_precond" ~count:2_000
       int
@@ -81,6 +85,17 @@ module Overall = struct
       (fun x ->
          QCheck.assume (x mod 100 = 1);
          true)
+
+  let tests = [
+    passing;
+    failing;
+    error;
+    collect;
+    stats;
+    retries;
+    bad_assume_warn;
+    bad_assume_fail;
+  ]
 end
 
 (* positive tests of the various generators
@@ -212,6 +227,85 @@ module Generator = struct
          Array.length arr = m
          && Array.for_all (fun k -> 0 < k) arr
          && Array.fold_left (+) 0 arr = n)
+
+  let test_tup2 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1): x = (0, 1)"
+      (tup2 (always 0) (always 1))
+      (fun x -> x = (0, 1))
+
+  let test_tup3 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2): x = (0, 1, 2)"
+      (tup3 (always 0) (always 1) (always 2))
+      (fun x -> x = (0, 1, 2))
+
+  let test_tup4 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3): x = (0, 1, 2, 3)"
+      (tup4 (always 0) (always 1) (always 2) (always 3))
+      (fun x -> x = (0, 1, 2, 3))
+
+  let test_tup5 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4): x = (0, 1, 2, 3, 4)"
+      (tup5 (always 0) (always 1) (always 2) (always 3) (always 4))
+      (fun x -> x = (0, 1, 2, 3, 4))
+
+  let test_tup6 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4, 5): x = (0, 1, 2, 3, 4, 5)"
+      (tup6 (always 0) (always 1) (always 2) (always 3) (always 4) (always 5))
+      (fun x -> x = (0, 1, 2, 3, 4, 5))
+
+  let test_tup7 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4, 5, 6): x = (0, 1, 2, 3, 4, 5, 6)"
+      (tup7
+         (always 0) (always 1) (always 2) (always 3) (always 4)
+         (always 5) (always 6))
+      (fun x -> x = (0, 1, 2, 3, 4, 5, 6))
+
+  let test_tup8 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4, 5, 6, 7): x = (0, 1, 2, 3, 4, 5, 6, 7)"
+      (tup8
+         (always 0) (always 1) (always 2) (always 3) (always 4)
+         (always 5) (always 6) (always 7))
+      (fun x -> x = (0, 1, 2, 3, 4, 5, 6, 7))
+
+  let test_tup9 =
+    Test.make ~count:10
+      ~name:"forall x in (0, 1, 2, 3, 4, 5, 6, 7, 8): x = (0, 1, 2, 3, 4, 5, 6, 7, 8)"
+      (tup9
+         (always 0) (always 1) (always 2) (always 3) (always 4)
+         (always 5) (always 6) (always 7) (always 8))
+      (fun x -> x = (0, 1, 2, 3, 4, 5, 6, 7, 8))
+
+  let tests = [
+    char_dist_issue_23;
+    char_test;
+    nat_test;
+    string_test;
+    list_test;
+    list_repeat_test;
+    array_repeat_test;
+    passing_tree_rev;
+    nat_split2_spec;
+    pos_split2_spec;
+    range_subset_spec;
+    nat_split_n_way;
+    nat_split_smaller;
+    pos_split;
+    test_tup2;
+    test_tup3;
+    test_tup4;
+    test_tup5;
+    test_tup6;
+    test_tup7;
+    test_tup8;
+    test_tup9;
+  ]
 end
 
 (* negative tests that exercise shrinking behaviour *)
@@ -311,6 +405,82 @@ module Shrink = struct
       (list small_int)
       (fun xs -> let ys = List.sort_uniq Int.compare xs in
                  print_list xs; List.length xs = List.length ys)
+
+  let test_tup2 =
+    Test.make
+      ~name:"forall (a, b) in nat: a < b"
+      (tup2 small_int small_int)
+      (fun (a, b) -> a < b)
+
+  let test_tup3 =
+    Test.make
+      ~name:"forall (a, b, c) in nat: a < b < c"
+      (tup3 small_int small_int small_int)
+      (fun (a, b, c) -> a < b && b < c)
+
+  let test_tup4 =
+    Test.make
+      ~name:"forall (a, b, c, d) in nat: a < b < c < d"
+      (tup4 small_int small_int small_int small_int)
+      (fun (a, b, c, d) -> a < b && b < c && c < d)
+
+  let test_tup5 =
+    Test.make
+      ~name:"forall (a, b, c, d, e) in nat: a < b < c < d < e"
+      (tup5 small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e) -> a < b && b < c && c < d && d < e)
+
+  let test_tup6 =
+    Test.make
+      ~name:"forall (a, b, c, d, e, f) in nat: a < b < c < d < e < f"
+      (tup6 small_int small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e, f) -> a < b && b < c && c < d && d < e && e < f)
+
+  let test_tup7 =
+    Test.make
+      ~name:"forall (a, b, c, d, e, f, g) in nat: a < b < c < d < e < f < g"
+      (tup7 small_int small_int small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e, f, g) -> a < b && b < c && c < d && d < e && e < f && f < g)
+
+  let test_tup8 =
+    Test.make
+      ~name:"forall (a, b, c, d, e, f, g, h) in nat: a < b < c < d < e < f < g < h"
+      (tup8 small_int small_int small_int small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e, f, g, h) -> a < b && b < c && c < d && d < e && e < f && f < g && g < h)
+
+  let test_tup9 =
+    Test.make
+      ~name:"forall (a, b, c, d, e, f, g, h, i) in nat: a < b < c < d < e < f < g < h < i"
+      (tup9 small_int small_int small_int small_int small_int small_int small_int small_int small_int)
+      (fun (a, b, c, d, e, f, g, h, i) -> a < b && b < c && c < d && d < e && e < f && f < g && g < h && h < i)
+
+  let tests = [
+    (*test_fac_issue59;*)
+    big_bound_issue59;
+    long_shrink;
+    ints_arent_0_mod_3;
+    ints_are_0;
+    ints_smaller_209609;
+    nats_smaller_5001;
+    char_is_never_abcdef;
+    strings_are_empty;
+    string_never_has_000_char;
+    string_never_has_255_char;
+    lists_are_empty_issue_64;
+    list_shorter_10;
+    list_shorter_432;
+    list_shorter_4332;
+    list_equal_dupl;
+    list_unique_elems;
+    test_tup2;
+    test_tup3;
+    test_tup4;
+    test_tup5;
+    test_tup6;
+    test_tup7;
+    test_tup8;
+    test_tup9;
+  ]
 end
 
 (* tests function generator and shrinker *)
@@ -384,6 +554,15 @@ module Function = struct
          let f = Fn.apply f in
          List.fold_left f acc (is @ js)
          = List.fold_left f (List.fold_left f acc is) is) (*Typo*)
+
+  let tests = [
+    fail_pred_map_commute;
+    fail_pred_strings;
+    prop_foldleft_foldright;
+    prop_foldleft_foldright_uncurry;
+    prop_foldleft_foldright_uncurry_funlast;
+    fold_left_test;
+  ]
 end
 
 (* tests of (inner) find_example(_gen) behaviour *)
@@ -407,6 +586,12 @@ module FindExample = struct
   let find_ex_uncaught_issue_99_2_succeed =
     Test.make ~name:"should_succeed_#99_2" ~count:10
       int (fun i -> i <= max_int)
+
+  let tests = [
+    find_ex;
+    find_ex_uncaught_issue_99_1_fail;
+    find_ex_uncaught_issue_99_2_succeed;
+  ]
 end
 
 (* tests of statistics and histogram display *)
@@ -475,68 +660,31 @@ module Stats = struct
     Test.make ~name:"range_subset_spec" ~count:5_000
       (add_stat ("dist", fun a -> a.(0)) (make (Gen.range_subset ~size:1 0 20)))
       (fun a -> Array.length a = 1)
+
+  let tests =
+    [
+      bool_dist;
+      char_dist;
+      tree_depth_test;
+      range_subset_test
+    ]
+    @ string_len_tests
+    @ list_len_tests
+    @ array_len_tests
+    @ int_dist_tests
 end
 
 (* Calling runners *)
 
 let () = QCheck_base_runner.set_seed 1234
 let _ =
-  QCheck_base_runner.run_tests ~colors:false ([
-    Overall.passing;
-    Overall.failing;
-    Overall.error;
-    Overall.collect;
-    Overall.stats;
-    Overall.bad_assume_warn;
-    Overall.bad_assume_fail;
-    Generator.char_dist_issue_23;
-    Generator.char_test;
-    Generator.nat_test;
-    Generator.string_test;
-    Generator.list_test;
-    Generator.list_repeat_test;
-    Generator.array_repeat_test;
-    Generator.passing_tree_rev;
-    Generator.nat_split2_spec;
-    Generator.pos_split2_spec;
-    Generator.range_subset_spec;
-    Generator.nat_split_n_way;
-    Generator.nat_split_smaller;
-    Generator.pos_split;
-    (*Shrink.test_fac_issue59;*)
-    Shrink.big_bound_issue59;
-    Shrink.long_shrink;
-    Shrink.ints_arent_0_mod_3;
-    Shrink.ints_are_0;
-    Shrink.ints_smaller_209609;
-    Shrink.nats_smaller_5001;
-    Shrink.char_is_never_abcdef;
-    Shrink.strings_are_empty;
-    Shrink.string_never_has_000_char;
-    Shrink.string_never_has_255_char;
-    Shrink.lists_are_empty_issue_64;
-    Shrink.list_shorter_10;
-    Shrink.list_shorter_432;
-    Shrink.list_shorter_4332;
-    Shrink.list_equal_dupl;
-    Shrink.list_unique_elems;
-    Function.fail_pred_map_commute;
-    Function.fail_pred_strings;
-    Function.prop_foldleft_foldright;
-    Function.prop_foldleft_foldright_uncurry;
-    Function.prop_foldleft_foldright_uncurry_funlast;
-    Function.fold_left_test;
-    FindExample.find_ex;
-    FindExample.find_ex_uncaught_issue_99_1_fail;
-    FindExample.find_ex_uncaught_issue_99_2_succeed;
-    Stats.bool_dist;
-    Stats.char_dist;
-    Stats.tree_depth_test;
-    Stats.range_subset_test]
-    @ Stats.string_len_tests
-    @ Stats.list_len_tests
-    @ Stats.array_len_tests
-    @ Stats.int_dist_tests)
+  QCheck_base_runner.run_tests ~colors:false (
+    Overall.tests @
+    Generator.tests @
+    Shrink.tests @
+    Function.tests @
+    FindExample.tests @
+    Stats.tests)
 
 let () = QCheck_base_runner.set_seed 153870556
 let _  = QCheck_base_runner.run_tests ~colors:false [Stats.int_dist_empty_bucket]
diff --git a/test/core/qcheck2_output.txt.expected b/test/core/qcheck2_output.txt.expected
index 7c04fa8..efe05ed 100644
--- a/test/core/qcheck2_output.txt.expected
+++ b/test/core/qcheck2_output.txt.expected
@@ -1,5 +1,5 @@
 random seed: 1234
-2724675603984413065
+50 7 0 0 0 0 0 0 0 0 0 0 3 3 3 3 3 3 3 3 3 3 5 5 5 5 5 5 5 5 5 5 6 6 6 6 6 6 6 6 6 6 2724675603984413065
 0
 1362337801992206532
 0
@@ -221,6 +221,12 @@ stats num:
   110..115: #######################################################           9
   116..121: ##################                                                3
 
+--- Failure --------------------------------------------------------------------
+
+Test with shrinking retries failed (0 shrink steps):
+
+7
+
 !!! Warning !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 Warning for test WARN_unlikely_precond:
@@ -348,6 +354,54 @@ Leaf 0
 
 --- Failure --------------------------------------------------------------------
 
+Test forall (a, b) in nat: a < b failed (6 shrink steps):
+
+(0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c) in nat: a < b < c failed (3 shrink steps):
+
+(0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d) in nat: a < b < c < d failed (4 shrink steps):
+
+(0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e) in nat: a < b < c < d < e failed (5 shrink steps):
+
+(0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e, f) in nat: a < b < c < d < e < f failed (6 shrink steps):
+
+(0, 0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e, f, g) in nat: a < b < c < d < e < f < g failed (7 shrink steps):
+
+(0, 0, 0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e, f, g, h) in nat: a < b < c < d < e < f < g < h failed (8 shrink steps):
+
+(0, 0, 0, 0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e, f, g, h, i) in nat: a < b < c < d < e < f < g < h < i failed (9 shrink steps):
+
+(0, 0, 0, 0, 0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
 Test fail_pred_map_commute failed (16 shrink steps):
 
 ([2], {_ -> 0}, {1 -> false; 2 -> true; _ -> false})
@@ -934,7 +988,7 @@ stats dist:
    4150517416584649600.. 4611686018427387903: #################                                               189
 ================================================================================
 1 warning(s)
-failure (27 tests failed, 1 tests errored, ran 67 tests)
+failure (36 tests failed, 1 tests errored, ran 84 tests)
 random seed: 153870556
 
 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
diff --git a/test/core/qcheck_output.txt.expected b/test/core/qcheck_output.txt.expected
index 4d55d63..880df25 100644
--- a/test/core/qcheck_output.txt.expected
+++ b/test/core/qcheck_output.txt.expected
@@ -1,5 +1,5 @@
 random seed: 1234
-2724675603984413065
+50 7 4 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 2724675603984413065
 1362337801992206533
 681168900996103267
 340584450498051634
@@ -156,6 +156,12 @@ stats num:
   110..115: #######################################################           9
   116..121: ##################                                                3
 
+--- Failure --------------------------------------------------------------------
+
+Test with shrinking retries failed (1 shrink steps):
+
+4
+
 !!! Warning !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 Warning for test WARN_unlikely_precond:
@@ -277,6 +283,54 @@ Test lists have unique elems failed (7 shrink steps):
 
 --- Failure --------------------------------------------------------------------
 
+Test forall (a, b) in nat: a < b failed (13 shrink steps):
+
+(0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c) in nat: a < b < c failed (15 shrink steps):
+
+(0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d) in nat: a < b < c < d failed (23 shrink steps):
+
+(0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e) in nat: a < b < c < d < e failed (28 shrink steps):
+
+(0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e, f) in nat: a < b < c < d < e < f failed (30 shrink steps):
+
+(0, 0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e, f, g) in nat: a < b < c < d < e < f < g failed (31 shrink steps):
+
+(0, 0, 0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e, f, g, h) in nat: a < b < c < d < e < f < g < h failed (35 shrink steps):
+
+(0, 0, 0, 0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
+Test forall (a, b, c, d, e, f, g, h, i) in nat: a < b < c < d < e < f < g < h < i failed (42 shrink steps):
+
+(0, 0, 0, 0, 0, 0, 0, 0, 0)
+
+--- Failure --------------------------------------------------------------------
+
 Test fail_pred_map_commute failed (127 shrink steps):
 
 ([3], {_ -> 0}, {3 -> false; _ -> true})
@@ -889,7 +943,7 @@ stats dist:
    4150517416584649600.. 4611686018427387903: #################                                               189
 ================================================================================
 1 warning(s)
-failure (26 tests failed, 1 tests errored, ran 73 tests)
+failure (35 tests failed, 1 tests errored, ran 90 tests)
 random seed: 153870556
 
 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
diff --git a/test/ppx_deriving_qcheck/deriver/dune b/test/ppx_deriving_qcheck/deriver/dune
new file mode 100644
index 0000000..a154c75
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/dune
@@ -0,0 +1,11 @@
+(tests
+ (names
+   test_textual
+   test_primitives
+   test_qualified_names
+   test_recursive
+   test_tuple
+   test_variants
+   test_record)
+ (libraries qcheck-alcotest ppxlib ppx_deriving_qcheck qcheck)
+ (preprocess (pps ppxlib.metaquot ppx_deriving_qcheck)))
diff --git a/test/ppx_deriving_qcheck/deriver/helpers.ml b/test/ppx_deriving_qcheck/deriver/helpers.ml
new file mode 100644
index 0000000..2f93c02
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/helpers.ml
@@ -0,0 +1,15 @@
+open QCheck
+
+(** {1. Helpers} *)
+
+let seed = [| 42 |]
+
+let generate gen = Gen.generate ~n:20 ~rand:(Random.State.make seed) gen
+
+(** [test_compare msg eq gen_ref gen_cand] will generate with the same seed
+    [gen_ref] and [gen_cand], and test with Alcotest that both generators
+    generates the same values. *)
+let test_compare ~msg ~eq gen_ref gen_candidate =
+  let expected = generate gen_ref in
+  let actual = generate gen_candidate in
+  Alcotest.(check (list eq)) msg expected actual
diff --git a/test/ppx_deriving_qcheck/deriver/test_primitives.ml b/test/ppx_deriving_qcheck/deriver/test_primitives.ml
new file mode 100644
index 0000000..00162ef
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/test_primitives.ml
@@ -0,0 +1,89 @@
+open QCheck
+open Helpers
+
+(** {1. Test primitives derivation} *)
+
+(** {2. Tests} *)
+
+type int' = int [@@deriving qcheck]
+
+let test_int () =
+  test_compare ~msg:"Gen.int <=> deriving int" ~eq:Alcotest.int Gen.int gen_int'
+
+type unit' = unit [@@deriving qcheck]
+
+(* Pretty useless though, but, meh *)
+let test_unit () =
+  test_compare ~msg:"Gen.unit <=> deriving unit" ~eq:Alcotest.unit Gen.unit gen_unit'
+
+type string' = string [@@deriving qcheck]
+
+let test_string () =
+  test_compare ~msg:"Gen.string <=> deriving string" ~eq:Alcotest.string Gen.string gen_string'
+
+type char' = char [@@deriving qcheck]
+
+let test_char () =
+  test_compare ~msg:"Gen.char <=> deriving char" ~eq:Alcotest.char Gen.char gen_char'
+
+type bool' = bool [@@deriving qcheck]
+
+let test_bool () =
+  test_compare ~msg:"Gen.bool <=> deriving bool" ~eq:Alcotest.bool Gen.bool gen_bool'
+
+type float' = float [@@deriving qcheck]
+
+let test_float () =
+  test_compare ~msg:"Gen.float <=> deriving float" ~eq:(Alcotest.float 0.) Gen.float gen_float'
+
+type int32' = int32 [@@deriving qcheck]
+
+let test_int32 () =
+  test_compare ~msg:"Gen.int32 <=> deriving int32" ~eq:Alcotest.int32 Gen.ui32 gen_int32'
+
+type int64' = int64 [@@deriving qcheck]
+
+let test_int64 () =
+  test_compare ~msg:"Gen.int64 <=> deriving int64" ~eq:Alcotest.int64 Gen.ui64 gen_int64'
+
+type 'a option' = 'a option [@@deriving qcheck]
+
+let test_option () =
+  let zero = Gen.pure 0 in
+  test_compare ~msg:"Gen.opt <=> deriving opt"
+    ~eq:Alcotest.(option int)
+    (Gen.opt zero) (gen_option' zero)
+
+type 'a array' = 'a array [@@deriving qcheck]
+
+let test_array () =
+  let zero = Gen.pure 0 in
+  test_compare ~msg:"Gen.array <=> deriving array"
+    ~eq:Alcotest.(array int)
+    (Gen.array zero) (gen_array' zero)
+
+type 'a list' = 'a list [@@deriving qcheck]
+
+let test_list () =
+  let zero = Gen.pure 0 in
+  test_compare ~msg:"Gen.list <=> deriving list"
+    ~eq:Alcotest.(list int)
+    (Gen.list zero) (gen_list' zero)
+
+(** {2. Execute tests} *)
+
+let () = Alcotest.run "Test_Primitives"
+           [("Primitives",
+             Alcotest.[
+                 test_case "test_int" `Quick test_int;
+                 test_case "test_unit" `Quick test_unit;
+                 test_case "test_string" `Quick test_string;
+                 test_case "test_char" `Quick test_char;
+                 test_case "test_bool" `Quick test_bool;
+                 test_case "test_float" `Quick test_float;
+                 test_case "test_int32" `Quick test_int32;
+                 test_case "test_int64" `Quick test_int64;
+                 test_case "test_option" `Quick test_option;
+                 test_case "test_array" `Quick test_array;
+                 test_case "test_list" `Quick test_list;
+           ])]
diff --git a/test/ppx_deriving_qcheck/deriver/test_qualified_names.ml b/test/ppx_deriving_qcheck/deriver/test_qualified_names.ml
new file mode 100644
index 0000000..623bc08
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/test_qualified_names.ml
@@ -0,0 +1,37 @@
+open QCheck
+open Helpers
+
+module type S = sig
+  type t = int
+
+  val gen : int QCheck.Gen.t
+end
+
+module Q : S = struct
+  type t = int [@@deriving qcheck]
+end
+
+module F (X : S) = struct
+  type t = X.t [@@deriving qcheck]
+end
+
+module G = F (Q)
+
+type t = Q.t [@@deriving qcheck]
+
+type u = G.t [@@deriving qcheck]
+
+let test_module () =
+  test_compare ~msg:"Gen.int <=> deriving Q.t" ~eq:Alcotest.int Gen.int gen
+
+let test_functor () =
+  test_compare ~msg:"Gen.int <=> deriving F.t" ~eq:Alcotest.int Gen.int gen_u
+
+(** {2. Execute tests} *)
+
+let () = Alcotest.run "Test_Qualified_names"
+           [("Qualified names",
+             Alcotest.[
+                 test_case "test_module" `Quick test_module;
+                 test_case "test_functor" `Quick test_functor
+           ])]
diff --git a/test/ppx_deriving_qcheck/deriver/test_record.ml b/test/ppx_deriving_qcheck/deriver/test_record.ml
new file mode 100644
index 0000000..77b3acd
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/test_record.ml
@@ -0,0 +1,65 @@
+open QCheck
+open Helpers
+
+type env = {
+    rec_types : string list;
+    curr_types : string list;
+    curr_type : string
+  }
+[@@deriving qcheck]
+
+let pp_env fmt {rec_types; curr_types; curr_type} =
+  let open Format in
+  fprintf fmt {|{
+  rec_types = [%a];
+  curr_types = [%a];
+  curr_type = [%s];
+}|}
+    (pp_print_list pp_print_string) rec_types
+    (pp_print_list pp_print_string) curr_types
+    curr_type
+
+let eq_env = Alcotest.of_pp pp_env
+
+let gen_env_ref =
+  let open Gen in
+  map3 (fun rec_types curr_types curr_type ->
+      { rec_types; curr_types; curr_type })
+    (list string) (list string) string
+
+let test_env () =
+  test_compare ~msg:"gen_env ref <=> deriving env"
+  ~eq:eq_env gen_env_ref gen_env
+
+type color = Color of { red : float; green : float; blue : float }
+[@@deriving qcheck]
+
+let pp_color fmt (Color {red; green; blue}) =
+  let open Format in
+  fprintf fmt {|Color {
+  red = %a;
+  green = %a;
+  blue = %a;
+}|}
+    pp_print_float red
+    pp_print_float green
+    pp_print_float blue
+
+let eq_color = Alcotest.of_pp pp_color
+
+let gen_color_ref =
+  let open Gen in
+  map3 (fun red green blue -> Color {red; green; blue}) float float float
+
+let test_color () =
+  test_compare ~msg:"gen_color ref <=> deriving color"
+  ~eq:eq_color gen_color_ref gen_color
+
+(** {2. Execute tests} *)
+
+let () = Alcotest.run "Test_Record"
+           [("Record",
+             Alcotest.[
+                 test_case "test_env" `Quick test_env;
+                 test_case "test_color" `Quick test_color;
+           ])]
diff --git a/test/ppx_deriving_qcheck/deriver/test_recursive.ml b/test/ppx_deriving_qcheck/deriver/test_recursive.ml
new file mode 100644
index 0000000..af3c759
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/test_recursive.ml
@@ -0,0 +1,80 @@
+open QCheck
+open Helpers
+
+type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree
+[@@deriving qcheck]
+
+let rec pp_tree pp fmt x =
+  let open Format in
+  match x with
+  | Leaf ->
+     fprintf fmt "Leaf"
+  | Node (x, l, r) ->
+     fprintf fmt "Node (%a, %a, %a)"
+       pp x
+       (pp_tree pp) l
+       (pp_tree pp) r
+
+let eq_tree pp = Alcotest.of_pp (pp_tree pp)
+
+let gen_tree_ref gen =
+  let open Gen in
+  sized @@ fix (fun self ->
+             function
+             | 0 -> pure Leaf
+             | n ->
+                oneof [
+                    pure Leaf;
+                    map3 (fun x l r -> Node (x,l,r)) gen (self (n/2)) (self (n/2));
+             ])
+
+let gen_tree_candidate = gen_tree
+
+let test_tree_ref () =
+  let gen = Gen.int in
+  test_compare ~msg:"gen tree <=> derivation tree"
+    ~eq:(eq_tree Format.pp_print_int)
+    (gen_tree_ref gen) (gen_tree gen)
+
+let test_leaf =
+  Test.make
+    ~name:"gen_tree_sized 0 = Node (_, Leaf, Leaf)"
+    (make (gen_tree_sized Gen.int 0))
+    (function
+     | Leaf -> true
+     | Node (_, Leaf, Leaf) -> true
+     | _ -> false)
+  |>
+    QCheck_alcotest.to_alcotest
+
+(* A slight error has been found here:
+   If the type is named `list` then `'a list` will be derived with the
+   QCheck generator `list` instead of the `gen_list_sized`.
+
+   This could lead to a design choice:
+   - do we allow overriding primitive types?
+   - do we prioritize `Env.curr_types` over primitive types?
+*)
+type 'a my_list = Cons of 'a * 'a my_list | Nil
+[@@deriving qcheck]
+
+let rec length = function
+  | Nil -> 0
+  | Cons (_, xs) -> 1 + length xs
+
+let test_length =
+  Test.make
+    ~name:"gen_list_sized n >>= fun l -> length l <= n"
+    small_int
+    (fun n ->
+      let l = Gen.(generate1 (gen_my_list_sized Gen.int n)) in
+      length l <= n)
+  |>
+    QCheck_alcotest.to_alcotest
+
+let () = Alcotest.run "Test_Recursive"
+           [("Recursive",
+             Alcotest.[
+                 test_case "test_tree_ref" `Quick test_tree_ref;
+                 test_leaf
+             ])]
diff --git a/test/ppx_deriving_qcheck/deriver/test_textual.ml b/test/ppx_deriving_qcheck/deriver/test_textual.ml
new file mode 100644
index 0000000..6886502
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/test_textual.ml
@@ -0,0 +1,818 @@
+(** Module test for ppx_deriving_qcheck *)
+open Ppxlib
+
+(** Primitive types tests *)
+let loc = Location.none
+
+let f = Ppx_deriving_qcheck.derive_gen ~loc
+
+let f' xs = List.map f xs |> List.concat
+
+let extract stri =
+  match stri.pstr_desc with Pstr_type (x, y) -> (x, y) | _ -> assert false
+
+let extract' xs = List.map extract xs
+
+let check_eq ~expected ~actual name =
+  let f = Ppxlib.Pprintast.string_of_structure in
+  Alcotest.(check string) name (f expected) (f actual)
+
+let test_int () =
+  let expected = [ [%stri let gen = QCheck.Gen.int] ] in
+
+  let actual = f @@ extract [%stri type t = int] in
+
+  check_eq ~expected ~actual "deriving int"
+
+let test_float () =
+  let expected = [ [%stri let gen = QCheck.Gen.float] ] in
+  let actual = f @@ extract [%stri type t = float] in
+
+  check_eq ~expected ~actual "deriving float"
+
+let test_char () =
+  let expected = [ [%stri let gen = QCheck.Gen.char] ] in
+  let actual = f @@ extract [%stri type t = char] in
+
+  check_eq ~expected ~actual "deriving char"
+
+let test_string () =
+  let expected = [ [%stri let gen = QCheck.Gen.string] ] in
+  let actual = f @@ extract [%stri type t = string] in
+
+  check_eq ~expected ~actual "deriving string"
+
+let test_unit () =
+  let expected = [ [%stri let gen = QCheck.Gen.unit] ] in
+  let actual = f @@ extract [%stri type t = unit] in
+
+  check_eq ~expected ~actual "deriving unit"
+
+let test_bool () =
+  let expected = [ [%stri let gen = QCheck.Gen.bool] ] in
+  let actual = f @@ extract [%stri type t = bool] in
+
+  check_eq ~expected ~actual "deriving bool"
+
+let test_int32 () =
+  let expected = [ [%stri let gen = QCheck.Gen.ui32] ] in
+  let actual = f @@ extract [%stri type t = int32] in
+
+  check_eq ~expected ~actual "deriving int32"
+
+let test_int32' () =
+  let expected = [ [%stri let gen = QCheck.Gen.ui32] ] in
+  let actual = f @@ extract [%stri type t = Int32.t] in
+
+  check_eq ~expected ~actual "deriving int32'"
+
+let test_int64 () =
+  let expected = [ [%stri let gen = QCheck.Gen.ui64] ] in
+  let actual = f @@ extract [%stri type t = int64] in
+
+  check_eq ~expected ~actual "deriving int64"
+
+let test_int64' () =
+  let expected = [ [%stri let gen = QCheck.Gen.ui64] ] in
+  let actual = f @@ extract [%stri type t = Int64.t] in
+
+  check_eq ~expected ~actual "deriving int64'"
+
+(* let test_bytes () =
+ *   let expected =
+ *     [
+ *       [%stri
+ *         let gen =
+ *           QCheck.map
+ *             (fun n -> Bytes.create n)
+ *             QCheck.(0 -- Sys.max_string_length)];
+ *     ]
+ *   in
+ *   let actual = f @@ extract [%stri type t = Bytes.t ] in
+ * 
+ *   check_eq ~expected ~actual "deriving int64" *)
+
+let test_tuple () =
+  let actual =
+    f'
+    @@ extract'
+         [
+           [%stri type t = int * int];
+           [%stri type t = int * int * int];
+           [%stri type t = int * int * int * int];
+           [%stri type t = int * int * int * int * int];
+           [%stri type t = int * int * int * int * int * int];
+         ]
+  in
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.Gen.map
+            (fun (gen0, gen1) -> (gen0, gen1))
+            (QCheck.Gen.pair QCheck.Gen.int QCheck.Gen.int)];
+      [%stri
+        let gen =
+          QCheck.Gen.map
+            (fun (gen0, gen1, gen2) -> (gen0, gen1, gen2))
+            (QCheck.Gen.triple QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int)];
+      [%stri
+        let gen =
+          QCheck.Gen.map
+            (fun (gen0, gen1, gen2, gen3) -> (gen0, gen1, gen2, gen3))
+            (QCheck.Gen.quad
+               QCheck.Gen.int
+               QCheck.Gen.int
+               QCheck.Gen.int
+               QCheck.Gen.int)];
+      [%stri
+        let gen =
+          QCheck.Gen.map
+            (fun ((gen0, gen1), (gen2, gen3, gen4)) ->
+              (gen0, gen1, gen2, gen3, gen4))
+            (QCheck.Gen.pair
+               (QCheck.Gen.pair QCheck.Gen.int QCheck.Gen.int)
+               (QCheck.Gen.triple QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int))];
+      [%stri
+        let gen =
+          QCheck.Gen.map
+            (fun ((gen0, gen1, gen2), (gen3, gen4, gen5)) ->
+              (gen0, gen1, gen2, gen3, gen4, gen5))
+            (QCheck.Gen.pair
+               (QCheck.Gen.triple QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int)
+               (QCheck.Gen.triple QCheck.Gen.int QCheck.Gen.int QCheck.Gen.int))];
+    ]
+  in
+
+  check_eq ~expected ~actual "deriving tuples"
+
+let test_option () =
+  let expected = [ [%stri let gen = QCheck.Gen.opt QCheck.Gen.int] ] in
+  let actual = f' @@ extract' [ [%stri type t = int option] ] in
+  check_eq ~expected ~actual "deriving option"
+
+let test_array () =
+  let expected = [ [%stri let gen = QCheck.Gen.array QCheck.Gen.int] ] in
+  let actual = f' @@ extract' [ [%stri type t = int array] ] in
+  check_eq ~expected ~actual "deriving option"
+
+let test_list () =
+  let expected = [ [%stri let gen = QCheck.Gen.list QCheck.Gen.string] ] in
+
+  let actual = f' @@ extract' [ [%stri type t = string list] ] in
+  check_eq ~expected ~actual "deriving list"
+
+let test_alpha () =
+  let expected =
+    [
+      [%stri let gen gen_a = gen_a];
+      [%stri let gen gen_a = QCheck.Gen.list gen_a];
+      [%stri let gen gen_a = QCheck.Gen.map (fun gen0 -> A gen0) gen_a];
+      [%stri
+        let gen gen_a gen_b =
+          QCheck.Gen.map
+            (fun (gen0, gen1) -> A (gen0, gen1))
+            (QCheck.Gen.pair gen_a gen_b)];
+      [%stri
+        let gen gen_left gen_right =
+          QCheck.Gen.map
+            (fun (gen0, gen1) -> (gen0, gen1))
+            (QCheck.Gen.pair gen_left gen_right)];
+      [%stri
+       let gen_int_tree = gen_tree QCheck.Gen.int
+      ]
+    ]
+  in
+  let actual =
+    f'
+    @@ extract'
+         [
+           [%stri type 'a t = 'a];
+           [%stri type 'a t = 'a list];
+           [%stri type 'a t = A of 'a];
+           [%stri type ('a, 'b) t = A of 'a * 'b];
+           [%stri type ('left, 'right) t = 'left * 'right];
+           [%stri type int_tree = int tree]
+         ]
+  in
+  check_eq ~expected ~actual "deriving alpha"
+
+let test_equal () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.Gen.frequency
+            [
+              (1, QCheck.Gen.pure A);
+              (1, QCheck.Gen.pure B);
+              (1, QCheck.Gen.pure C);
+            ]];
+      [%stri
+        let gen_t' =
+          QCheck.Gen.frequency
+            [
+              (1, QCheck.Gen.pure A);
+              (1, QCheck.Gen.pure B);
+              (1, QCheck.Gen.pure C);
+            ]];
+    ]
+  in
+  let actual =
+    f'
+    @@ extract'
+         [ [%stri type t = A | B | C]; [%stri type t' = t = A | B | C] ]
+  in
+  check_eq ~expected ~actual "deriving equal"
+
+let test_dependencies () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.Gen.frequency
+            [
+              (1, QCheck.Gen.map (fun gen0 -> Int gen0) SomeModule.gen);
+              ( 1,
+                QCheck.Gen.map
+                  (fun gen0 -> Float gen0)
+                  SomeModule.SomeOtherModule.gen );
+            ]];
+      [%stri let gen = gen_something];
+    ]
+  in
+  let actual =
+    f'
+    @@ extract'
+         [
+           [%stri
+             type t =
+               | Int of SomeModule.t
+               | Float of SomeModule.SomeOtherModule.t];
+           [%stri type t = (Something.t[@gen gen_something])];
+         ]
+  in
+
+  check_eq ~expected ~actual "deriving dependencies"
+
+let test_konstr () =
+  let expected =
+    [
+      [%stri let gen = QCheck.Gen.map (fun gen0 -> A gen0) QCheck.Gen.int];
+      [%stri
+        let gen =
+          QCheck.Gen.frequency
+            [
+              (1, QCheck.Gen.map (fun gen0 -> B gen0) QCheck.Gen.int);
+              (1, QCheck.Gen.map (fun gen0 -> C gen0) QCheck.Gen.int);
+            ]];
+      [%stri
+        let gen =
+          QCheck.Gen.frequency
+            [
+              (1, QCheck.Gen.map (fun gen0 -> X gen0) gen_t1);
+              (1, QCheck.Gen.map (fun gen0 -> Y gen0) gen_t2);
+              (1, QCheck.Gen.map (fun gen0 -> Z gen0) QCheck.Gen.string);
+            ]];
+      [%stri
+        let gen =
+          QCheck.Gen.frequency
+            [ (1, QCheck.Gen.pure Left); (1, QCheck.Gen.pure Right) ]];
+      [%stri
+        let gen =
+          QCheck.Gen.frequency
+            [
+              (1, QCheck.Gen.map (fun gen0 -> Simple gen0) QCheck.Gen.int);
+              ( 1,
+                QCheck.Gen.map
+                  (fun (gen0, gen1) -> Double (gen0, gen1))
+                  (QCheck.Gen.pair QCheck.Gen.int QCheck.Gen.int) );
+              ( 1,
+                QCheck.Gen.map
+                  (fun (gen0, gen1, gen2) -> Triple (gen0, gen1, gen2))
+                  (QCheck.Gen.triple
+                     QCheck.Gen.int
+                     QCheck.Gen.int
+                     QCheck.Gen.int) );
+            ]];
+    ]
+  in
+  let actual =
+    f'
+    @@ extract'
+         [
+           [%stri type t = A of int];
+           [%stri type t = B of int | C of int];
+           [%stri type t = X of t1 | Y of t2 | Z of string];
+           [%stri type t = Left | Right];
+           [%stri
+             type t =
+               | Simple of int
+               | Double of int * int
+               | Triple of int * int * int];
+         ]
+  in
+  check_eq ~expected ~actual "deriving constructors"
+
+let test_record () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.Gen.map
+            (fun (gen0, gen1) -> { a = gen0; b = gen1 })
+            (QCheck.Gen.pair QCheck.Gen.int QCheck.Gen.string)];
+      [%stri
+        let gen =
+          QCheck.Gen.map
+            (fun (gen0, gen1) -> { a = gen0; b = gen1 })
+            (QCheck.Gen.pair QCheck.Gen.int QCheck.Gen.string)];
+      [%stri
+        let gen =
+          QCheck.Gen.frequency
+            [
+              (1, QCheck.Gen.map (fun gen0 -> A gen0) gen_t');
+              ( 1,
+                QCheck.Gen.map
+                  (fun (gen0, gen1) -> B { left = gen0; right = gen1 })
+                  (QCheck.Gen.pair QCheck.Gen.int QCheck.Gen.int) );
+            ]];
+    ]
+  in
+  let actual =
+    f'
+    @@ extract'
+         [
+           [%stri type t = { a : int; b : string }];
+           [%stri type t = { mutable a : int; mutable b : string }];
+           [%stri type t = A of t' | B of { left : int; right : int }];
+         ]
+  in
+  check_eq ~expected ~actual "deriving record"
+
+let test_variant () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          (QCheck.Gen.frequency
+             [
+               (1, QCheck.Gen.pure `A);
+               (1, QCheck.Gen.map (fun gen0 -> `B gen0) QCheck.Gen.int);
+               (1, QCheck.Gen.map (fun gen0 -> `C gen0) QCheck.Gen.string);
+             ]
+            : t QCheck.Gen.t)];
+      [%stri
+        let gen_t' =
+          (QCheck.Gen.frequency [ (1, QCheck.Gen.pure `B); (1, gen) ]
+            : t' QCheck.Gen.t)];
+    ]
+  in
+  let actual =
+    f'
+    @@ extract'
+         [
+           [%stri type t = [ `A | `B of int | `C of string ]];
+           [%stri type t' = [ `B | t ]];
+         ]
+  in
+  check_eq ~expected ~actual "deriving variant"
+
+let test_tree () =
+  let expected =
+    [
+      [%stri
+       let rec gen_tree_sized gen_a n =
+         match n with
+         | 0 -> QCheck.Gen.pure Leaf
+         | _ ->
+            QCheck.Gen.frequency
+              [
+                (1, QCheck.Gen.pure Leaf);
+                ( 1,
+                  QCheck.Gen.map
+                    (fun (gen0, gen1, gen2) -> Node (gen0, gen1, gen2))
+                    (QCheck.Gen.triple
+                       gen_a
+                       ((gen_tree_sized gen_a) (n / 2))
+                       ((gen_tree_sized gen_a) (n / 2))) );
+              ]
+      ];
+      [%stri
+       let gen_tree gen_a = QCheck.Gen.sized @@ (gen_tree_sized gen_a)
+      ];
+    ]
+  in
+  let actual =
+    f
+    @@ extract [%stri type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree];
+  in
+  check_eq ~expected ~actual "deriving tree"
+
+let test_expr () =
+  let expected =
+    [
+      [%stri
+       let rec gen_expr_sized n =
+         match n with
+         | 0 -> QCheck.Gen.map (fun gen0 -> Value gen0) QCheck.Gen.int
+         | _ ->
+            QCheck.Gen.frequency
+              [
+                ( 1,
+                  QCheck.Gen.map (fun gen0 -> Value gen0) QCheck.Gen.int
+                );
+                ( 1,
+                  QCheck.Gen.map
+                    (fun (gen0, gen1, gen2) -> If (gen0, gen1, gen2))
+                    (QCheck.Gen.triple
+                       (gen_expr_sized (n / 2))
+                       (gen_expr_sized (n / 2))
+                       (gen_expr_sized (n / 2))) );
+                ( 1,
+                  QCheck.Gen.map
+                    (fun (gen0, gen1) -> Eq (gen0, gen1))
+                    (QCheck.Gen.pair (gen_expr_sized (n / 2)) (gen_expr_sized (n / 2))) );
+                ( 1,
+                  QCheck.Gen.map
+                    (fun (gen0, gen1) -> Lt (gen0, gen1))
+                    (QCheck.Gen.pair (gen_expr_sized (n / 2)) (gen_expr_sized (n / 2))) );
+              ]
+      ];
+      [%stri
+       let gen_expr = QCheck.Gen.sized @@ gen_expr_sized
+      ]
+    ]
+  in
+  let actual =
+    f @@ extract
+           [%stri
+            type expr =
+              | Value of int
+              | If of expr * expr * expr
+              | Eq of expr * expr
+              | Lt of expr * expr]
+  in
+  check_eq ~expected ~actual "deriving expr"
+
+let test_forest () =
+  let expected =
+    [
+      [%stri
+        let rec gen_tree_sized gen_a n =
+          QCheck.Gen.map
+            (fun gen0 -> Node gen0)
+            (QCheck.Gen.map
+               (fun (gen0, gen1) -> (gen0, gen1))
+               (QCheck.Gen.pair gen_a ((gen_forest_sized gen_a) (n / 2))))
+
+        and gen_forest_sized gen_a n =
+          match n with
+          | 0 -> QCheck.Gen.pure Nil
+          | _ ->
+             QCheck.Gen.frequency
+               [
+                 (1, QCheck.Gen.pure Nil);
+                 ( 1,
+                   QCheck.Gen.map
+                     (fun gen0 -> Cons gen0)
+                     (QCheck.Gen.map
+                        (fun (gen0, gen1) -> (gen0, gen1))
+                        (QCheck.Gen.pair
+                           ((gen_tree_sized gen_a) (n / 2))
+                           ((gen_forest_sized gen_a) (n / 2)))) );
+               ]
+      ];
+      [%stri let gen_tree gen_a = QCheck.Gen.sized @@ (gen_tree_sized gen_a)];
+      [%stri let gen_forest gen_a = QCheck.Gen.sized @@ (gen_forest_sized gen_a)];
+    ]
+  in
+  let actual =
+    f
+    @@ extract
+         [%stri
+           type 'a tree = Node of ('a * 'a forest)
+
+           and 'a forest = Nil | Cons of ('a tree * 'a forest)]
+  in
+  check_eq ~expected ~actual "deriving forest"
+
+let test_fun_primitives () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.int @-> QCheck.Observable.int @-> o_nil)
+            (QCheck.make QCheck.Gen.string)
+          |> QCheck.gen];
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.float @-> QCheck.Observable.float @-> o_nil)
+            (QCheck.make QCheck.Gen.string)
+          |> QCheck.gen];
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.string @-> QCheck.Observable.string @-> o_nil)
+            (QCheck.make QCheck.Gen.string)
+          |> QCheck.gen];
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.bool @-> QCheck.Observable.bool @-> o_nil)
+            (QCheck.make QCheck.Gen.string)
+          |> QCheck.gen];
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.char @-> QCheck.Observable.char @-> o_nil)
+            (QCheck.make QCheck.Gen.string)
+          |> QCheck.gen];
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(QCheck.Observable.unit @-> o_nil)
+            (QCheck.make QCheck.Gen.string)
+          |> QCheck.gen];
+    ]
+  in
+
+  let actual =
+    f'
+    @@ extract'
+         [
+           [%stri type t = int -> int -> string];
+           [%stri type t = float -> float -> string];
+           [%stri type t = string -> string -> string];
+           [%stri type t = bool -> bool -> string];
+           [%stri type t = char -> char -> string];
+           [%stri type t = unit -> string];
+         ]
+  in
+  check_eq ~expected ~actual "deriving fun primitives"
+
+let test_fun_n () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.bool @-> QCheck.Observable.int
+              @-> QCheck.Observable.float @-> QCheck.Observable.string
+              @-> QCheck.Observable.char @-> o_nil)
+            (QCheck.make QCheck.Gen.unit)
+          |> QCheck.gen];
+    ]
+  in
+  let actual =
+    f @@ extract [%stri type t = bool -> int -> float -> string -> char -> unit]
+  in
+  check_eq ~expected ~actual "deriving fun n"
+
+let test_fun_option () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.option QCheck.Observable.int @-> o_nil)
+            (QCheck.make QCheck.Gen.unit)
+          |> QCheck.gen];
+    ]
+  in
+  let actual = f @@ extract [%stri type t = int option -> unit] in
+  check_eq ~expected ~actual "deriving fun option"
+
+let test_fun_list () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.list QCheck.Observable.int @-> o_nil)
+            (QCheck.make QCheck.Gen.unit)
+          |> QCheck.gen];
+    ]
+  in
+  let actual = f @@ extract [%stri type t = int list -> unit] in
+  check_eq ~expected ~actual "deriving fun list"
+
+let test_fun_array () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.array QCheck.Observable.int @-> o_nil)
+            (QCheck.make QCheck.Gen.unit)
+          |> QCheck.gen];
+    ]
+  in
+  let actual = f @@ extract [%stri type t = int array -> unit] in
+  check_eq ~expected ~actual "deriving fun array"
+
+let test_fun_tuple () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.pair QCheck.Observable.int QCheck.Observable.int
+              @-> o_nil)
+            (QCheck.make QCheck.Gen.unit)
+          |> QCheck.gen];
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.triple
+                QCheck.Observable.int
+                QCheck.Observable.int
+                QCheck.Observable.int
+              @-> o_nil)
+            (QCheck.make QCheck.Gen.unit)
+          |> QCheck.gen];
+      [%stri
+        let gen =
+          QCheck.fun_nary
+            QCheck.Tuple.(
+              QCheck.Observable.quad
+                QCheck.Observable.int
+                QCheck.Observable.int
+                QCheck.Observable.int
+                QCheck.Observable.int
+              @-> o_nil)
+            (QCheck.make QCheck.Gen.unit)
+          |> QCheck.gen];
+    ]
+  in
+  let actual =
+    f'
+    @@ extract'
+         [
+           [%stri type t = int * int -> unit];
+           [%stri type t = int * int * int -> unit];
+           [%stri type t = int * int * int * int -> unit];
+         ]
+  in
+  check_eq ~expected ~actual "deriving fun tuple"
+
+let test_weight_konstrs () =
+  let expected =
+    [
+      [%stri
+        let gen =
+          QCheck.Gen.frequency
+            [
+              (5, QCheck.Gen.pure A);
+              (6, QCheck.Gen.pure B);
+              (1, QCheck.Gen.pure C);
+            ]];
+    ]
+  in
+  let actual =
+    f @@ extract [%stri type t = A [@weight 5] | B [@weight 6] | C]
+  in
+  check_eq ~expected ~actual "deriving weight konstrs"
+
+(* Regression test: https://github.com/c-cube/qcheck/issues/187 *)
+let test_recursive_poly_variant () =
+  let expected =
+    [
+      [%stri
+       let rec gen_tree_sized gen_a n =
+         (match n with
+         | 0 -> QCheck.Gen.map (fun gen0 -> `Leaf gen0) gen_a
+         | _ ->
+            QCheck.Gen.frequency
+              [
+                ( 1,
+                  QCheck.Gen.map (fun gen0 -> `Leaf gen0) gen_a
+                );
+                ( 1,
+                  QCheck.Gen.map
+                    (fun gen0 -> `Node gen0)
+                    (QCheck.Gen.map
+                       (fun (gen0, gen1) -> (gen0, gen1))
+                       (QCheck.Gen.pair
+                          ((gen_tree_sized gen_a) (n / 2))
+                          ((gen_tree_sized gen_a) (n / 2))))
+                );
+              ]
+            : tree QCheck.Gen.t)];
+      [%stri
+       let gen_tree gen_a = QCheck.Gen.sized @@ (gen_tree_sized gen_a)
+      ]
+    ]
+  in
+  let actual =
+    f @@ extract [%stri type 'a tree = [ `Leaf of 'a | `Node of 'a tree * 'a tree ]]
+  in
+  check_eq ~expected ~actual "deriving recursive polymorphic variants"
+
+(* Regression test: https://github.com/c-cube/qcheck/issues/213 *)
+let test_unused_variable () =
+  let expected =
+    [
+      [%stri
+        let rec gen_c_sized n =
+          match n with
+          | 0 -> QCheck.Gen.pure A
+          | _ ->
+            QCheck.Gen.frequency
+              [(1, (QCheck.Gen.pure A));
+               (1, (QCheck.Gen.map (fun gen0 -> B gen0) gen_myint))]
+        and gen_myint = QCheck.Gen.nat
+     ];
+      [%stri
+       let gen_c = QCheck.Gen.sized @@ gen_c_sized
+      ];
+      [%stri
+        let rec gen_c_sized _n =
+          QCheck.Gen.frequency
+            [(1, (QCheck.Gen.map (fun gen0 -> A gen0) gen_myint));
+             (1, (QCheck.Gen.map (fun gen0 -> B gen0) gen_myint))]
+        and gen_myint = QCheck.Gen.nat
+      ];
+      [%stri
+       let gen_c = QCheck.Gen.sized @@ gen_c_sized
+      ];
+    ]
+  in
+  let actual =
+    f' @@ extract' [
+             [%stri
+              type c =
+                | A
+                | B of myint
+              and myint = int [@gen QCheck.Gen.nat] ];
+             [%stri
+              type c =
+                | A of myint
+                | B of myint
+              and myint = int [@gen QCheck.Gen.nat] ];
+           ]
+  in
+  check_eq ~expected ~actual "deriving variant with unused fuel parameter"
+
+
+let () =
+  Alcotest.(
+    run
+      "ppx_deriving_qcheck tests"
+      [
+        ( "deriving generator good",
+          [
+            test_case "deriving int" `Quick test_int;
+            test_case "deriving float" `Quick test_float;
+            test_case "deriving char" `Quick test_char;
+            test_case "deriving string" `Quick test_string;
+            test_case "deriving unit" `Quick test_unit;
+            test_case "deriving bool" `Quick test_bool;
+            test_case "deriving int32" `Quick test_int32;
+            test_case "deriving int32'" `Quick test_int32';
+            test_case "deriving int64" `Quick test_int64;
+            test_case "deriving int64'" `Quick test_int64';
+            (* test_case "deriving bytes" `Quick test_bytes; *)
+            test_case "deriving tuple" `Quick test_tuple;
+            test_case "deriving option" `Quick test_option;
+            test_case "deriving array" `Quick test_array;
+            test_case "deriving list" `Quick test_list;
+            test_case "deriving constructors" `Quick test_konstr;
+            test_case "deriving dependencies" `Quick test_dependencies;
+            test_case "deriving record" `Quick test_record;
+            test_case "deriving equal" `Quick test_equal;
+            test_case "deriving tree like" `Quick test_tree;
+            test_case "deriving expr like" `Quick test_expr;
+            test_case "deriving alpha" `Quick test_alpha;
+            test_case "deriving variant" `Quick test_variant;
+            test_case "deriving weight constructors" `Quick test_weight_konstrs;
+            test_case "deriving forest" `Quick test_forest;
+            test_case "deriving fun primitives" `Quick test_fun_primitives;
+            test_case "deriving fun option" `Quick test_fun_option;
+            test_case "deriving fun array" `Quick test_fun_array;
+            test_case "deriving fun list" `Quick test_fun_list;
+            test_case "deriving fun n" `Quick test_fun_n;
+            test_case "deriving fun tuple" `Quick test_fun_tuple;
+            test_case
+              "deriving rec poly variants"
+              `Quick
+              test_recursive_poly_variant;
+            test_case
+              "deriving variant with unused fuel parameter"
+              `Quick
+              test_unused_variable;
+          ] );
+      ])
diff --git a/test/ppx_deriving_qcheck/deriver/test_tuple.ml b/test/ppx_deriving_qcheck/deriver/test_tuple.ml
new file mode 100644
index 0000000..0aa93d2
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/test_tuple.ml
@@ -0,0 +1,106 @@
+open QCheck
+
+type a = char [@gen QCheck.Gen.pure 'a']
+[@@deriving qcheck]
+
+type b = char [@gen QCheck.Gen.pure 'b']
+[@@deriving qcheck]
+
+type c = char [@gen QCheck.Gen.pure 'c']
+[@@deriving qcheck]
+
+type d = char [@gen QCheck.Gen.pure 'd']
+[@@deriving qcheck]
+
+type e = char [@gen QCheck.Gen.pure 'e']
+[@@deriving qcheck]
+
+type f = char [@gen QCheck.Gen.pure 'f']
+[@@deriving qcheck]
+
+type g = char [@gen QCheck.Gen.pure 'g']
+[@@deriving qcheck]
+
+type h = char [@gen QCheck.Gen.pure 'h']
+[@@deriving qcheck]
+
+type i = char [@gen QCheck.Gen.pure 'i']
+[@@deriving qcheck]
+
+type tup2 = a * b
+[@@deriving qcheck]
+
+type tup3 = a * b * c
+[@@deriving qcheck]
+
+type tup4 = a * b * c * d
+[@@deriving qcheck]
+
+type tup5 = a * b * c * d * e
+[@@deriving qcheck]
+
+type tup6 = a * b * c * d * e * f
+[@@deriving qcheck]
+
+type tup7 = a * b * c * d * e * f * g
+[@@deriving qcheck]
+
+type tup8 = a * b * c * d * e * f * g * h
+[@@deriving qcheck]
+
+let test_tup2 =
+  Test.make ~count:10
+    ~name:"forall x in ('a', 'b'): x = ('a', 'b')"
+    (make gen_tup2)
+    (fun x -> x = ('a', 'b'))
+
+let test_tup3 =
+  Test.make ~count:10
+    ~name:"forall x in ('a', 'b', 'c'): x = ('a', 'b', 'c')"
+    (make gen_tup3)
+    (fun x -> x = ('a', 'b', 'c'))
+
+let test_tup4 =
+  Test.make ~count:10
+    ~name:"forall x in ('a', 'b', 'c', 'd'): x = ('a', 'b', 'c', 'd')"
+    (make gen_tup4)
+    (fun x -> x = ('a', 'b', 'c', 'd'))
+
+let test_tup5 =
+  Test.make ~count:10
+    ~name:"forall x in ('a', 'b', 'c', 'd', 'e'): x = ('a', 'b', 'c', 'd', 'e')"
+    (make gen_tup5)
+    (fun x -> x = ('a', 'b', 'c', 'd', 'e'))
+
+let test_tup6 =
+  Test.make ~count:10
+    ~name:"forall x in ('a', 'b', 'c', 'd', 'e', 'f'): x = ('a', 'b', 'c', 'd', 'e', 'f')"
+    (make gen_tup6)
+    (fun x -> x = ('a', 'b', 'c', 'd', 'e', 'f'))
+
+let test_tup7 =
+  Test.make ~count:10
+    ~name:"forall x in ('a', 'b', 'c', 'd', 'e', 'f', 'g'): x = ('a', 'b', 'c', 'd', 'e', 'f', 'g')"
+    (make gen_tup7)
+    (fun x -> x = ('a', 'b', 'c', 'd', 'e', 'f', 'g'))
+
+let test_tup8 =
+  Test.make ~count:10
+    ~name:"forall x in ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h'): x = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h')"
+    (make gen_tup8)
+    (fun x -> x = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h'))
+
+let tests = [
+    test_tup2;
+    test_tup3;
+    test_tup4;
+    test_tup5;
+    test_tup6;
+    test_tup7;
+    test_tup8;
+  ]
+
+let tests = List.map (QCheck_alcotest.to_alcotest) tests
+
+(** {2. Execute tests} *)
+let () = Alcotest.run "Test_Tuple" [("Tuple", tests)]
diff --git a/test/ppx_deriving_qcheck/deriver/test_variants.ml b/test/ppx_deriving_qcheck/deriver/test_variants.ml
new file mode 100644
index 0000000..58110fa
--- /dev/null
+++ b/test/ppx_deriving_qcheck/deriver/test_variants.ml
@@ -0,0 +1,81 @@
+open QCheck
+open Helpers
+
+(** {1. Test variants and polymorphic variants derivation} *)
+
+(** {2. Variants} *)
+
+type colors = Red | Green | Blue [@@deriving qcheck]
+
+let pp_colors fmt x =
+  let open Format in
+  match x with
+  | Red -> fprintf fmt "Red"
+  | Green -> fprintf fmt "Green"
+  | Blue -> fprintf fmt "Blue"
+
+let eq_colors = Alcotest.of_pp pp_colors
+
+let gen = Gen.oneofl [Red; Green; Blue]
+
+let test_variants () =
+  test_compare ~msg:"Gen.oneofl <=> deriving variants" ~eq:eq_colors gen gen_colors
+
+type poly_colors = [`Red | `Green | `Blue] [@@deriving qcheck]
+
+let pp_poly_colors fmt x =
+  let open Format in
+  match x with
+  | `Red -> fprintf fmt "`Red"
+  | `Green -> fprintf fmt "`Green"
+  | `Blue -> fprintf fmt "`Blue"
+
+let eq_poly_colors = Alcotest.of_pp pp_poly_colors
+
+let gen_poly : poly_colors Gen.t = Gen.oneofl [`Red; `Green; `Blue]
+
+let test_poly_variants () =
+  test_compare ~msg:"Gen.oneofl <=> deriving variants"
+    ~eq:eq_poly_colors gen_poly gen_poly_colors
+
+(** {2. Tests weight} *)
+
+type letters =
+  | A [@weight 0]
+  | B
+[@@deriving qcheck]
+
+let test_weight =
+  Test.make ~name:"gen_letters always produces B"
+    (make gen_letters)
+    (function
+     | A -> false
+     | B -> true)
+  |>
+    QCheck_alcotest.to_alcotest
+
+type poly_letters = [
+    | `A [@weight 0]
+    | `B
+  ]
+[@@deriving qcheck]
+
+let test_weight_poly =
+  Test.make ~name:"gen_poly_letters always produces B"
+    (make gen_poly_letters)
+    (function
+     | `A -> false
+     | `B -> true)
+  |>
+    QCheck_alcotest.to_alcotest
+
+(** {2. Execute tests} *)
+
+let () = Alcotest.run "Test_Variant"
+           [("Variants",
+             Alcotest.[
+                 test_case "test_variants" `Quick test_variants;
+                 test_case "test_poly_variants" `Quick test_poly_variants;
+                 test_weight;
+                 test_weight_poly
+           ])]