Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
44 changes: 43 additions & 1 deletion CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,49 @@

## NEXT RELEASE (202?-??-??)

- ...
- Remove deprecated generator bindings:
- `QCheck.Gen`:
- `big_nat` `neg_int` `pint` `small_nat` `small_int` `small_signed_int` `int_pos_corners`, `int_corners`
- `ui32` `ui64`
- `pfloat` `nfloat`
- `opt`
- `string_readable` `small_string`
- `small_list` `list_repeat`
- `array_repeat` `small_array`
- `oneofl` `oneofa`
- `frequency` `frequencyl` `frequencya`
- `shuffle_a` `shuffle_l` `shuffle_w_l`
- `flatten_l` `flatten_a` `flatten_opt` `flatten_res`
- `QCheck.arbitrary`:
- `small_nat` `small_int` `small_signed_int` `pos_int` `neg_int` - `small_int_corners`
- `pos_float` `neg_float`
- `printable_char` `numeral_char`
- `string_gen_of_size` `string_gen` `small_string` `string_of_size`
`printable_string` `printable_string_of_size` `string_printable_of_size` `small_printable_string` `string_small_printable`
`numeral_string` `numeral string` `numeral_string_of_size` `string_numeral_of_size`
- `bytes_gen_of_size` `bytes_of_size`
- `small_list` `list_of_size`
- `array_of_size`
- `choose` `oneofl` `oneofa`
- `frequency` `frequencyl` `frequencya`
- `QCheck2.Gen`:
- `pint` `small_nat` `big_nat` `neg_int` `small_int` `small_signed_int`
`small_int_corners` `int_pos_corners` `int_corners`
- `ui32` `ui64`
- `pfloat` `nfloat`
- `opt`
- `small_string`
- `small_list` `list_repeat`
- `small_array` `array_repeat`
- `oneofl` `oneofa`
- `frequency` `frequencyl` `frequencya`
- `shuffle_a` `shuffle_l` `shuffle_w_l`
- `flatten_l` `flatten_a` `flatten_opt` `flatten_res`
- Other removed deprecated `QCheck2` bindings:
- `Print.comap`
- `Shrink.int_aggressive`
- `Observable.map`
- `TestResult.stats` `TestResult.warnings` `TestResult.collect`


## 0.91 (2025-12-21)
Expand Down
105 changes: 4 additions & 101 deletions src/core/QCheck.ml
Original file line number Diff line number Diff line change
Expand Up @@ -138,9 +138,7 @@ module Gen = struct

let oneof l st = List.nth l (Random.State.int st (List.length l)) st
let oneof_list xs st = List.nth xs (Random.State.int st (List.length xs))
let oneofl = oneof_list
let oneof_array xs st = Array.get xs (Random.State.int st (Array.length xs))
let oneofa = oneof_array

let oneof_list_weighted l st =
let sums = sum_int (List.map fst l) in
Expand All @@ -151,21 +149,14 @@ module Gen = struct
in
aux 0 l

let frequencyl = oneof_list_weighted

let oneof_array_weighted a = oneof_list_weighted (Array.to_list a)

let frequencya = oneof_array_weighted

let oneof_weighted l st = oneof_list_weighted l st st

let frequency = oneof_weighted

let int_pos_small st =
let p = RS.float st 1. in
if p < 0.75 then RS.int st 10 else RS.int st 100
let nat_small = int_pos_small
let small_nat = int_pos_small

(* natural number generator *)
let nat st =
Expand All @@ -177,11 +168,6 @@ module Gen = struct

let int_pos_mid = nat

let big_nat st =
let p = RS.float st 1. in
if p < 0.75 then nat st
else RS.int st 1_000_000

let unit _st = ()

let bool st = RS.bool st
Expand All @@ -200,9 +186,6 @@ module Gen = struct
let float_pos st = abs_float (float st)
let float_neg st = -.(float_pos st)

let pfloat = float_pos
let nfloat = float_neg

let float_bound_inclusive bound st = RS.float st bound

let float_bound_exclusive bound st =
Expand All @@ -225,15 +208,11 @@ module Gen = struct

let exponential = float_exp

let neg_int st = -(nat st)

let option ?(ratio = 0.85) f st =
let p = RS.float st 1. in
if p < (1.0 -. ratio) then None
else Some (f st)

let opt = option

let result ?(ratio = 0.75) vg eg st =
let p = RS.float st 1. in
if p < (1.0 -. ratio)
Expand All @@ -256,8 +235,6 @@ module Gen = struct
let right = RS.bits st in
left lor middle lor right

let pint = int_pos

let int_neg st = -(int_pos st)-1

let int st = if RS.bool st then - (int_pos st) - 1 else int_pos st
Expand All @@ -284,17 +261,11 @@ module Gen = struct

