From 18581fa00ca44f632b826e44c99e4dab7bdd2453 Mon Sep 17 00:00:00 2001
From: Valentin Chaboche <valentin.chaboche@nomadic-labs.com>
Date: Fri, 6 May 2022 11:34:26 +0200
Subject: [PATCH] QCheck2.Gen: enforce naming consistency for type int
---
src/core/QCheck2.ml | 266 +++++++++++++------------
src/core/QCheck2.mli | 168 +++++++++-------
test/core/QCheck2_expect_test.expected | 48 ++---
test/core/QCheck2_tests.ml | 114 +++++------
4 files changed, 323 insertions(+), 273 deletions(-)
diff --git a/src/core/QCheck2.ml b/src/core/QCheck2.ml
index 2e3c5da2..c671aa4a 100644
--- a/src/core/QCheck2.ml
+++ b/src/core/QCheck2.ml
@@ -282,13 +282,27 @@ module Gen = struct
else if origin > high then invalid_arg Format.(asprintf "%s: origin value %a is greater than high value %a" loc pp origin pp high)
else origin
- let small_nat : int t = fun st ->
- let p = RS.float st 1. in
- let x = if p < 0.75 then RS.int st 10 else RS.int st 100 in
- let shrink a = fun () -> Shrink.int_towards 0 a () in
- Tree.make_primitive shrink x
+ let bool : bool t = fun st ->
+ let false_gen = Tree.pure false in
+ if RS.bool st
+ then Tree.Tree (true, Seq.return false_gen)
+ else false_gen
+
+ let pick_origin_within_range ~low ~high ~goal =
+ if low > goal then low
+ else if high < goal then high
+ else goal
+
+ (* corner cases *)
+
+ let graft_corners (gen : 'a t) (corners : 'a list) () : 'a t =
+ let cors = ref corners in fun st ->
+ match !cors with
+ | [] -> gen st
+ | e::l -> cors := l; Tree.pure e
+
+ (** {2 Integer generators} *)
- (** Natural number generator *)
let nat : int t = fun st ->
let p = RS.float st 1. in
let x =
@@ -300,7 +314,13 @@ module Gen = struct
let shrink a = fun () -> Shrink.int_towards 0 a () in
Tree.make_primitive shrink x
- let big_nat : int t = fun st ->
+ let nat_small : int t = fun st ->
+ let p = RS.float st 1. in
+ let x = if p < 0.75 then RS.int st 10 else RS.int st 100 in
+ let shrink a = fun () -> Shrink.int_towards 0 a () in
+ Tree.make_primitive shrink x
+
+ let nat_big : int t = fun st ->
let p = RS.float st 1. in
if p < 0.75
then nat st
@@ -308,78 +328,9 @@ module Gen = struct
let shrink a = fun () -> Shrink.int_towards 0 a () in
Tree.make_primitive shrink (RS.int st 1_000_000)
- let unit : unit t = fun _st -> Tree.pure ()
-
- let bool : bool t = fun st ->
- let false_gen = Tree.pure false in
- if RS.bool st
- then Tree.Tree (true, Seq.return false_gen)
- else false_gen
-
- let float : float t = fun st ->
- let x = exp (RS.float st 15. *. (if RS.bool st then 1. else -1.))
- *. (if RS.bool st then 1. else -1.)
- in
- let shrink a = fun () -> Shrink.float_towards 0. a () in
- Tree.make_primitive shrink x
-
- let pfloat : float t = float >|= abs_float
-
- let nfloat : float t = pfloat >|= Float.neg
-
- let float_bound_inclusive ?(origin : float = 0.) (bound : float) : float t = fun st ->
- let (low, high) = Float.min_max_num 0. bound in
- let shrink a = fun () ->
- let origin = parse_origin "Gen.float_bound_inclusive" Format.pp_print_float ~origin ~low ~high in
- Shrink.float_towards origin a ()
- in
- let x = RS.float st bound in
- Tree.make_primitive shrink x
-
- let float_bound_exclusive ?(origin : float = 0.) (bound : float) : float t =
- if bound = 0. then invalid_arg "Gen.float_bound_exclusive";
- fun st ->
- let (low, high) = Float.min_max_num 0. bound in
- let shrink a = fun () ->
- let origin = parse_origin "Gen.float_bound_exclusive" Format.pp_print_float ~origin ~low ~high in
- Shrink.float_towards origin a ()
- in
- let bound =
- if bound > 0.
- then bound -. epsilon_float
- else bound +. epsilon_float
- in
- let x = RS.float st bound in
- Tree.make_primitive shrink x
+ let nat_corners_list = [0; 1; 2; max_int]
- let pick_origin_within_range ~low ~high ~goal =
- if low > goal then low
- else if high < goal then high
- else goal
-
- let float_range ?(origin : float option) (low : float) (high : float) : float t =
- if high < low then invalid_arg "Gen.float_range: high < low"
- else if high -. low > max_float then invalid_arg "Gen.float_range: high -. low > max_float";
- let origin = parse_origin "Gen.float_range" Format.pp_print_float
- ~origin:(Option.value ~default:(pick_origin_within_range ~low ~high ~goal:0.) origin)
- ~low
- ~high in
- (float_bound_inclusive ~origin (high -. low))
- >|= (fun x -> low +. x)
-
- let (--.) low high = float_range ?origin:None low high
-
- let neg_int : int t = nat >|= Int.neg
-
- (** [option gen] shrinks towards [None] then towards shrinks of [gen]. *)
- let option ?(ratio : float = 0.85) (gen : 'a t) : 'a option t = fun st ->
- let p = RS.float st 1. in
- if p < (1. -. ratio)
- then Tree.pure None
- else Tree.opt (gen st)
-
- (** [opt] is an alias of {!val:option} for backward compatibility. *)
- let opt = option
+ let nat_corners = graft_corners nat nat_corners_list
(* Uniform positive random int generator.
@@ -403,7 +354,7 @@ module Gen = struct
Technically this function is a special case of [random_binary_string] where the size is
{!Sys.int_size}.
*)
- let pint_raw : RS.t -> int =
+ let int_pos_raw : RS.t -> int =
if Sys.word_size = 32
then fun st -> RS.bits st
else (* word size = 64 *)
@@ -418,36 +369,39 @@ module Gen = struct
let right = RS.bits st in
left lor middle lor right
- let pint ?(origin : int = 0) : int t = fun st ->
- let x = pint_raw st in
+ let int_pos ?(origin : int = 0) : int t = fun st ->
+ let x = int_pos_raw st in
let shrink a = fun () ->
- let origin = parse_origin "Gen.pint" Format.pp_print_int ~origin ~low:0 ~high:max_int in
+ let origin = parse_origin "Gen.int_pos" Format.pp_print_int ~origin ~low:0 ~high:max_int in
Shrink.int_towards origin a ()
in
Tree.make_primitive shrink x
- let number_towards = Shrink.number_towards
+ let int : int t =
+ bool >>= fun b ->
+ if b
+ then int_pos ~origin:0 >|= (fun n -> - n - 1)
+ else int_pos ~origin:0
- let int_towards = Shrink.int_towards
+ let int_neg : int t = nat >|= Int.neg
- let int64_towards = Shrink.int64_towards
+ let int_small : int t = fun st ->
+ if RS.bool st
+ then nat_small st
+ else (nat_small >|= Int.neg) st
- let int32_towards = Shrink.int32_towards
+ let int_big = nat >|= (-) Int.max_int
- let float_towards = Shrink.float_towards
+ let int_corners_list = nat_corners_list @ [-1; -2; min_int]
- let int : int t =
- bool >>= fun b ->
- if b
- then pint ~origin:0 >|= (fun n -> - n - 1)
- else pint ~origin:0
+ let int_corners () : int t = graft_corners nat int_corners_list ()
- let int_bound (n : int) : int t =
- if n < 0 then invalid_arg "Gen.int_bound";
+ let int_pos_bound (n : int) : int t =
+ if n < 0 then invalid_arg "Gen.int_pos_bound";
fun st ->
if n <= (1 lsl 30) - 2
then Tree.make_primitive (fun a () -> Shrink.int_towards 0 a ()) (RS.int st (n + 1))
- else Tree.map (fun r -> r mod (n + 1)) (pint st)
+ else Tree.map (fun r -> r mod (n + 1)) (int_pos st)
(** To support ranges wider than [Int.max_int], the general idea is to find the center,
and generate a random half-difference number as well as whether we add or
@@ -457,7 +411,7 @@ module Gen = struct
fun st ->
let Tree.Tree(n, _shrinks) = if low >= 0 || high < 0 then (
(* range smaller than max_int *)
- Tree.map (fun n -> low + n) (int_bound (high - low) st)
+ Tree.map (fun n -> low + n) (int_pos_bound (high - low) st)
) else (
(* range potentially bigger than max_int: we split on 0 and
choose the interval with regard to their size ratio *)
@@ -465,8 +419,8 @@ module Gen = struct
let f_high = float_of_int high in
let ratio = (-.f_low) /. (1. +. f_high -. f_low) in
if RS.float st 1. <= ratio
- then Tree.map (fun n -> -n - 1) (int_bound (- (low + 1)) st)
- else int_bound high st
+ then Tree.map (fun n -> -n - 1) (int_pos_bound (- (low + 1)) st)
+ else int_pos_bound high st
) in
let shrink a = fun () ->
let origin = match origin with
@@ -483,6 +437,92 @@ module Gen = struct
let (--) low high = int_range ?origin:None low high
+ (** {2 Deprecated integer generators} *)
+
+ let small_nat = nat_small
+
+ let big_nat = nat_big
+
+ let neg_int = int_neg
+
+ let small_signed_int = int_small
+
+ let small_int_corners = nat_corners
+
+ let pint = int_pos
+
+ let int_bound = int_pos_bound
+
+ let unit : unit t = fun _st -> Tree.pure ()
+
+ let float : float t = fun st ->
+ let x = exp (RS.float st 15. *. (if RS.bool st then 1. else -1.))
+ *. (if RS.bool st then 1. else -1.)
+ in
+ let shrink a = fun () -> Shrink.float_towards 0. a () in
+ Tree.make_primitive shrink x
+
+ let pfloat : float t = float >|= abs_float
+
+ let nfloat : float t = pfloat >|= Float.neg
+
+ let float_bound_inclusive ?(origin : float = 0.) (bound : float) : float t = fun st ->
+ let (low, high) = Float.min_max_num 0. bound in
+ let shrink a = fun () ->
+ let origin = parse_origin "Gen.float_bound_inclusive" Format.pp_print_float ~origin ~low ~high in
+ Shrink.float_towards origin a ()
+ in
+ let x = RS.float st bound in
+ Tree.make_primitive shrink x
+
+ let float_bound_exclusive ?(origin : float = 0.) (bound : float) : float t =
+ if bound = 0. then invalid_arg "Gen.float_bound_exclusive";
+ fun st ->
+ let (low, high) = Float.min_max_num 0. bound in
+ let shrink a = fun () ->
+ let origin = parse_origin "Gen.float_bound_exclusive" Format.pp_print_float ~origin ~low ~high in
+ Shrink.float_towards origin a ()
+ in
+ let bound =
+ if bound > 0.
+ then bound -. epsilon_float
+ else bound +. epsilon_float
+ in
+ let x = RS.float st bound in
+ Tree.make_primitive shrink x
+
+ let float_range ?(origin : float option) (low : float) (high : float) : float t =
+ if high < low then invalid_arg "Gen.float_range: high < low"
+ else if high -. low > max_float then invalid_arg "Gen.float_range: high -. low > max_float";
+ let origin = parse_origin "Gen.float_range" Format.pp_print_float
+ ~origin:(Option.value ~default:(pick_origin_within_range ~low ~high ~goal:0.) origin)
+ ~low
+ ~high in
+ (float_bound_inclusive ~origin (high -. low))
+ >|= (fun x -> low +. x)
+
+ let (--.) low high = float_range ?origin:None low high
+
+ (** [option gen] shrinks towards [None] then towards shrinks of [gen]. *)
+ let option ?(ratio : float = 0.85) (gen : 'a t) : 'a option t = fun st ->
+ let p = RS.float st 1. in
+ if p < (1. -. ratio)
+ then Tree.pure None
+ else Tree.opt (gen st)
+
+ (** [opt] is an alias of {!val:option} for backward compatibility. *)
+ let opt = option
+
+ let number_towards = Shrink.number_towards
+
+ let int_towards = Shrink.int_towards
+
+ let int64_towards = Shrink.int64_towards
+
+ let int32_towards = Shrink.int32_towards
+
+ let float_towards = Shrink.float_towards
+
let oneof (l : 'a t list) : 'a t =
int_range 0 (List.length l - 1) >>= List.nth l
@@ -492,21 +532,12 @@ module Gen = struct
let oneofa (a : 'a array) : 'a t =
int_range 0 (Array.length a - 1) >|= Array.get a
- (* NOTE: we keep this alias to not break code that uses [small_int]
- for sizes of strings, arrays, etc. *)
- let small_int = small_nat
-
- let small_signed_int : int t = fun st ->
- if RS.bool st
- then small_nat st
- else (small_nat >|= Int.neg) st
-
(** Shrink towards the first element of the list *)
let frequency (l : (int * 'a t) list) : 'a t =
if l = [] then failwith "QCheck2.frequency called with an empty list";
let sums = sum_int (List.map fst l) in
if sums < 1 then failwith "QCheck2.frequency called with weight sum < 1";
- int_bound (sums - 1)
+ int_pos_bound (sums - 1)
>>= fun i ->
let rec aux acc = function
| ((x, g) :: xs) -> if i < acc + x then g else aux (acc + x) xs
@@ -704,27 +735,14 @@ module Gen = struct
let string_printable = string_size ~gen:printable nat
- let small_string ?gen st = string_size ?gen small_nat st
+ let small_string ?gen st = string_size ?gen nat_small st
- let small_list gen = list_size small_nat gen
+ let small_list gen = list_size nat_small gen
- let small_array gen = array_size small_nat gen
+ let small_array gen = array_size nat_small gen
let join (gen : 'a t t) : 'a t = gen >>= Fun.id
- (* corner cases *)
-
- let graft_corners (gen : 'a t) (corners : 'a list) () : 'a t =
- let cors = ref corners in fun st ->
- match !cors with [] -> gen st
- | e::l -> cors := l; Tree.pure e
-
- let int_pos_corners = [0; 1; 2; max_int]
-
- let int_corners = int_pos_corners @ [min_int]
-
- let small_int_corners () : int t = graft_corners nat int_pos_corners ()
-
(* sized, fix *)
let sized_size (size : int t) (gen : 'a sized) : 'a t =
diff --git a/src/core/QCheck2.mli b/src/core/QCheck2.mli
index ec54ca16..9e6c2f4f 100644
--- a/src/core/QCheck2.mli
+++ b/src/core/QCheck2.mli
@@ -59,7 +59,7 @@ content will appear. *)
~name:"All lists are sorted"
~count:10_000
~print:Print.(list int)
- Gen.(list small_nat)
+ Gen.(list nat_small)
(fun l -> l = List.sort compare l));;
QCheck2.Test.check_exn test;;
@@ -155,71 +155,141 @@ module Gen : sig
Shrinks towards [false].
*)
- val int : int t
- (** Generates integers uniformly.
+ (** {2 Integer numbers generators} *)
- Shrinks towards [0].
- *)
+ (** {3. Natural} *)
- val pint : ?origin : int -> int t
- (** Generates non-strictly positive integers uniformly ([0] included).
+ val nat : int t
+ (** Generates natural numbers (< [10_000]).
- Shrinks towards [origin] if specified, otherwise towards [0]. *)
+ Non-uniform: smaller numbers are more likely than bigger numbers.
- val small_nat : int t
+ Shrinks towards [0].
+ *)
+
+ val nat_small : int t
(** Small positive integers (< [100], [0] included).
Non-uniform: smaller numbers are more likely than bigger numbers.
Shrinks towards [0].
- @since 0.5.1 *)
+ @since NEXT_RELEASE *)
- val nat : int t
- (** Generates natural numbers (< [10_000]).
+ val nat_big : int t
+ (** Generates natural numbers, possibly large (< [1_000_000]).
Non-uniform: smaller numbers are more likely than bigger numbers.
Shrinks towards [0].
+
+ @since NEXT_RELEASE *)
+
+ val nat_corners : unit -> int t
+ (** As {!nat}, but each newly created generator starts with a list of corner
+ cases before falling back on random generation.
+
+ @since NEXT_RELEASE
*)
- val big_nat : int t
- (** Generates natural numbers, possibly large (< [1_000_000]).
+ (** {3 Classic integers} *)
- Non-uniform: smaller numbers are more likely than bigger numbers.
+ val int : int t
+ (** Generates integers uniformly.
Shrinks towards [0].
+ *)
- @since 0.10 *)
-
- val neg_int : int t
+ val int_neg : int t
(** Generates non-strictly negative integers ([0] included).
Non-uniform: smaller numbers (in absolute value) are more likely than bigger numbers.
Shrinks towards [0].
+
+ @since NEXT_RELEASE
*)
- val small_int : int t
- (** Small UNSIGNED integers, for retrocompatibility.
+ val int_pos : ?origin : int -> int t
+ (** Generates non-strictly positive integers uniformly ([0] included).
- Shrinks towards [0].
+ Shrinks towards [origin] if specified, otherwise towards [0].
- @deprecated use {!small_nat}. *)
+ @since NEXT_RELEASE *)
- val small_signed_int : int t
- (** Small SIGNED integers, based on {!small_nat}.
+ val int_small : int t
+ (** Small SIGNED integers, based on {!nat_small}.
Non-uniform: smaller numbers (in absolute value) are more likely than bigger numbers.
Shrinks towards [0].
- @since 0.5.2 *)
+ @since NEXT_RELEASE *)
+
+ val int_big : int t
+ (** Big SIGNED integers, based on {!nat_small} substraced to [Int.max_int]
+
+ Shrinks towards [0].
+
+ @since NEXT_RELEASE *)
+
+ val int_corners : unit -> int t
+ (** As {!int}, but each newly created generator starts with a list of corner
+ cases before falling back on random generation.
+
+ @since NEXT_RELEASE
+ *)
+
+ val int_pos_bound : int -> int t
+ (** Uniform integer generator producing integers within [0..bound].
+
+ Shrinks towards [0].
+
+ @raise Invalid_argument if the argument is negative. *)
+
+ val int_range : ?origin:int -> int -> int -> int t
+ (** [int_range ?origin low high] is an uniform integer generator producing integers within [low..high] (inclusive).
+
+ Shrinks towards [origin] if specified, otherwise towards [0] (but always stays within the range).
+
+ Examples:
+ - [int_range ~origin:6 (-5) 15] will shrink towards [6]
+ - [int_range (-5) 15] will shrink towards [0]
+ - [int_range 8 20] will shrink towards [8] (closest to [0] within range)
+ - [int_range (-20) (-8)] will shrink towards [-8] (closest to [0] within range)
+
+ @raise Invalid_argument if any of the following holds:
+ - [low > high]
+ - [origin < low]
+ - [origin > high]
+ *)
+
+ val (--) : int -> int -> int t
+ (** [a -- b] is an alias for [int_range a b]. See {!int_range} for more information.
+ *)
+
+ (** {3 Deprecated integer generators} *)
+
+ val small_nat : int t
+ (** @deprecated use {!nat_small} *)
+
+ val big_nat : int t
+ (** @deprecated use {!nat_big} *)
+
+ val neg_int : int t
+ (** @deprecated use {!int_neg} *)
+
+ val small_signed_int : int t
+ (** @deprecated use {!int_small} *)
val small_int_corners : unit -> int t
- (** As {!small_int}, but each newly created generator starts with
- a list of corner cases before falling back on random generation. *)
+ (** @deprecated use {!nat_corners} *)
+
+ val pint : ?origin : int -> int t
+ (** @deprecated use {!int_pos} *)
+ val int_bound : int -> int t
+ (** @deprecated use {!int_pos_bound} *)
val int32 : int32 t
(** Generates uniform {!int32} values.
@@ -320,7 +390,7 @@ module Gen : sig
@since 0.11 *)
val small_string : ?gen:char t -> string t
- (** Builds a string generator, length is {!small_nat}.
+ (** Builds a string generator, length is {!nat_small}.
Accepts an optional character generator (the default is {!char}).
Shrinks on the number of characters first, then on the characters.
@@ -375,34 +445,6 @@ module Gen : sig
(** {3 Ranges} *)
- val int_bound : int -> int t
- (** Uniform integer generator producing integers within [0..bound].
-
- Shrinks towards [0].
-
- @raise Invalid_argument if the argument is negative. *)
-
- val int_range : ?origin:int -> int -> int -> int t
- (** [int_range ?origin low high] is an uniform integer generator producing integers within [low..high] (inclusive).
-
- Shrinks towards [origin] if specified, otherwise towards [0] (but always stays within the range).
-
- Examples:
- - [int_range ~origin:6 (-5) 15] will shrink towards [6]
- - [int_range (-5) 15] will shrink towards [0]
- - [int_range 8 20] will shrink towards [8] (closest to [0] within range)
- - [int_range (-20) (-8)] will shrink towards [-8] (closest to [0] within range)
-
- @raise Invalid_argument if any of the following holds:
- - [low > high]
- - [origin < low]
- - [origin > high]
- *)
-
- val (--) : int -> int -> int t
- (** [a -- b] is an alias for [int_range a b]. See {!int_range} for more information.
- *)
-
val float_bound_inclusive : ?origin : float -> float -> float t
(** [float_bound_inclusive ?origin bound] returns a random floating-point number between [0.] and
[bound] (inclusive). If [bound] is negative, the result is negative or zero. If
@@ -533,16 +575,6 @@ module Gen : sig
@since 0.6 *)
- val int_pos_corners : int list
- (** Non-negative corner cases for int.
-
- @since 0.6 *)
-
- val int_corners : int list
- (** All corner cases for int.
-
- @since 0.6 *)
-
(** {3 Lists, arrays and options} *)
val list : 'a t -> 'a list t
@@ -552,7 +584,7 @@ module Gen : sig
*)
val small_list : 'a t -> 'a list t
- (** Generates lists of small size (see {!small_nat}).
+ (** Generates lists of small size (see {!nat_small}).
Shrinks on the number of elements first, then on elements.
@@ -583,7 +615,7 @@ module Gen : sig
*)
val small_array : 'a t -> 'a array t
- (** Generates arrays of small size (see {!small_nat}).
+ (** Generates arrays of small size (see {!nat_small}).
Shrinks on the number of elements first, then on elements.
diff --git a/test/core/QCheck2_expect_test.expected b/test/core/QCheck2_expect_test.expected
index bf66c643..7ef7c4c8 100644
--- a/test/core/QCheck2_expect_test.expected
+++ b/test/core/QCheck2_expect_test.expected
@@ -257,7 +257,7 @@ NOTE: it is likely that the precondition is too strong, or that the generator is
Test FAIL_bad_gen failed:
ERROR: uncaught exception in generator for test FAIL_bad_gen after 100 steps:
-Exception: Invalid_argument("Gen.int_bound")
+Exception: Invalid_argument("Gen.int_pos_bound")
Backtrace:
--- Failure --------------------------------------------------------------------
@@ -1035,7 +1035,7 @@ stats dist:
81.. 90: # 60
91..100: # 66
-+++ Stats for small_signed_int dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++ Stats for int_small dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
stats dist:
num: 1000, avg: 0.90, stddev: 28.23, median 0, min -99, max 99
@@ -1060,7 +1060,7 @@ stats dist:
81.. 90: # 16
91..100: # 10
-+++ Stats for small_nat dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++++ Stats for nat_small dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
stats dist:
num: 1000, avg: 15.11, stddev: 23.27, median 6, min 0, max 99
@@ -1256,26 +1256,26 @@ random seed: 153870556
+++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
stats dist:
- num: 1000, avg: -55083208105414400.00, stddev: 1847115855773139200.00, median 9, min -4590718933436425025, max 4611686018427387903
- -4590718933436425025..-4130598685843234370: ## 26
- -4130598685843234369..-3670478438250043714: # 13
- -3670478438250043713..-3210358190656853058: ### 37
- -3210358190656853057..-2750237943063662402: ### 30
- -2750237943063662401..-2290117695470471746: ## 27
- -2290117695470471745..-1829997447877281090: ## 24
- -1829997447877281089..-1369877200284090434: ## 27
- -1369877200284090433.. -909756952690899778: ## 27
- -909756952690899777.. -449636705097709122: ## 21
- -449636705097709121.. 10483542495481534: ####################################################### 531
- 10483542495481535.. 470603790088672190: ## 21
- 470603790088672191.. 930724037681862846: ## 27
- 930724037681862847.. 1390844285275053502: ## 24
- 1390844285275053503.. 1850964532868244158: ## 25
- 1850964532868244159.. 2311084780461434814: ## 28
- 2311084780461434815.. 2771205028054625470: ## 23
- 2771205028054625471.. 3231325275647816126: ## 23
- 3231325275647816127.. 3691445523241006782: ## 25
- 3691445523241006783.. 4151565770834197438: # 17
- 4151565770834197439.. 4611686018427387903: ## 24
+ num: 1000, avg: -52249009531205656.00, stddev: 1861821285982728448.00, median 9, min -4611686018427387904, max 4611686018427387903
+ -4611686018427387904..-4150517416584649089: ### 26
+ -4150517416584649088..-3689348814741910273: # 14
+ -3689348814741910272..-3228180212899171457: #### 35
+ -3228180212899171456..-2767011611056432641: #### 31
+ -2767011611056432640..-2305843009213693825: ### 27
+ -2305843009213693824..-1844674407370955009: ### 25
+ -1844674407370955008..-1383505805528216193: ### 27
+ -1383505805528216192.. -922337203685477377: ### 26
+ -922337203685477376.. -461168601842738561: ## 21
+ -461168601842738560.. 255: ####################################################### 421
+ 256.. 461168601842739071: ################ 129
+ 461168601842739072.. 922337203685477887: ### 27
+ 922337203685477888.. 1383505805528216703: ### 23
+ 1383505805528216704.. 1844674407370955519: ### 27
+ 1844674407370955520.. 2305843009213694335: ### 28
+ 2305843009213694336.. 2767011611056433151: ### 23
+ 2767011611056433152.. 3228180212899171967: ## 22
+ 3228180212899171968.. 3689348814741910783: ### 25
+ 3689348814741910784.. 4150517416584649599: ## 18
+ 4150517416584649600.. 4611686018427387903: ### 25
================================================================================
success (ran 1 tests)
diff --git a/test/core/QCheck2_tests.ml b/test/core/QCheck2_tests.ml
index d3c960e2..429ff491 100644
--- a/test/core/QCheck2_tests.ml
+++ b/test/core/QCheck2_tests.ml
@@ -45,11 +45,11 @@ module Overall = struct
let passing =
Test.make ~name:"list_rev_is_involutive" ~count:100 ~long_factor:100
~print:Print.(list int)
- Gen.(list small_int) (fun l -> List.rev (List.rev l) = l)
+ Gen.(list nat_small) (fun l -> List.rev (List.rev l) = l)
let failing =
Test.make ~name:"should_fail_sort_id" ~count:10 ~print:Print.(list int)
- Gen.(small_list small_int) (fun l -> l = List.sort compare l)
+ Gen.(small_list nat_small) (fun l -> l = List.sort compare l)
exception Error
@@ -60,7 +60,7 @@ module Overall = struct
let collect =
Test.make ~name:"collect_results" ~count:100 ~long_factor:100
~print:Print.int ~collect:string_of_int
- (Gen.int_bound 4) (fun _ -> true)
+ (Gen.int_pos_bound 4) (fun _ -> true)
let stats =
Test.make ~name:"with_stats" ~count:100 ~long_factor:100 ~print:Print.int
@@ -68,11 +68,11 @@ module Overall = struct
"mod4", (fun i->i mod 4);
"num", (fun i->i);
]
- (Gen.int_bound 120) (fun _ -> true)
+ (Gen.int_pos_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)
+ Gen.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 ~print:Print.int
@@ -91,8 +91,8 @@ module Overall = struct
let bad_gen_fail =
Test.make ~name:"FAIL_bad_gen"
- 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 *)
+ Gen.(int >>= fun j -> int_pos_bound j >>= fun i -> return (i,j))
+ (fun (_i,_j) -> true) (* i may be negative, causing int_pos_bound to fail *)
let bad_shrinker_fail =
Test.make ~name:"FAIL_bad_shrinker"
@@ -112,7 +112,7 @@ module Overall = struct
let sleep_time = 0.175 in
let count = ref 0 in
Test.make ~count:10 ~name:"bad function reproducability"
- Gen.(triple small_int (fun1 Observable.int small_int) small_int)
+ Gen.(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 " ");
@@ -175,17 +175,17 @@ module Generator = struct
let pair_test =
Test.make ~name:"int pairs - commute over +" ~count:1000 ~print:Print.(pair int int)
- Gen.(pair small_nat small_nat) (fun (i,j) -> i+j = j+i)
+ Gen.(pair nat_small nat_small) (fun (i,j) -> i+j = j+i)
let triple_test =
Test.make ~name:"int triples - associative over +" ~count:1000
~print:Print.(triple int int int)
- Gen.(triple small_nat small_nat small_nat) (fun (i,j,k) -> i+(j+k) = (i+j)+k)
+ Gen.(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
~print:Print.(quad int int int int)
- Gen.(quad small_nat small_nat small_nat small_nat)
+ Gen.(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 =
@@ -244,13 +244,13 @@ module Generator = struct
let bind_test =
Test.make ~name:"bind test for ordered pairs" ~count:1000 ~print:Print.(pair int int)
- Gen.(small_nat >>= fun j -> int_bound j >>= fun i -> return (i,j))
+ Gen.(nat_small >>= fun j -> int_pos_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 ~print:Print.(pair int (list int))
- Gen.(int_bound 1000 >>= fun len ->
- list_size (return len) (int_bound 10) >>= fun xs -> return (len,xs))
+ Gen.(int_pos_bound 1000 >>= fun len ->
+ list_size (return len) (int_pos_bound 10) >>= fun xs -> return (len,xs))
(fun (len,xs) -> len = List.length xs)
let list_test =
@@ -261,13 +261,13 @@ module Generator = struct
let list_repeat_test =
Test.make ~name:"list_repeat has constant length" ~count:1000
~print:Print.(pair int (list unit))
- Gen.(small_nat >>= fun i -> list_repeat i unit >>= fun l -> return (i,l))
+ Gen.(nat_small >>= fun i -> list_repeat i unit >>= fun l -> return (i,l))
(fun (i,l) -> List.length l = i)
let array_repeat_test =
Test.make ~name:"array_repeat has constant length" ~count:1000
~print:Print.(pair int (array unit))
- Gen.(small_nat >>= fun i -> array_repeat i unit >>= fun l -> return (i,l))
+ Gen.(nat_small >>= fun i -> array_repeat i unit >>= fun l -> return (i,l))
(fun (i,l) -> Array.length l = i)
let passing_tree_rev =
@@ -311,7 +311,7 @@ module Shrink = struct
(* example from issue #59 *)
let test_fac_issue59 =
Test.make ~name:"test fac issue59"
- (Gen.make_primitive ~gen:(fun st -> Gen.generate1 ~rand:st (Gen.small_int_corners ())) ~shrink:(fun _ -> Seq.empty))
+ (Gen.make_primitive ~gen:(fun st -> Gen.generate1 ~rand:st (Gen.int_corners ())) ~shrink:(fun _ -> Seq.empty))
(fun n -> try (fac n) mod n = 0
with
(*| Stack_overflow -> false*)
@@ -319,7 +319,7 @@ module Shrink = struct
let big_bound_issue59 =
Test.make ~name:"big bound issue59" ~print:Print.int
- (Gen.small_int_corners()) (fun i -> i < 209609)
+ (Gen.int_corners()) (fun i -> i < 209609)
let long_shrink =
let listgen = Gen.(list_size (int_range 1000 10000) int) in
@@ -339,7 +339,7 @@ module Shrink = struct
(* test from issue #59 *)
let ints_smaller_209609 =
Test.make ~name:"ints < 209609" ~print:Print.int
- (Gen.small_int_corners()) (fun i -> i < 209609)
+ (Gen.int_corners()) (fun i -> i < 209609)
let nats_smaller_5001 =
Test.make ~name:"nat < 5001" ~count:1000 ~print:Print.int
@@ -373,7 +373,7 @@ module Shrink = struct
(* test from issue #167 *)
let pair_diff_issue_64 =
Test.make ~name:"pairs have different components" ~print:Print.(pair int int)
- Gen.(pair small_int small_int) (fun (i,j) -> i<>j)
+ Gen.(pair nat_small nat_small) (fun (i,j) -> i<>j)
let pair_same =
Test.make ~name:"pairs have same components" ~print:Print.(pair int int)
@@ -389,29 +389,29 @@ module Shrink = struct
let pair_ordered =
Test.make ~name:"pairs are ordered" ~print:Print.(pair int int)
- Gen.(pair (pint ~origin:0) (pint ~origin:0)) (fun (i,j) -> i<=j)
+ Gen.(pair (int_pos ~origin:0) (int_pos ~origin:0)) (fun (i,j) -> i<=j)
let pair_ordered_rev =
Test.make ~name:"pairs are ordered reversely" ~print:Print.(pair int int)
- Gen.(pair (pint ~origin:0) (pint ~origin:0)) (fun (i,j) -> i>=j)
+ Gen.(pair (int_pos ~origin:0) (int_pos ~origin:0)) (fun (i,j) -> i>=j)
let pair_sum_lt_128 =
Test.make ~name:"pairs sum to less than 128" ~print:Print.(pair int int)
- Gen.(pair (pint ~origin:0) (pint ~origin:0)) (fun (i,j) -> i+j<128)
+ Gen.(pair (int_pos ~origin:0) (int_pos ~origin:0)) (fun (i,j) -> i+j<128)
let pair_lists_rev_concat =
Test.make ~name:"pairs lists rev concat" ~print:Print.(pair (list int) (list int))
- Gen.(pair (list (pint ~origin:0)) (list (pint ~origin:0)))
+ Gen.(pair (list (int_pos ~origin:0)) (list (int_pos ~origin:0)))
(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" ~print:Print.(pair (list int) (list int))
- Gen.(pair (list small_nat) (list small_nat))
+ Gen.(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" ~print:Print.(triple int int int)
- Gen.(triple small_int small_int small_int) (fun (i,j,k) -> i<>j && j<>k)
+ Gen.(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" ~print:Print.(triple int int int)
@@ -427,7 +427,7 @@ module Shrink = struct
let quad_diff =
Test.make ~name:"quadruples have pair-wise different components" ~print:Print.(quad int int int int)
- Gen.(quad small_int small_int small_int small_int) (fun (h,i,j,k) -> h<>i && i<>j && j<>k)
+ Gen.(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" ~print:Print.(quad int int int int)
@@ -445,67 +445,67 @@ module Shrink = struct
Test.make
~print:Print.(tup2 int int)
~name:"forall (a, b) in nat: a < b"
- Gen.(tup2 small_int small_int)
+ Gen.(tup2 nat_small nat_small)
(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)
+ Gen.(tup3 nat_small nat_small nat_small)
(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)
+ Gen.(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
~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)
+ Gen.(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
~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)
+ Gen.(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
~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)
+ Gen.(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
~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)
+ Gen.(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
~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)
+ Gen.(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" ~print:Print.(pair int int)
- Gen.(pint ~origin:0 >>= fun j -> int_bound j >>= fun i -> return (i,j))
+ Gen.(int_pos ~origin:0 >>= fun j -> int_pos_bound j >>= fun i -> return (i,j))
(fun (_i,_j) -> false)
let bind_pair_list_size =
Test.make ~name:"bind list_size constant" ~print:Print.(pair int (list int))
- Gen.(int_bound 1000 >>= fun len ->
- list_size (return len) (int_bound 1000) >>= fun xs -> return (len,xs))
+ Gen.(int_pos_bound 1000 >>= fun len ->
+ list_size (return len) (int_pos_bound 1000) >>= fun xs -> return (len,xs))
(fun (len,xs) -> let len' = List.length xs in len=len' && len' < 4)
(* tests from issue #64 *)
@@ -513,36 +513,36 @@ module Shrink = struct
let lists_are_empty_issue_64 =
Test.make ~name:"lists are empty" ~print:Print.(list int)
- Gen.(list small_int) (fun xs -> print_list xs; xs = [])
+ Gen.(list nat_small) (fun xs -> print_list xs; xs = [])
let list_shorter_10 =
Test.make ~name:"lists shorter than 10" ~print:Print.(list int)
- Gen.(list small_int) (fun xs -> List.length xs < 10)
+ Gen.(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 [small_nat; int_bound 750_000])
+ let size_gen = Gen.(oneof [nat_small; int_pos_bound 750_000])
let list_shorter_432 =
Test.make ~name:"lists shorter than 432" ~print:length_printer
- Gen.(list_size size_gen small_int)
+ Gen.(list_size size_gen nat_small)
(fun xs -> List.length xs < 432)
let list_shorter_4332 =
Test.make ~name:"lists shorter than 4332" ~print:length_printer
- Gen.(list_size size_gen small_int)
+ Gen.(list_size size_gen nat_small)
(fun xs -> List.length xs < 4332)
let list_equal_dupl =
Test.make ~name:"lists equal to duplication" ~print:Print.(list int)
- Gen.(list_size size_gen small_int)
+ Gen.(list_size size_gen nat_small)
(fun xs -> try xs = xs @ xs
with Stack_overflow -> false)
let list_unique_elems =
Test.make ~name:"lists have unique elems" ~print:Print.(list int)
- Gen.(list small_int)
+ Gen.(list nat_small)
(fun xs -> let ys = List.sort_uniq Int.compare xs in
print_list xs; List.length xs = List.length ys)
@@ -609,7 +609,7 @@ module Function = struct
Test.make ~name:"fail_pred_map_commute" ~count:100 ~long_factor:100
~print:Print.(triple (list int) Fn.print Fn.print)
Gen.(triple
- (small_list small_int)
+ (small_list nat_small)
(fun1 ~print:Print.int Observable.int int)
(fun1 ~print:Print.bool Observable.int bool))
(fun (l,Fun (_,f),Fun (_,p)) ->
@@ -620,7 +620,7 @@ module Function = struct
(fun1 Observable.string ~print:Print.bool Gen.bool)
(fun (Fun (_,p)) -> not (p "some random string") || p "some other string")
- let int_gen = Gen.small_nat (* int *)
+ let int_gen = Gen.nat_small (* int *)
(* Another example (false) property *)
let prop_foldleft_foldright =
@@ -670,8 +670,8 @@ module Function = struct
Gen.(quad (* string -> int -> string *)
(fun2 ~print:Print.string Observable.string Observable.int (small_string ~gen:char))
(small_string ~gen:char)
- (list small_int)
- (list small_int))
+ (list nat_small)
+ (list nat_small))
(fun (f,acc,is,js) ->
let f = Fn.apply f in
List.fold_left f acc (is @ js)
@@ -739,20 +739,20 @@ module Stats = struct
let pair_dist =
Test.make ~name:"pair dist" ~count:500_000 ~stats:[("pair sum", (fun (i,j) -> i+j))]
- Gen.(pair (int_bound 100) (int_bound 100)) (fun _ -> true)
+ Gen.(pair (int_pos_bound 100) (int_pos_bound 100)) (fun _ -> true)
let triple_dist =
Test.make ~name:"triple dist" ~count:500_000 ~stats:[("triple sum", (fun (i,j,k) -> i+j+k))]
- Gen.(triple (int_bound 100) (int_bound 100) (int_bound 100)) (fun _ -> true)
+ Gen.(triple (int_pos_bound 100) (int_pos_bound 100) (int_pos_bound 100)) (fun _ -> true)
let quad_dist =
Test.make ~name:"quad dist" ~count:500_000 ~stats:[("quad sum", (fun (h,i,j,k) -> h+i+j+k))]
- Gen.(quad (int_bound 100) (int_bound 100) (int_bound 100) (int_bound 100)) (fun _ -> true)
+ Gen.(quad (int_pos_bound 100) (int_pos_bound 100) (int_pos_bound 100) (int_pos_bound 100)) (fun _ -> true)
let bind_dist =
Test.make ~name:"bind dist" ~count:1_000_000
~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)
+ Gen.(int_pos_bound 100 >>= fun j -> int_pos_bound j >>= fun i -> return (i,j)) (fun _ -> true)
let list_len_tests =
let len = ("len",List.length) in
@@ -776,10 +776,10 @@ module Stats = struct
let dist = ("dist",fun x -> x) in
[
(* test from issue #40 *)
- Test.make ~name:"int_stats_neg" ~count:5000 ~stats:[dist] Gen.small_signed_int (fun _ -> true);
+ Test.make ~name:"int_stats_neg" ~count:5000 ~stats:[dist] Gen.int_small (fun _ -> true);
(* distribution tests from PR #45 *)
- Test.make ~name:"small_signed_int dist" ~count:1000 ~stats:[dist] Gen.small_signed_int (fun _ -> true);
- Test.make ~name:"small_nat dist" ~count:1000 ~stats:[dist] Gen.small_nat (fun _ -> true);
+ Test.make ~name:"int_small dist" ~count:1000 ~stats:[dist] Gen.int_small (fun _ -> true);
+ Test.make ~name:"nat_small dist" ~count:1000 ~stats:[dist] Gen.nat_small (fun _ -> true);
Test.make ~name:"nat dist" ~count:1000 ~stats:[dist] Gen.nat (fun _ -> true);
Test.make ~name:"int_range (-43643) 435434 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-43643) 435434) (fun _ -> true);
Test.make ~name:"int_range (-40000) 40000 dist" ~count:1000 ~stats:[dist] (Gen.int_range (-40000) 40000) (fun _ -> true);
@@ -795,7 +795,7 @@ module Stats = struct
let int_dist_empty_bucket =
Test.make ~name:"int_dist_empty_bucket" ~count:1_000 ~stats:[("dist",fun x -> x)]
- Gen.(oneof [small_int_corners ();int]) (fun _ -> true)
+ Gen.(oneof [int_corners ();int]) (fun _ -> true)
let tests =
[ bool_dist;