(** QCheck(1) tests **)

(* Please add any additional tests to both [QCheck_tests.ml] and [QCheck2_tests.ml].
   This ensures that both generator approaches continue to work as expected
   and furthermore allows us to compare their behaviour with
   [diff -y test/core/QCheck_expect_test.expected test/core/QCheck2_expect_test.expected] *)

(** Module representing a tree data structure, used in tests *)
module IntTree = struct
  open QCheck

  type tree = Leaf of int | Node of tree * tree

  let leaf x = Leaf x
  let node x y = Node (x,y)

  let rec depth = function
    | Leaf _ -> 1
    | Node (x, y) -> 1 + max (depth x) (depth y)

  let rec print_tree = function
    | Leaf x -> Printf.sprintf "Leaf %d" x
    | Node (x, y) -> Printf.sprintf "Node (%s, %s)" (print_tree x) (print_tree y)

  let gen_tree = Gen.(sized @@ fix
                        (fun self n -> match n with
                           | 0 -> map leaf nat
                           | n ->
                             oneof_weighted
                               [1, map leaf nat;
                                2, map2 node (self (n/2)) (self (n/2))]
                        ))

  let rec shrink_tree t = match t with
    | Leaf l -> Iter.map (fun l' -> Leaf l') (Shrink.int l)
    | Node (x,y) ->
      let open Iter in
      of_list [x;y]
      <+> map (fun x' -> Node (x',y)) (shrink_tree x)
      <+> map (fun y' -> Node (x,y')) (shrink_tree y)

  let rec rev_tree = function
    | Node (x, y) -> Node (rev_tree y, rev_tree x)
    | Leaf x -> Leaf x

  let rec contains_only_n tree n = match tree with
    | Leaf n' -> n = n'
    | Node (x, y) -> contains_only_n x n && contains_only_n y n
end