let (--) = int_range

(* 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 int_small st =
if bool st
then nat_small st
else - (nat_small st)

let small_signed_int = int_small

let char_range a b = map Char.chr (Char.code a -- Char.code b)

let random_binary_string st length =
Expand All @@ -310,9 +281,6 @@ module Gen = struct
let int32 st = Int32.of_string (random_binary_string st 32)
let int64 st = Int64.of_string (random_binary_string st 64)

let ui32 = int32
let ui64 = int64

let list_size size gen st =
foldn ~f:(fun acc _ -> (gen st)::acc) ~init:[] (size st)
let list gen st = list_size nat gen st
Expand All @@ -321,12 +289,9 @@ module Gen = struct
let array_size size gen st =
Array.init (size st) (fun _ -> gen st)
let array gen st = array_size nat gen st
let array_repeat n g = array_size (return n) g

let flatten_list l st = List.map (fun f->f st) l
let flatten_l = flatten_list
let flatten_array a st = Array.map (fun f->f st) a
let flatten_a = flatten_array
let flatten_option o st =
match o with
| None -> None
Expand Down Expand Up @@ -356,8 +321,6 @@ module Gen = struct
shuffle_a a st;
Array.to_list a

let shuffle_l = shuffle_list

let shuffle_list_weighted l st =
let sample (w, v) =
let fl_w = float_of_int w in
Expand All @@ -366,8 +329,6 @@ module Gen = struct
let samples = List.rev_map sample l in
List.sort (fun (w1, _) (w2, _) -> poly_compare w1 w2) samples |> List.rev_map snd

let shuffle_w_l = shuffle_list_weighted

let range_subset ~size low high st =
let range_size = high - low + 1 in
if not (0 <= size && size <= range_size) then
Expand Down Expand Up @@ -458,14 +419,10 @@ module Gen = struct
let string_of gen = string_size ~gen nat
let bytes_printable = bytes_size ~gen:char_printable nat
let string_printable = string_size ~gen:char_printable nat
let string_readable = string_printable
let bytes_small st = bytes_size nat_small st
let bytes_small_of gen st = bytes_size ~gen nat_small st
let small_string ?gen st = string_size ?gen nat_small st
let list_small gen = list_size nat_small gen
let small_list = list_small
let array_small gen = array_size nat_small gen
let small_array = array_small
let string_small st = string_size nat_small st
let string_small_of gen st = string_size ~gen nat_small st

Expand All @@ -482,7 +439,6 @@ module Gen = struct
let int_corners = int_pos_corners @ [min_int;-2;-1]

let int_small_corners () = graft_corners int_small int_corners ()
let nng_corners () = graft_corners nat int_pos_corners ()

(* sized, fix *)

Expand Down Expand Up @@ -1294,8 +1250,6 @@ let bool =
let float = make_scalar Gen.float
let float_pos = make_scalar Gen.float_pos
let float_neg = make_scalar Gen.float_neg
let pos_float = float_pos
let neg_float = float_neg

let float_bound_inclusive bound =
make ~small:small1 ~shrink:(Shrink.float_bound bound) ~print:Print.float (Gen.float_bound_inclusive bound)
Expand All @@ -1317,19 +1271,14 @@ let int_bound n = make_int (Gen.int_bound n)
let int_range a b = make_int (Gen.int_range a b)
let (--) = int_range
let int_pos = make_int Gen.int_pos
let pos_int = int_pos
let small_int = make_int Gen.small_int

let nat = make_int Gen.nat
let int_pos_small = make_int Gen.int_pos_small
let int_pos_mid = nat
let nat_small = int_pos_small
let small_nat = nat_small
let int_small = make_int Gen.small_signed_int
let small_signed_int = int_small
let small_int_corners () = make_int (Gen.nng_corners ())
let int_small = make_int Gen.int_small
let int_small_corners () = make_int (Gen.int_small_corners ())
let int_neg = make_int Gen.int_neg
let neg_int = make_int Gen.neg_int

let int32 =
make ~print:Print.int32 ~small:small1 ~shrink:Shrink.int32 Gen.int32
Expand All @@ -1345,23 +1294,19 @@ let char_range low high =
let char_printable =
make ~print:Print.char ~small:(small_char 'a') ~shrink:Shrink.char_printable Gen.char_printable
let printable = char_printable
let printable_char = char_printable
let char_numeral =
make ~print:Print.char ~small:(small_char '0') ~shrink:Shrink.char_numeral Gen.char_numeral
let numeral = char_numeral
let numeral_char = char_numeral

let bytes_size ?(gen = Gen.char) size =
make ~shrink:Shrink.bytes ~small:Bytes.length
~print:Print.bytes (Gen.bytes_size ~gen size)
let bytes_size_of size gen = bytes_size ~gen size
let bytes_gen_of_size size gen = bytes_size ~gen size
let bytes_of gen =
make ~shrink:Shrink.bytes ~small:Bytes.length
~print:Print.bytes (Gen.bytes_of gen)

let bytes = bytes_of Gen.char
let bytes_of_size size = bytes_size ~gen:Gen.char size
let bytes_small = bytes_size ~gen:Gen.char Gen.nat_small
let bytes_small_of gen = bytes_size ~gen Gen.nat_small
let bytes_printable =
Expand All @@ -1377,39 +1322,13 @@ let string_of gen =

let string = string_of Gen.char
let string_size ?(gen=Gen.char) size = string_size_of size gen
let string_of_size size = string_size_of size Gen.char
let string_small = string_size_of Gen.nat_small Gen.char
let string_small_of gen = string_size_of Gen.nat_small gen
let small_string = string_small
let string_gen = string_of
let string_gen_of_size = string_size_of

let string_printable =
make ~shrink:(Shrink.string ~shrink:Shrink.char_printable) ~small:String.length
~print:Print.string (Gen.string_of Gen.char_printable)

let printable_string_of_size size =
make ~shrink:(Shrink.string ~shrink:Shrink.char_printable) ~small:String.length
~print:Print.string (Gen.string_size ~gen:Gen.char_printable size)

let small_printable_string =
make ~shrink:(Shrink.string ~shrink:Shrink.char_printable) ~small:String.length
~print:Print.string (Gen.string_size ~gen:Gen.char_printable Gen.nat_small)

let numeral_string =
make ~shrink:(Shrink.string ~shrink:Shrink.char_numeral) ~small:String.length
~print:Print.string (Gen.string_of Gen.char_numeral)

let numeral_string_of_size size =
make ~shrink:(Shrink.string ~shrink:Shrink.char_numeral) ~small:String.length
~print:Print.string (Gen.string_size ~gen:Gen.char_numeral size)

let printable_string = string_printable
let string_printable_of_size = printable_string_of_size
let string_small_printable = small_printable_string
let string_numeral = numeral_string
let string_numeral_of_size = numeral_string_of_size

let list_sum_ f l = List.fold_left (fun acc x-> f x+acc) 0 l

let mk_list a gen =
Expand All @@ -1420,9 +1339,7 @@ let mk_list a gen =

let list a = mk_list a (Gen.list a.gen)
let list_size size a = mk_list a (Gen.list_size size a.gen)
let list_of_size = list_size
let list_small a = mk_list a (Gen.small_list a.gen)
let small_list = list_small
let list_small a = mk_list a (Gen.list_small a.gen)

let array_sum_ f a = Array.fold_left (fun acc x -> f x+acc) 0 a

Expand Down Expand Up @@ -1450,8 +1367,6 @@ let array_size size a =
?print:(_opt_map ~f:Print.array a.print)
(Gen.array_size size a.gen)

let array_of_size = array_size

let pair a b =
make
?small:(_opt_map_2 ~f:(fun f g (x,y) -> f x+g y) a.small b.small)
Expand Down Expand Up @@ -1551,7 +1466,7 @@ let tup9 a b c d e f g h i =
(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
let g = Gen.option ?ratio a.gen
and shrink = _opt_map a.shrink ~f:Shrink.option
and small =
_opt_map_or a.small ~d:(function None -> 0 | Some _ -> 1)
Expand Down Expand Up @@ -1866,13 +1781,7 @@ let fun4 o1 o2 o3 o4 ret =

(** given a list, returns generator that picks at random from list *)
let oneof_list ?print ?small xs = make ?print ?small (Gen.oneof_list xs)
let oneofl ?print ?collect xs = make ?print ?collect (Gen.oneof_list xs)
let oneof_array ?print ?small xs = make ?print ?small (Gen.oneof_array xs)
let oneofa ?print ?collect xs = make ?print ?collect (Gen.oneof_array xs)

(** Given a list of generators, returns generator that randomly uses one of the generators
from the list *)
let choose l = oneof l

(** Generator that always returns given value *)
let always ?print x =
Expand All @@ -1888,12 +1797,6 @@ let oneof_weighted ?print ?small ?shrink l =
let gens = List.map (fun (x,y) -> x, y.gen) l in
make ?print ?small ?shrink (Gen.oneof_weighted gens)

let frequency ?print ?small ?shrink ?collect l =
let arb = oneof_weighted ?print ?small ?shrink l in
match collect with
| None -> arb
| Some c -> set_collect c arb

(** Given list of [(frequency,value)] pairs, returns value with probability proportional
to given frequency *)
let oneof_list_weighted ?print ?small l = make ?print ?small (Gen.oneof_list_weighted l)
Expand Down
Loading