(* tests of overall functionality *)
module Overall = struct
  open QCheck

  let passing =
    Test.make ~name:"list_rev_is_involutive" ~count:100 ~long_factor:100
      (list int_small) (fun l -> List.rev (List.rev l) = l)

  let failing =
    Test.make ~name:"should_fail_sort_id" ~count:10
      (list_small nat_small) (fun l -> l = List.sort compare l)

  let max_fail =
    Test.make ~name:"max_fail" ~count:1000 ~max_fail:3
      (list nat_small)
      (fun l -> l = List.rev l)

  exception Error

  let error =
    Test.make ~name:"should_error_raise_exn" ~count:10
      int (fun _ -> raise Error)

  let collect =
    Test.make ~name:"collect_results" ~count:100 ~long_factor:100
      (make ~collect:string_of_int (Gen.int_bound 4))
      (fun _ -> true)

  let stats =
    Test.make ~name:"with_stats" ~count:100 ~long_factor:100
      (make (Gen.int_bound 120)
         ~stats:[
           "mod4", (fun i->i mod 4);
           "num", (fun i->i);
         ])
      (fun _ -> true)

  let retries =
    Test.make ~name:"with shrinking retries" ~retries:10
      nat_small (fun i -> Printf.printf "%i %!" i; i mod 3 <> 1)

  let bad_assume_warn =
    Test.make ~name:"WARN_unlikely_precond" ~count:2_000
      int
      (fun x ->
         QCheck.assume (x mod 100 = 1);
         true)

  let bad_assume_fail =
    Test.make ~name:"FAIL_unlikely_precond" ~count:2_000
      ~if_assumptions_fail:(`Fatal, 0.1)
      int
      (fun x ->
         QCheck.assume (x mod 100 = 1);
         true)

  let bad_gen_fail =
    Test.make ~name:"FAIL_bad_gen"
      (make Gen.(int >>= fun j -> int_bound j >>= fun i -> return (i,j)))
      (fun (_i,_j) -> true) (* i may be negative, causing int_bound to fail *)

  let bad_shrinker_fail =
    Test.make ~name:"FAIL_bad_shrinker"
      (make
        ~shrink:(fun _i -> raise Error)
         Gen.int)
      (fun _i -> false)

  let neg_test_fail_as_expected =
    Test.make_neg ~name:"all ints are even" int_small (fun i -> i mod 2 = 0)

  let neg_test_unexpected_success =
    Test.make_neg ~name:"int double" int_small (fun i -> i + i = i * 2)

  let neg_test_fail_with_shrinking =
    Test.make_neg ~name:"list rev concat"
      (pair (list int_small) (list int_small)) (fun (is,js) -> (List.rev is)@(List.rev js) = List.rev (is@js))

  let pos_test_fails_with_error =
    Test.make ~name:"pos fail with error" nat_small (fun _i -> raise Error)

  let neg_test_fail_with_error =
    Test.make_neg ~name:"neg fail with error" nat_small (fun _i -> raise Error)

  (* [apply_n f x n] computes f(f(...f(x))) with n applications of f *)
  let rec apply_n f x n =
    if n=0
    then x
    else apply_n f (f x) (pred n)

  (* test from #236 *)
  let bad_fun_repro =
    let sleep_time = 0.175 in
    let count = ref 0 in
    Test.make ~count:10 ~name:"bad function reproducability"
      (set_shrink Shrink.nil (triple nat_small (fun1 Observable.int nat_small) nat_small))
      (fun (i,f,j) ->
         incr count;
         Printf.printf "(%i,fun,%i)%s%!" i j (if !count mod 10 = 0 then "\n" else " ");
         Unix.sleepf sleep_time;
         if 1 = Float.to_int (Unix.time ()) mod 2
         then
           (ignore(apply_n (Fn.apply f) i j > 0); true)
         else
           (ignore(apply_n (Fn.apply f) i i > 0); true))

  let tests = [
    passing;
    failing;
    max_fail;
    error;
    collect;
    stats;
    retries;
    bad_assume_warn;
    bad_assume_fail;
    bad_gen_fail;
    (*bad_shrinker_fail;*)
    neg_test_fail_as_expected;
    neg_test_unexpected_success;
    neg_test_fail_with_shrinking;
    pos_test_fails_with_error;
    neg_test_fail_with_error;
    (* we repeat the following multiple times to check the expected output for duplicate lines *)
    bad_fun_repro;
    bad_fun_repro;
    bad_fun_repro;
    bad_fun_repro;
    bad_fun_repro;
    bad_fun_repro;
    bad_fun_repro;
    bad_fun_repro;
  ]
end

(* positive tests of the various generators *)
module Generator = struct
  open QCheck

  (* example from issue #23 *)
  let char_dist_issue_23 =
    Test.make ~name:"char never produces '\\255'" ~count:1_000_000 char (fun c -> c <> '\255')

  let char_test =
    Test.make ~name:"char has right range" ~count:1000
      char (fun c -> '\000' <= c && c <= '\255')

  let char_range_test =
    Test.make ~name:"char_range 'a' 'z' has right range" ~count:1000
      (char_range 'a' 'z') (fun c -> 'a' <= c && c <= 'z')

  let char_printable_test =
    Test.make ~name:"char_printable has right range" ~count:1000
      char_printable (fun c -> c = '\n' || 32 <= Char.code c && Char.code c <= 126)

  let char_numeral_test =
    Test.make ~name:"char_numeral has right range" ~count:1000
      char_numeral (fun c -> '0' <= c && c <= '9')

  let nat_test =
    Test.make ~name:"nat has right range" ~count:1000
      (make ~print:Print.int Gen.nat) (fun n -> 0 <= n && n < 10000)

  let int_test =
    Test.make ~name:"int doubling" ~count:1000
      int (fun i -> i+i = 2*i)

  let int32_test =
    Test.make ~name:"int32 doubling" ~count:1000
      int32 (fun i -> Int32.add i i = Int32.mul 2l i)

  let int64_test =
    Test.make ~name:"int64 doubling" ~count:1000
      int64 (fun i -> Int64.add i i = Int64.mul 2L i)

  let bytes_test =
    Test.make ~name:"bytes has right length and content" ~count:1000
      bytes
      (fun b ->
        let len = Bytes.length b in
        0 <= len && len < 10000
        && Bytes.to_seq b |>
             Seq.fold_left (fun acc c -> acc && '\000' <= c && c <= '\255') true)

  let string_test =
    Test.make ~name:"string has right length and content" ~count:1000
      string
      (fun s ->
         let len = String.length s in
         0 <= len && len < 10000
         && String.to_seq s |>
            Seq.fold_left (fun acc c -> acc && '\000' <= c && c <= '\255') true)

  let pair_test =
    Test.make ~name:"int pairs - commute over +" ~count:1000
      (pair nat_small nat_small) (fun (i,j) -> i+j = j+i)

  let triple_test =
    Test.make ~name:"int triples - associative over +" ~count:1000
      (triple nat_small nat_small nat_small) (fun (i,j,k) -> i+(j+k) = (i+j)+k)

  let quad_test =
    Test.make ~name:"int quadruples - product of sums" ~count:1000
      (quad nat_small nat_small nat_small nat_small)
      (fun (h,i,j,k) -> (h+i)*(j+k) = h*j + h*k + i*j + i*k)

  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 bind_test =
    Test.make ~name:"bind test for ordered pairs" ~count:1000
      (make Gen.(nat_small >>= fun j -> int_bound j >>= fun i -> return (i,j)))
      (fun (i,j) -> i<=j)

  let bind_pair_list_length =
    Test.make ~name:"bind list length" ~count:1000
      (make Gen.(int_bound 1000 >>= fun len ->
                 list_size (return len) (int_bound 1000) >>= fun xs -> return (len,xs)))
      (fun (len,xs) -> len = List.length xs)

  let list_test =
    Test.make ~name:"list has right length" ~count:1000
      (list unit) (fun l -> let len = List.length l in 0 <= len && len < 10_000)

  let int_option_test =
    Test.make ~name:"int option right range" ~count:1000
      (option (int_bound 1000)) (function None -> true | Some i -> 0 <= i && i <= 1000)

  let int_string_result_test =
    Test.make ~name:"(int,string) result right range" ~count:1000
      (result (int_bound 1000) string_small) (function Ok i -> 0 <= i && i <= 1000 | Error s -> String.length s < 100)

  let passing_tree_rev =
    Test.make ~name:"tree_rev_is_involutive" ~count:1000
      (make IntTree.gen_tree)
      (fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree)

  let nat_split2_spec =
    Test.make ~name:"nat_split2 spec"
      (make
        ~print:Print.(pair int (pair int int))
         Gen.(nat_small >>= fun n ->
              pair (return n) (nat_split2 n)))
      (fun (n, (a, b)) ->
         0 <= a && 0 <= b && a + b = n)

  let pos_split2_spec =
    Test.make ~name:"pos_split2 spec"
      (make
        ~print:Print.(pair int (pair int int))
         Gen.(nat_small >>= fun n ->
              (* we need n > 2 *)
              let n = n + 2 in
              pair (return n) (pos_split2 n)))
      (fun (n, (a, b)) ->
         (0 < a && 0 < b && a + b = n))

  let range_subset_spec =
    Test.make ~name:"range_subset_spec"
      (make
         ~print:Print.(quad int int int (array int))
         Gen.(pair nat_small nat_small >>= fun (m, n) ->
              (* we must guarantee [low <= high]
                 and [size <= high - low + 1] *)
              let low = m and high = m + n in
              int_range 0 (high - low + 1) >>= fun size ->
              quad (return size) (return low) (return high)
                (range_subset ~size low high)))
      (fun (size, low, high, arr) ->
         if size = 0 then arr = [||]
         else
           Array.length arr = size
           && low <= arr.(0)
           && Array.for_all (fun (a, b) -> a < b)
               (Array.init (size - 1) (fun k -> arr.(k), arr.(k+1)))
           && arr.(size - 1) <= high)

  let nat_split_n_way =
    Test.make ~name:"nat_split n-way"
      (make
         ~print:Print.(pair int (array int))
         Gen.(nat_small >>= fun n ->
              pair (return n) (nat_split ~size:n n)))
      (fun (n, arr) ->
         Array.length arr = n
         && Array.for_all (fun k -> 0 <= k) arr
         && Array.fold_left (+) 0 arr = n)

  let nat_split_smaller =
    Test.make ~name:"nat_split smaller"
      (make
         ~print:Print.(triple int int (array int))
         Gen.(nat_small >>= fun size ->
              int_bound size >>= fun n ->
              triple (return size) (return n) (nat_split ~size n)))
      (fun (m, n, arr) ->
         Array.length arr = m
         && Array.for_all (fun k -> 0 <= k) arr
         && Array.fold_left (+) 0 arr = n)

  let pos_split =
    Test.make ~name:"pos_split"
      (make
         ~print:Print.(triple int int (array int))
         Gen.(pair nat_small nat_small >>= fun (m, n) ->
              (* we need both size>0 and n>0 and size <= n *)
              let size = 1 + min m n and n = 1 + max m n in
              triple (return size) (return n) (pos_split ~size n)))
      (fun (m, n, arr) ->
         Array.length arr = m
         && Array.for_all (fun k -> 0 < k) arr
         && Array.fold_left (+) 0 arr = n)

  let float_test =
    Test.make ~name:"regression test negative float range" ~count:1000 (float_range (-2.) (-1.)) (fun _ -> false)

  let tests = [
    char_dist_issue_23;
    char_test;
    char_range_test;
    char_printable_test;
    char_numeral_test;
    nat_test;
    int_test;
    int32_test;
    int64_test;
    bytes_test;
    string_test;
    pair_test;
    triple_test;
    quad_test;
    test_tup2;
    test_tup3;
    test_tup4;
    test_tup5;
    test_tup6;
    test_tup7;
    test_tup8;
    test_tup9;
    bind_test;
    bind_pair_list_length;
    list_test;
    int_option_test;
    int_string_result_test;
    passing_tree_rev;
    nat_split2_spec; (* Features (and tests) only available in QCheck for now, not QCheck2 *)
    pos_split2_spec;
    range_subset_spec;
    nat_split_n_way;
    nat_split_smaller;
    pos_split;       (* ... up until this one *)
    float_test;
  ]
end

(* negative tests that exercise shrinking behaviour *)
module Shrink = struct
  open QCheck

  let rec fac n = match n with
    | 0 -> 1
    | n -> n * fac (n - 1)

  (* example from issue #59 *)
  let test_fac_issue59 =
    Test.make ~name:"test fac issue59"
      (set_shrink Shrink.nil (int_small_corners ()))
      (fun n -> try (fac n) mod n = 0
                with
                (*| Stack_overflow   -> false*)
                | Division_by_zero -> (n=0))

  let big_bound_issue59 =
    Test.make ~name:"big bound issue59"
      (int_small_corners()) (fun i -> i < 209609)

  let long_shrink =
    let listgen = list_size (Gen.int_range 1000 10000) int in
    Test.make ~name:"long_shrink" (pair listgen listgen)
      (fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys))

  (* test from issue #36 *)
  let ints_arent_0_mod_3 =
    Test.make ~name:"ints arent 0 mod 3" ~count:1000
      int (fun i -> i mod 3 <> 0)

  let ints_are_0 =
    Test.make ~name:"ints are 0" ~count:1000
      int (fun i -> Printf.printf "%i\n" i; i = 0)

  let int32s_arent_0l_rem_3l =
    Test.make ~name:"int32s arent 0l rem 3l" ~count:1000
      int32 (fun i -> Int32.rem i 3l <> 0l)

  let int32s_are_0l =
    Test.make ~name:"int32s are 0l" ~count:1000
      int32 (fun i -> i = 0l)

  let int64s_arent_0L_rem_3L =
    Test.make ~name:"int64s arent 0L rem 3L" ~count:1000
      int64 (fun i -> Int64.rem i 3L <> 0L)

  let int64s_are_0L =
    Test.make ~name:"int64s are 0L" ~count:1000
      int64 (fun i -> i = 0L)

  (* test from issue #59 *)
  let ints_smaller_209609 =
    Test.make ~name:"ints < 209609"
      (int_small_corners()) (fun i -> i < 209609)

  let nats_smaller_5001 =
    Test.make ~name:"nat < 5001" ~count:1000
      (make ~print:Print.int ~shrink:Shrink.int Gen.nat) (fun n -> n < 5001)

  let float_leq_1e10 =
    Test.make ~name:"float <= 1e10" ~count:1000
      float (fun f -> f <= 1e10)

  let float_lt_pi =
    Test.make ~name:"float < Float.pi" ~count:1000
      float (fun f -> f < Float.pi)

  let float_leq_1 =
    Test.make ~name:"float <= 1.0" ~count:1000
      float (fun f -> f <= 1.0)

  let float_lt_1 =
    Test.make ~name:"float < 1.0" ~count:1000
      float (fun f -> f < 1.0)

  let float_leq_1em10 =
    Test.make ~name:"float <= 1e-10" ~count:1000
      float (fun f -> f <= 1e-10)

  let float_geq_m1em10 =
    Test.make ~name:"float >= -1e-10" ~count:1000
      float (fun f -> f >= -1e-10)

  let float_geq_m1e10 =
    Test.make ~name:"float >= -1e10" ~count:1000
      float (fun f -> f >= -1e10)

  let float_not_nan =
    Test.make ~name:"float is not nan" ~count:10_000
      float (fun f -> not (Float.is_nan f))

  let float_not_infinite =
    Test.make ~name:"float is not infinity" ~count:10_000
      float (fun f -> not (Float.is_infinite f))

  let float_bound_inclusive_1e6_leq_10 =
    Test.make ~name:"float_bound_inclusive 1e6 <= 10." ~count:1000
      (float_bound_inclusive 1e6) (fun f -> f <= 10.)

  let float_bound_inclusive_1e6_leq_pi =
    Test.make ~name:"float_bound_inclusive 1e6 <= pi" ~count:1000
      (float_bound_inclusive 1e6) (fun f -> f <= Float.pi)

  let float_bound_inclusive_1_leq_5em1 =
    Test.make ~name:"float_bound_inclusive 1. <= 0.5" ~count:1000
      (float_bound_inclusive 1.) (fun f -> f <= 0.5)

  let float_bound_inclusive_1_leq_min_float =
    Test.make ~name:"float_bound_inclusive 1. <= min_float" ~count:1000
      (float_bound_inclusive 1.) (fun f -> f <= min_float)

  let float_bound_inclusive_m1_geq_m5em1 =
    Test.make ~name:"float_bound_inclusive -1. >= -0.5" ~count:1000
      (float_bound_inclusive (-1.)) (fun f -> f >= -0.5)

  let float_bound_inclusive_m1e6_geq_mpi =
    Test.make ~name:"float_bound_inclusive -1e6 >= -.pi" ~count:1000
      (float_bound_inclusive (-1e6)) (fun f -> f >= -.Float.pi)

  let float_bound_exclusive_1e6_leq_10 =
    Test.make ~name:"float_bound_exclusive 1e6 <= 10." ~count:1000
      (float_bound_exclusive 1e6) (fun f -> f <= 10.)

  let float_bound_exclusive_1e6_leq_pi =
    Test.make ~name:"float_bound_exclusive 1e6 <= pi" ~count:1000
      (float_bound_exclusive 1e6) (fun f -> f <= Float.pi)

  let float_bound_exclusive_1_leq_5em1 =
    Test.make ~name:"float_bound_exclusive 1. <= 0.5" ~count:1000
      (float_bound_exclusive 1.) (fun f -> f <= 0.5)

  let float_bound_exclusive_1_leq_min_float =
    Test.make ~name:"float_bound_exclusive 1. <= min_float" ~count:1000
      (float_bound_exclusive 1.) (fun f -> f <= min_float)

  let float_bound_exclusive_m1_geq_m5em1 =
    Test.make ~name:"float_bound_exclusive -1. >= -0.5" ~count:1000
      (float_bound_exclusive (-1.)) (fun f -> f >= -0.5)

  let float_bound_exclusive_m1e6_geq_mpi =
    Test.make ~name:"float_bound_exclusive -1e6 >= -.pi" ~count:1000
      (float_bound_exclusive (-1e6)) (fun f -> f >= -.Float.pi)

  let float_range_1_10_leq_pi =
    Test.make ~name:"float_range 1. 10. <= pi" ~count:1000
      (float_range 1. 10.) (fun f -> f <= Float.pi)

  let float_range_m10_10_square_leq_2 =
    Test.make ~name:"(float_range -10. 10.)^2 <= 2." ~count:1000
      (float_range (-10.) 10.) (fun f -> f *. f <= 2.)

  let float_range_m10_m1_geq_mpi =
    Test.make ~name:"float_range -10. -1. >= -.pi" ~count:1000
      (float_range (-10.) (-1.)) (fun f -> f >= -.Float.pi)

  let float_pos_lt_pi =
    Test.make ~name:"float_pos < Float.pi" ~count:1000
      float_pos (fun f -> f < Float.pi)

  let float_pos_not_nan =
    Test.make ~name:"float_pos is not nan" ~count:10_000
      float_pos (fun f -> not (Float.is_nan f))

  let float_pos_not_infinite =
    Test.make ~name:"float_pos is not infinity" ~count:10_000
      float_pos (fun f -> not (Float.is_infinite f))

  let float_neg_gt_mpi =
    Test.make ~name:"float_neg > Float.pi" ~count:1000
      float_neg (fun f -> f > -.Float.pi)

  let float_neg_not_nan =
    Test.make ~name:"float_neg is not nan" ~count:10_000
      float_neg (fun f -> not (Float.is_nan f))

  let float_neg_not_infinite =
    Test.make ~name:"float_neg is not infinity" ~count:10_000
      float_neg (fun f -> not (Float.is_infinite f))

  let float_exp_10_lt_pi =
    Test.make ~name:"float_exp 10. < Float.pi" ~count:1000
      (float_exp 10.) (fun f -> f < Float.pi)

  let float_exp_m10_gt_mpi =
    Test.make ~name:"float_exp -10. > -. Float.pi" ~count:1000
      (float_exp (-10.)) (fun f -> f > -. Float.pi)

  let char_is_never_abcdef =
    Test.make ~name:"char never produces 'abcdef'" ~count:1000
      char (fun c -> not (List.mem c ['a';'b';'c';'d';'e';'f']))

  let char_range_is_never_abc =
    Test.make ~name:"char never 'abc'" ~count:1000
      (char_range 'a' 'z') (fun c -> not (c < 'c'))

  let char_printable_is_never_sign = (* should shrink towards 'a', hence produce '&' with highest ascii code 38 *)
    Test.make ~name:"char_printable never produces '!\"#$%&'" ~count:1000
      char_printable (fun c -> not (List.mem c ['!';'"';'#';'$';'%';'&']))

  let char_numeral_is_never_less_5 =
    Test.make ~name:"char_numeral never produces less than '5'" ~count:1000
      char_numeral (fun c -> c >= '5')

  let bytes_are_empty =
    Test.make ~name:"bytes are empty" ~count:1000
      bytes (fun b -> b = Bytes.empty)

  let bytes_never_has_000_char =
    Test.make ~name:"bytes never has a \\000 char" ~count:1000
      bytes
      (fun b -> Bytes.to_seq b |> Seq.fold_left (fun acc c -> acc && c <> '\000') true)

   let bytes_never_has_255_char =
    Test.make ~name:"bytes never has a \\255 char" ~count:1000
      bytes
      (fun s -> Bytes.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\255') true)

  let bytes_unique_chars =
    Test.make ~name:"bytes have unique chars" ~count:1000
      bytes
      (fun s ->
         let ch_list = Bytes.to_seq s |> List.of_seq in
         List.length ch_list = List.length (List.sort_uniq Char.compare ch_list))

  let strings_are_empty =
    Test.make ~name:"strings are empty" ~count:1000
      string (fun s -> s = "")

  let string_never_has_000_char =
    Test.make ~name:"string never has a \\000 char" ~count:1000
      string
      (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\000') true)

  let string_never_has_255_char =
    Test.make ~name:"string never has a \\255 char" ~count:1000
      string
      (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\255') true)

  let string_unique_chars =
    Test.make ~name:"strings have unique chars" ~count:1000
      string
      (fun s ->
         let ch_list = String.to_seq s |> List.of_seq in
         List.length ch_list = List.length (List.sort_uniq Char.compare ch_list))

  (* test from issue #167 *)
  let pair_diff_issue_64 =
    Test.make ~name:"pairs have different components"
      (pair nat_small nat_small) (fun (i,j) -> i<>j)

  let pair_same =
    Test.make ~name:"pairs have same components" (pair int int) (fun (i,j) -> i=j)

  let pair_one_zero =
    Test.make ~name:"pairs have a zero component" (pair int int) (fun (i,j) -> i=0 || j=0)

  let pair_all_zero =
    Test.make ~name:"pairs are (0,0)" (pair int int) (fun (i,j) -> i=0 && j=0)

  let pair_ordered =
    Test.make ~name:"pairs are ordered" (pair int_pos int_pos) (fun (i,j) -> i<=j)

  let pair_ordered_rev =
    Test.make ~name:"pairs are ordered reversely" (pair int_pos int_pos) (fun (i,j) -> i>=j)

  let pair_sum_lt_128 =
    Test.make ~name:"pairs sum to less than 128" (pair int_pos int_pos) (fun (i,j) -> i+j<128)

  let pair_lists_rev_concat =
    Test.make ~name:"pairs lists rev concat"
      (pair (list int_pos) (list int_pos))
      (fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys))

  let pair_lists_no_overlap =
    Test.make ~name:"pairs lists no overlap"
      (pair (list nat_small) (list nat_small))
      (fun (xs,ys) -> List.for_all (fun x -> not (List.mem x ys)) xs)

  let triple_diff =
    Test.make ~name:"triples have pair-wise different components"
      (triple nat_small nat_small nat_small) (fun (i,j,k) -> i<>j && j<>k)

  let triple_same =
    Test.make ~name:"triples have same components"
      (triple int int int) (fun (i,j,k) -> i=j || j=k)

  let triple_ordered =
    Test.make ~name:"triples are ordered"
      (triple int int int) (fun (i,j,k) -> i<=j && j<=k)

  let triple_ordered_rev =
    Test.make ~name:"triples are ordered reversely"
      (triple int int int) (fun (i,j,k) -> i>=j && j>=k)

  let quad_diff =
    Test.make ~name:"quadruples have pair-wise different components"
      (quad nat_small nat_small nat_small nat_small) (fun (h,i,j,k) -> h<>i && i<>j && j<>k)

  let quad_same =
    Test.make ~name:"quadruples have same components"
      (quad int int int int) (fun (h,i,j,k) -> h=i || i=j || j=k)

  let quad_ordered =
    Test.make ~name:"quadruples are ordered"
      (quad int int int int) (fun (h,i,j,k) -> h <= i && i <= j && j <= k)

  let quad_ordered_rev =
    Test.make ~name:"quadruples are ordered reversely"
      (quad int int int int) (fun (h,i,j,k) -> h >= i && i >= j && j >= k)

  let test_tup2 =
    Test.make
      ~name:"forall (a, b) in nat: a < b"
      (tup2 nat_small nat_small)
      (fun (a, b) -> a < b)

  let test_tup3 =
    Test.make
      ~name:"forall (a, b, c) in nat: a < b < c"
      (tup3 nat_small nat_small nat_small)
      (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 nat_small nat_small nat_small nat_small)
      (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 nat_small nat_small nat_small nat_small nat_small)
      (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 nat_small nat_small nat_small nat_small nat_small nat_small)
      (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 nat_small nat_small nat_small nat_small nat_small nat_small nat_small)
      (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 nat_small nat_small nat_small nat_small nat_small nat_small nat_small nat_small)
      (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 nat_small nat_small nat_small nat_small nat_small nat_small nat_small nat_small nat_small)
      (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 bind_pair_ordered =
    Test.make ~name:"bind ordered pairs"
      (make ~print:Print.(pair int int)
         ~shrink:Shrink.(filter (fun (i,j) -> i<=j) (pair int int))
         Gen.(int_pos >>= fun j -> int_bound j >>= fun i -> return (i,j)))
      (fun (_i,_j) -> false)

  let bind_pair_list_size =
    let shrink (_l,xs) =
      Iter.map (fun xs' -> (List.length xs',xs')) Shrink.(list ~shrink:int xs) in
    Test.make ~name:"bind list_size constant"
      (make ~print:Print.(pair int (list int)) ~shrink
         Gen.(int_bound 1000 >>= fun len ->
              list_size (return len) (int_bound 1000) >>= fun xs -> return (len,xs)))
      (fun (len,xs) -> let len' = List.length xs in len=len' && len' < 4)

  let print_list xs = print_endline Print.(list int xs)

  (* test from issue #64 *)
  let lists_are_empty_issue_64 =
    Test.make ~name:"lists are empty"
      (list nat_small) (fun xs -> print_list xs; xs = [])

  let list_shorter_10 =
    Test.make ~name:"lists shorter than 10"
      (list nat_small) (fun xs -> List.length xs < 10)

  let length_printer xs =
    Printf.sprintf "[...] list length: %i" (List.length xs)

  let size_gen = Gen.(oneof [nat_small; int_bound 750_000])

  let list_shorter_432 =
    Test.make ~name:"lists shorter than 432"
      (set_print length_printer (list_size size_gen nat_small))
      (fun xs -> List.length xs < 432)

  let list_shorter_4332 =
    Test.make ~name:"lists shorter than 4332"
      (set_shrink Shrink.list_spine (set_print length_printer (list_size size_gen nat_small)))
      (fun xs -> List.length xs < 4332)

  let list_equal_dupl =
    Test.make ~name:"lists equal to duplication"
      (list_size size_gen int_small)
      (fun xs -> try xs = xs @ xs
                 with Stack_overflow -> false)

  let list_unique_elems =
    Test.make ~name:"lists have unique elems"
      (list nat_small)
      (fun xs -> let ys = List.sort_uniq Int.compare xs in
                 print_list xs; List.length xs = List.length ys)

  let int_option_are_none =
    Test.make ~name:"int option are none" ~count:1000
      (option (int_bound 1000)) (function None -> true | Some _ -> false)

   let int_option_are_some_100_or_more =
    Test.make ~name:"int option are some 100 or more" ~count:1000
      (option (int_bound 1000)) (function None -> false | Some i -> i >= 100)

  let int_string_result_are_ok =
    Test.make ~name:"(int,string) result are Ok" ~count:1000
      (result (int_bound 1000) string_small) (function Ok _ -> true | Error _ -> false)

  let int_string_result_are_error =
    Test.make ~name:"(int,string) result are Error" ~count:1000
      (result (int_bound 1000) string_small) (function Ok _ -> false | Error _ -> true)

  let tree_contains_only_42 =
    Test.make ~name:"tree contains only 42"
      IntTree.(make ~print:print_tree ~shrink:shrink_tree gen_tree)
      (fun tree -> IntTree.contains_only_n tree 42)

  let test_gen_no_shrink =
    Test.make ~name:"sum list = 0 with no_shrink"
      (no_shrink @@ list nat_small)
      (fun xs -> List.fold_left (+) 0 xs = 0)

  let tests = [
    (*test_fac_issue59;*)
    big_bound_issue59;
    long_shrink;
    ints_arent_0_mod_3;
    ints_are_0;
    int32s_arent_0l_rem_3l;
    int32s_are_0l;
    int64s_arent_0L_rem_3L;
    int64s_are_0L;
    ints_smaller_209609;
    nats_smaller_5001;
    float_leq_1e10;
    float_lt_pi;
    float_leq_1;
    float_lt_1;
    float_leq_1em10;
    float_geq_m1em10;
    float_geq_m1e10;
    float_not_nan;
    float_not_infinite;
    float_bound_inclusive_1e6_leq_10;
    float_bound_inclusive_1e6_leq_pi;
    float_bound_inclusive_1_leq_5em1;
    float_bound_inclusive_1_leq_min_float;
    float_bound_inclusive_m1_geq_m5em1;
    float_bound_inclusive_m1e6_geq_mpi;
    float_bound_exclusive_1e6_leq_10;
    float_bound_exclusive_1e6_leq_pi;
    float_bound_exclusive_1_leq_5em1;
    float_bound_exclusive_1_leq_min_float;
    float_bound_exclusive_m1_geq_m5em1;
    float_bound_exclusive_m1e6_geq_mpi;
    float_range_1_10_leq_pi;
    float_range_m10_10_square_leq_2;
    float_range_m10_m1_geq_mpi;
    float_pos_lt_pi;
    float_pos_not_nan;
    float_pos_not_infinite;
    float_neg_gt_mpi;
    float_neg_not_nan;
    float_neg_not_infinite;
    float_exp_10_lt_pi;
    float_exp_m10_gt_mpi;
    char_is_never_abcdef;
    char_range_is_never_abc;
    char_printable_is_never_sign;
    char_numeral_is_never_less_5;
    bytes_are_empty;
    bytes_never_has_000_char;
    bytes_never_has_255_char;
    bytes_unique_chars;
    strings_are_empty;
    string_never_has_000_char;
    string_never_has_255_char;
    string_unique_chars;
    pair_diff_issue_64;
    pair_same;
    pair_one_zero;
    pair_all_zero;
    pair_ordered;
    pair_ordered_rev;
    pair_sum_lt_128;
    pair_lists_rev_concat;
    pair_lists_no_overlap;
    triple_diff;
    triple_same;
    triple_ordered;
    triple_ordered_rev;
    quad_diff;
    quad_same;
    quad_ordered;
    quad_ordered_rev;
    test_tup2;
    test_tup3;
    test_tup4;
    test_tup5;
    test_tup6;
    test_tup7;
    test_tup8;
    test_tup9;
    bind_pair_ordered;
    bind_pair_list_size;
    lists_are_empty_issue_64;
    list_shorter_10;
    list_shorter_432;
    list_shorter_4332;
    (*list_equal_dupl;*)
    list_unique_elems;
    int_option_are_none;
    int_option_are_some_100_or_more;
    int_string_result_are_ok;
    int_string_result_are_error;
    tree_contains_only_42;
    test_gen_no_shrink;
  ]
end

(* tests function generator and shrinker *)
module Function = struct
  open QCheck

  let fail_pred_map_commute_int =
    Test.make ~name:"fail_pred_map_commute_int" ~count:100 ~long_factor:100
      (triple
         (list_small nat_small)
         (fun1 Observable.int int)
         (fun1 Observable.int bool))
      (fun (l,Fun (_,f),Fun (_,p)) ->
         List.filter p (List.map f l) = List.map f (List.filter p l))

  let fail_pred_map_commute_int32 =
    Test.make ~name:"fail_pred_map_commute_int32" ~count:100 ~long_factor:100
      (triple
         (list_small int32)
         (fun1 Observable.int32 int32)
         (fun1 Observable.int32 bool))
      (fun (l,Fun (_,f),Fun (_,p)) ->
         List.filter p (List.map f l) = List.map f (List.filter p l))

  let fail_pred_map_commute_int64 =
    Test.make ~name:"fail_pred_map_commute_int64" ~count:100 ~long_factor:100
      (triple
         (list_small int64)
         (fun1 Observable.int64 int64)
         (fun1 Observable.int64 bool))
      (fun (l,Fun (_,f),Fun (_,p)) ->
         List.filter p (List.map f l) = List.map f (List.filter p l))

  let fail_pred_strings =
    Test.make ~name:"fail_pred_strings" ~count:100
      (fun1 Observable.string bool)
      (fun (Fun (_,p)) -> not (p "some random string") || p "some other string")

  let int_gen = nat_small (* int *)

  (* Another example (false) property *)
  let prop_foldleft_foldright =
    Test.make ~name:"fold_left fold_right" ~count:1000 ~long_factor:20
      (triple
         int_gen
         (list int_gen)
         (fun2 Observable.int Observable.int int_gen))
      (fun (z,xs,f) ->
         let l1 = List.fold_right (Fn.apply f) xs z in
         let l2 = List.fold_left (Fn.apply f) z xs in
         if l1=l2 then true
         else Test.fail_reportf "l=%s, fold_left=%s, fold_right=%s@."
             (Print.(list int) xs)
             (Print.int l1)
             (Print.int l2)
      )

  (* Another example (false) property *)
  let prop_foldleft_foldright_uncurry =
    Test.make ~name:"fold_left fold_right uncurried" ~count:1000 ~long_factor:20
      (triple
         (fun1 Observable.(pair int int) int_gen)
         int_gen
         (list int_gen))
      (fun (f,z,xs) ->
         List.fold_right (fun x y -> Fn.apply f (x,y)) xs z =
         List.fold_left (fun x y -> Fn.apply f (x,y)) z xs)

  (* Same as the above (false) property, but generating+shrinking functions last *)
  let prop_foldleft_foldright_uncurry_funlast =
    Test.make ~name:"fold_left fold_right uncurried fun last" ~count:1000 ~long_factor:20
      (triple
         int_gen
         (list int_gen)
         (fun1 Observable.(pair int int) int_gen))
      (fun (z,xs,f) ->
         List.fold_right (fun x y -> Fn.apply f (x,y)) xs z =
         List.fold_left (fun x y -> Fn.apply f (x,y)) z xs)

  (* test from issue #64 *)
  let fold_left_test =
    Test.make ~name:"fold_left test, fun first"
      (quad  (* string -> int -> string *)
         (fun2 Observable.string Observable.int string_small)
         string_small
         (list nat_small)
         (list nat_small))
      (fun (f,acc,is,js) ->
         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_int;
    fail_pred_map_commute_int32;
    fail_pred_map_commute_int64;
    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 *)
module FindExample = struct
  open QCheck

  let find_ex =
    Test.make ~name:"find_example" (2--50)
      (fun n ->
         let st = Random.State.make [| 0 |] in
         let f m = n < m && m < 2 * n in
         try
           let m = find_example_gen ~rand:st ~count:100_000 ~f Gen.(0 -- 1000) in
           f m
         with No_example_found _ -> false)

  let find_ex_uncaught_issue_99_1_fail =
    let rs = make (find_example ~count:10 ~f:(fun _ -> false) Gen.int) in
    Test.make ~name:"FAIL_#99_1" rs (fun _ -> true)

  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 *)
module Stats = struct
  open QCheck

  let bool_dist =
    Test.make ~name:"bool dist" ~count:500_000 (set_collect Bool.to_string bool) (fun _ -> true)

  let char_dist_tests =
    [
      Test.make ~name:"char code dist"           ~count:500_000 (add_stat ("char code", Char.code) char)                 (fun _ -> true);
      Test.make ~name:"char_range code dist"     ~count:500_000 (add_stat ("char code", Char.code) (char_range 'A' 'Z')) (fun _ -> true);
      Test.make ~name:"char_printable code dist" ~count:500_000 (add_stat ("char code", Char.code) char_printable)       (fun _ -> true);
      Test.make ~name:"char_numeral code dist"   ~count:500_000 (add_stat ("char code", Char.code) char_numeral)         (fun _ -> true);
    ]

  let bytes_len_tests =
    let len = ("len",Bytes.length) in
    [
      Test.make ~name:"bytes_size len dist"      ~count:5_000 (add_stat len (bytes_size (Gen.int_range 5 10))) (fun _ -> true);
      Test.make ~name:"bytes len dist"           ~count:5_000 (add_stat len bytes)                             (fun _ -> true);
      Test.make ~name:"bytes_of len dist"        ~count:5_000 (add_stat len (bytes_of (Gen.return 'a')))       (fun _ -> true);
      Test.make ~name:"bytes_small len dist"     ~count:5_000 (add_stat len bytes_small)                       (fun _ -> true);
    ]

  let string_len_tests =
    let len = ("len",String.length) in
    [
      Test.make ~name:"string_size len dist"      ~count:5_000 (add_stat len (string_size (Gen.int_range 5 10))) (fun _ -> true);
      Test.make ~name:"string len dist"           ~count:5_000 (add_stat len string)                             (fun _ -> true);
      Test.make ~name:"string_of len dist"        ~count:5_000 (add_stat len (string_of (Gen.return 'a')))       (fun _ -> true);
      Test.make ~name:"string_printable len dist" ~count:5_000 (add_stat len string_printable)                   (fun _ -> true);
      Test.make ~name:"string_small len dist"     ~count:5_000 (add_stat len string_small)                       (fun _ -> true);
    ]

  let pair_dist =
    Test.make ~name:"pair dist" ~count:500_000
      (add_stat ("pair sum", (fun (i,j) -> i+j))
         (pair (int_bound 100) (int_bound 100))) (fun _ -> true)

  let triple_dist =
    Test.make ~name:"triple dist" ~count:500_000
      (add_stat ("triple sum", (fun (i,j,k) -> i+j+k))
         (triple (int_bound 100) (int_bound 100) (int_bound 100))) (fun _ -> true)

  let quad_dist =
    Test.make ~name:"quad dist" ~count:500_000
      (add_stat ("quad sum", (fun (h,i,j,k) -> h+i+j+k))
         (quad (int_bound 100) (int_bound 100) (int_bound 100) (int_bound 100))) (fun _ -> true)

  let bind_dist =
    Test.make ~name:"bind dist" ~count:1_000_000
      (make ~stats:[("ordered pair difference", (fun (i,j) -> j-i));("ordered pair sum", (fun (i,j) -> i+j))]
         Gen.(int_bound 100 >>= fun j -> int_bound j >>= fun i -> return (i,j))) (fun _ -> true)

  let option_dist =
    Test.make ~name:"option dist" ~count:10_000
      (set_collect (function None -> "None" | Some _ -> "Some _") (option int)) (fun _ -> true)

  let result_dist =
    Test.make ~name:"result dist" ~count:10_000
      (set_collect (function Ok _ -> "Ok _" | Error _ -> "Error _") (result int string)) (fun _ -> true)

  let list_len_tests =
    let len = ("len",List.length) in
    [ (* test from issue #30 *)
      Test.make ~name:"list len dist"        ~count:5_000 (add_stat len (list int))                           (fun _ -> true);
      Test.make ~name:"list_small len dist"  ~count:5_000 (add_stat len (list_small int))                     (fun _ -> true);
      Test.make ~name:"list_size len dist"   ~count:5_000 (add_stat len (list_size (Gen.int_range 5 10) int)) (fun _ -> true);
    ]

  let array_len_tests =
    let len = ("len",Array.length) in
    [
      Test.make ~name:"array len dist"        ~count:5_000 (add_stat len (array int))                           (fun _ -> true);
      Test.make ~name:"array_small len dist"  ~count:5_000 (add_stat len (array_small int))                     (fun _ -> true);
      Test.make ~name:"array_size len dist"   ~count:5_000 (add_stat len (array_size (Gen.int_range 5 10) int)) (fun _ -> true);
    ]

  let int_dist_tests =
    let dist = ("dist",fun x -> x) in
    [ (* test from issue #40 *)
      Test.make ~name:"int_stats_neg"                  ~count:5000   (add_stat dist int_small)                        (fun _ -> true);
      (* distribution tests from PR #45 *)
      Test.make ~name:"int dist"                       ~count:100000 (add_stat dist int)                              (fun _ -> true);
      Test.make ~name:"int_bound 1000 dist"            ~count:10000  (add_stat dist (int_bound 1000))                 (fun _ -> true);
      Test.make ~name:"int_range (-43643) 435434 dist" ~count:1000   (add_stat dist (int_range (-43643) 435434))      (fun _ -> true);
      Test.make ~name:"int_range (-40000) 40000 dist"  ~count:1000   (add_stat dist (int_range (-40000) 40000))       (fun _ -> true);
      Test.make ~name:"int_range (-4) 4 dist"          ~count:1000   (add_stat dist (int_range (-4) 4))               (fun _ -> true);
      Test.make ~name:"int_range (-4) 17 dist"         ~count:1000   (add_stat dist (int_range (-4) 17))              (fun _ -> true);
      Test.make ~name:"int_small dist"                 ~count:1000   (add_stat dist int_small)                        (fun _ -> true);
      Test.make ~name:"int_small_corners dist"         ~count:1000   (add_stat dist (int_small_corners ()))           (fun _ -> true);
      Test.make ~name:"int_neg dist"                   ~count:10000  (add_stat dist int_neg)                          (fun _ -> true);
      Test.make ~name:"int_pos dist"                   ~count:10000  (add_stat dist int_pos)                          (fun _ -> true);
      Test.make ~name:"oneof_list int dist"            ~count:1000   (add_stat dist (oneof_list[min_int;-1;0;1;max_int])) (fun _ -> true);
      Test.make ~name:"nat dist"                       ~count:1000   (add_stat dist nat)                              (fun _ -> true);
      Test.make ~name:"nat_small dist"                 ~count:1000   (add_stat dist nat_small)                        (fun _ -> true);
    ]

  let int_32_64_dist_tests =
    let add_stat32 shift arb = add_stat ("dist",fun i -> Int32.(to_int (logand 0xffffl (shift i)))) arb in
    let add_stat64 shift arb = add_stat ("dist",fun i -> Int64.(to_int (logand 0xffffL (shift i)))) arb in
    [ (* stats are int-based, so for these to work for 31-bit ints, consider blocks of 16 bits *)
      Test.make ~name:"int32 lower dist"     ~count:10000 (add_stat32 (fun i -> i) int32)                              (fun _ -> true);
      Test.make ~name:"int32 upper dist"     ~count:10000 (add_stat32 (fun i -> Int32.shift_right_logical i 16) int32) (fun _ -> true);
      Test.make ~name:"int64 lower dist"     ~count:10000 (add_stat64 (fun i -> i) int64)                              (fun _ -> true);
      Test.make ~name:"int64 lower-mid dist" ~count:10000 (add_stat64 (fun i -> Int64.shift_right i 16) int64)         (fun _ -> true);
      Test.make ~name:"int64 upper-mid dist" ~count:10000 (add_stat64 (fun i -> Int64.shift_right i 32) int64)         (fun _ -> true);
      Test.make ~name:"int64 upper dist"     ~count:10000 (add_stat64 (fun i -> Int64.shift_right_logical i 48) int64) (fun _ -> true);
    ]

  let float_exp_tests =
    let float_dist = ("dist",int_of_float) in
    [ Test.make ~name:"float_exp 10. dist" ~count:5_000 (add_stat float_dist (float_exp 10.)) (fun _ -> true);
      Test.make ~name:"float_exp -10. dist" ~count:5_000 (add_stat float_dist (float_exp (-10.))) (fun _ -> true);
    ]

  let float_tests = (* Float.frexp nan (and infinity) is undefined and may return a 32766 exponent on Alpine *)
    let float_expon_dist  = ("exponent",    fun f -> if Float.(is_nan f || is_infinite f) then 0 else snd (Float.frexp f)) in
    let float_signif_dist = ("significant", fun f -> if Float.(is_nan f || is_infinite f) (* int_of_float is undefined on nan and infinity *)
                                                     then 0 else let s = fst (Float.frexp f) in int_of_float (s *. 1000000.)) in
    let float_fpclass f = match Float.classify_float f with
      | FP_normal    -> "FP_normal"
      | FP_subnormal -> "FP_subnormal"
      | FP_zero      -> "FP_zero"
      | FP_infinite  -> "FP_infinite"
      | FP_nan       -> "FP_nan" in
    [ Test.make ~name:"float exponent"    ~count:5000 (add_stat float_expon_dist float) (fun _ -> true);
      Test.make ~name:"float significant" ~count:5000 (add_stat float_signif_dist float) (fun _ -> true);
      Test.make ~name:"float classify"    ~count:5000 (set_collect float_fpclass float) (fun _ -> true);
    ]

  let tree_depth_test =
    let depth = ("depth", IntTree.depth) in
    Test.make ~name:"tree's depth" ~count:1000 (add_stat depth (make IntTree.gen_tree)) (fun _ -> true)

  let range_subset_test =
    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 int_dist_empty_bucket =
    Test.make ~name:"int_dist_empty_bucket" ~count:1_000
      (add_stat ("dist",fun x -> x) (oneof [int_small_corners ();int])) (fun _ -> true)

  let tests =
    [ bool_dist; ]
    @ char_dist_tests
    @ [tree_depth_test;
       range_subset_test;] (* Feature (and tests) only available in QCheck for now, not QCheck2 *)
    @ bytes_len_tests
    @ string_len_tests
    @ [pair_dist;
       triple_dist;
       quad_dist;
       bind_dist;
       option_dist;
       result_dist;]
    @ list_len_tests
    @ array_len_tests
    @ int_dist_tests
    @ int_32_64_dist_tests
    @ float_exp_tests
    @ float_tests
end