package qcheck-core

  1. Overview
  2. Docs

Module QCheckSource

Quickcheck inspired property-based testing

Introduction

The library takes inspiration from Haskell's QuickCheck library. The rough idea is that the programmer describes invariants that values of a certain type need to satisfy ("properties"), as functions from this type to bool. The programmer also needs to describe how to generate random values of the type, so that the property is tried and checked on a number of random instances.

This explains the organization of this module:

  • The 'a arbitrary record type describes how to generate random values, shrink them (reduce counter-examples to a minimum), print them, etc. It is the generator type expected by Test.make.
  • Auxiliary modules such as Gen, Print, and Shrink can be used along with make to build custom generators.
  • Test is used to describe a single test, that is, a property of type 'a -> bool combined with an 'a arbitrary that is used to generate the test cases for this property. Optional parameters allow to specify the random generator state, number of instances to generate and test, etc.

Examples

  • List.rev is involutive:

  let test =
    QCheck.(Test.make ~count:1000
              (list int) (fun l -> List.rev (List.rev l) = l));;

  QCheck.Test.check_exn test;;
  • Not all lists are sorted (false property that will fail. The 15 smallest counter-example lists will be printed):
  let test = QCheck.(
      Test.make
        ~count:10_000 ~max_fail:3
        (list small_nat)
        (fun l -> l = List.sort compare l));;
  QCheck.Test.check_exn test;;
  • generate 20 random trees using Gen.fix :
  type tree = Leaf of int | Node of tree * tree

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

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

      Gen.generate ~n:20 g;;

More complex and powerful combinators can be found in Gabriel Scherer's Generator module. Its documentation can be found here.

Assumptions

Sourceval (==>) : bool -> bool -> bool

b1 ==> b2 is the logical implication b1 => b2 ie not b1 || b2 (except that it is strict and will interact better with Test.check_exn and the likes, because they will know the precondition was not satisfied.).

WARNING: this function should only be used in a property (see Test.make), because it raises a special exception in case of failure of the first argument, to distinguish between failed test and failed precondition. Because of OCaml's evaluation order, both b1 and b2 are always evaluated; if b2 should only be evaluated when b1 holds, see assume.

Sourceval assume : bool -> unit

assume cond checks the precondition cond, and does nothing if cond=true. If cond=false, it interrupts the current test.

WARNING This function, like (==>), should only be used in a test, not outside. Example:

  Test.make (list int) (fun l ->
      assume (l <> []);
      List.hd l :: List.tl l = l)
  • since 0.5.1
Sourceval assume_fail : unit -> 'a

assume_fail () is like assume false, but can take any type since we know it always fails (like assert false). This is useful to ignore some branches in if or match.

Example:

  Test.make (list int) (function
      | [] -> assume_fail ()
      | _::_ as l -> List.hd l :: List.tl l = l)
  • since 0.5.1

Generate Random Values

Sourcemodule Gen : sig ... end

The Gen module offers combinators to build custom generators. Unlike the the 'a arbitrary record type, which comes with printers, shrinkers, etc. Gen.t represents a type for generation only.

Printing Values

Sourcemodule Print : sig ... end

The Print module offers combinators for printing generated values.

Shrinking Values

Shrinking is used to reduce the size of a counter-example. It tries to make the counter-example smaller, e.g., by decreasing an integer, or removing elements of a list, until the property to test holds again; it then returns the smallest value that still made the test fail.

Shrinking is defined as a type Shrink.t that takes an argument to shrink and produces an iterator of type Iter.t of shrinking candidates.

Iterators

Sourcemodule Iter : sig ... end

Iter is compatible with the library "sequence". An iterator i is simply a function that accepts another function f (of type 'a -> unit) and calls f on a sequence of elements f x1; f x2; ...; f xn.

Shrinkers

Sourcemodule Shrink : sig ... end

The Shrink module contains combinators to build up composite shrinkers for user-defined types

Arbitrary

A value of type 'a arbitrary glues together a random generator, and optional functions for shrinking, printing, computing the size, etc. It is the "normal" way of describing how to generate values of a given type, to be then used in tests (see Test).

Sourcetype 'a stat = string * ('a -> int)

A statistic on a distribution of values of type 'a. The function MUST return a positive integer.

Sourcetype 'a arbitrary = private {
  1. gen : 'a Gen.t;
  2. print : 'a Print.t option;
    (*

    print values

    *)
  3. small : ('a -> int) option;
    (*

    size of example

    *)
  4. shrink : 'a Shrink.t option;
    (*

    shrink to smaller examples

    *)
  5. collect : ('a -> string) option;
    (*

    map value to tag, and group by tag

    *)
  6. stats : 'a stat list;
    (*

    statistics to collect and print

    *)
}

A value of type 'a arbitrary is an object with a method for generating random values of type 'a, and additional methods to compute the size of values, print them, and possibly shrink them into smaller counter-examples.

NOTE the collect field is unstable and might be removed, or moved into Test.

Made private since 0.8

Sourceval make : ?print:'a Print.t -> ?small:('a -> int) -> ?shrink:'a Shrink.t -> ?collect:('a -> string) -> ?stats:'a stat list -> 'a Gen.t -> 'a arbitrary

Builder for arbitrary. Default is to only have a generator, but other arguments can be added.

  • parameter print

    printer for values (counter-examples)

  • parameter collect

    for statistics

  • parameter shrink

    to shrink counter-examples

Adjusting arbitrary generators

There is a range to get and set fields on an arbitrary record type.

Sourceval set_print : 'a Print.t -> 'a arbitrary -> 'a arbitrary
Sourceval set_small : ('a -> int) -> 'a arbitrary -> 'a arbitrary
Sourceval set_shrink : 'a Shrink.t -> 'a arbitrary -> 'a arbitrary
Sourceval set_collect : ('a -> string) -> 'a arbitrary -> 'a arbitrary
Sourceval set_stats : 'a stat list -> 'a arbitrary -> 'a arbitrary
  • since 0.6
Sourceval add_shrink_invariant : ('a -> bool) -> 'a arbitrary -> 'a arbitrary

Update shrinker by only keeping smaller values satisfying the given invariant.

  • since 0.8
Sourceval set_gen : 'a Gen.t -> 'a arbitrary -> 'a arbitrary

Change the generator

  • since 0.7
Sourceval add_stat : 'a stat -> 'a arbitrary -> 'a arbitrary

Add a statistic to the arbitrary instance.

  • since 0.6
Sourceval gen : 'a arbitrary -> 'a Gen.t

Access the underlying random generator of this arbitrary object.

  • since 0.6
Sourceval get_gen : 'a arbitrary -> 'a Gen.t

Access the underlying random generator of this arbitrary object.

  • since 0.6
Sourceval get_print : 'a arbitrary -> 'a Print.t option

Primitive combinators for arbitrary

Sourceval unit : unit arbitrary

Always generates (), obviously.

Sourceval bool : bool arbitrary

Uniform boolean generator.

Sourceval float : float arbitrary

Generates regular floats (no nan and no infinities).

Sourceval pos_float : float arbitrary

Positive float generator (no nan and no infinities).

Sourceval neg_float : float arbitrary

Negative float generator (no nan and no infinities).

Sourceval float_bound_inclusive : float -> float arbitrary

float_bound_inclusive n is uniform between 0 and n included. If bound is negative, the result is negative or zero. If bound is 0, the result is 0.

  • since 0.11
Sourceval float_bound_exclusive : float -> float arbitrary

float_bound_exclusive n is uniform between 0 included and n excluded. If bound is negative, the result is negative or zero.

  • since 0.11
Sourceval float_range : float -> float -> float arbitrary

float_range low high is uniform between low included and high included.

  • since 0.11
Sourceval exponential : float -> float arbitrary

exponential m generates floating-point numbers following an exponential distribution with a mean of m.

  • since 0.23
Sourceval int : int arbitrary

Int generator. Uniformly distributed.

Sourceval int_bound : int -> int arbitrary

int_bound n is uniform between 0 and n included.

Sourceval int_range : int -> int -> int arbitrary

int_range a b is uniform between a and b included. b must be larger than a.

Sourceval small_nat : int arbitrary

Small unsigned integers.

  • since 0.5.1
Sourceval small_int : int arbitrary

Small unsigned integers. See Gen.small_int.

Sourceval small_signed_int : int arbitrary

Small signed integers.

  • since 0.5.2
Sourceval (--) : int -> int -> int arbitrary

Synonym for int_range.

Sourceval int32 : int32 arbitrary

Int32 generator. Uniformly distributed.

Sourceval int64 : int64 arbitrary

Int64 generator. Uniformly distributed.

Sourceval pos_int : int arbitrary

Positive int generator (0 included). Uniformly distributed. See Gen.pint

Sourceval small_int_corners : unit -> int arbitrary

As small_int, but each newly created generator starts with a list of corner cases before falling back on random generation.

Note that small_int_corners () is stateful, meaning that once the list of corner cases has been emitted, subsequent calls will not reproduce them. As a consequence, in the following example, the first test fails with a counter example, whereas the second rerun does not:

  let gen = QCheck.small_int_corners ()
  let t = QCheck.Test.make ~name:"never max_int" gen (fun i -> i <> max_int)
  let _ = QCheck_base_runner.run_tests ~verbose:true [t;t]
Sourceval neg_int : int arbitrary

Negative int generator (0 included, see Gen.neg_int). The distribution is similar to that of small_int, not of pos_int.

Sourceval char : char arbitrary

Uniformly distributed on all the chars (not just ascii or valid latin-1).

Sourceval printable_char : char arbitrary

Uniformly distributed over a subset of printable ascii chars. Ascii character codes 32 to 126, inclusive - or '\n' with code 10.

Sourceval numeral_char : char arbitrary

Uniformly distributed over '0'..'9'.

Sourceval bytes_gen_of_size : int Gen.t -> char Gen.t -> bytes arbitrary

Builds a bytes generator from a (non-negative) size generator and a character generator.

  • since 0.20
Sourceval bytes_of : char Gen.t -> bytes arbitrary

Generates bytes with a distribution of length of Gen.nat.

  • since 0.20
Sourceval bytes : bytes arbitrary

Generates bytes with a distribution of length of Gen.nat and distribution of characters of char.

  • since 0.20
Sourceval bytes_small : bytes arbitrary

Same as bytes but with a small length (ie Gen.small_nat ).

  • since 0.20
Sourceval bytes_small_of : char Gen.t -> bytes arbitrary

Same as bytes_of but with a small length (ie Gen.small_nat ).

  • since 0.20
Sourceval bytes_of_size : int Gen.t -> bytes arbitrary

Generates bytes with distribution of characters of char.

  • since 0.20
Sourceval bytes_printable : bytes arbitrary

Generates bytes with a distribution of length of Gen.nat and distribution of characters of printable_char.

  • since 0.20
Sourceval string_gen_of_size : int Gen.t -> char Gen.t -> string arbitrary

Builds a string generator from a (non-negative) size generator and a character generator.

Sourceval string_gen : char Gen.t -> string arbitrary

Generates strings with a distribution of length of Gen.nat.

Sourceval string_of : char Gen.t -> string arbitrary

Synonym for string_gen added for convenience.

  • since 0.20
Sourceval string : string arbitrary

Generates strings with a distribution of length of Gen.nat and distribution of characters of char.

Sourceval small_string : string arbitrary

Same as string but with a small length (ie Gen.small_nat ).

Sourceval string_small : string arbitrary

Synonym for small_string added for convenience.

  • since 0.20
Sourceval string_small_of : char Gen.t -> string arbitrary

Same as string_of but with a small length (ie Gen.small_nat ).

  • since 0.20
Sourceval small_list : 'a arbitrary -> 'a list arbitrary

Generates lists of small size (see Gen.small_nat).

  • since 0.5.3
Sourceval string_of_size : int Gen.t -> string arbitrary

Generates strings with distribution of characters of char.

Sourceval printable_string : string arbitrary

Generates strings with a distribution of length of Gen.nat and distribution of characters of printable_char.

Sourceval string_printable : string arbitrary

Synonym for printable_string added for convenience.

  • since 0.20
Sourceval printable_string_of_size : int Gen.t -> string arbitrary

Generates strings with distribution of characters of printable_char.

Sourceval string_printable_of_size : int Gen.t -> string arbitrary

Synonym for printable_string_of_size added for convenience.

  • since 0.20
Sourceval small_printable_string : string arbitrary

Generates strings with a length of small_nat and distribution of characters of printable_char.

Sourceval string_small_printable : string arbitrary

Synonym for small_printable_string added for convenience.

  • since 0.20
Sourceval numeral_string : string arbitrary

Generates strings with a distribution of length of Gen.nat and distribution of characters of numeral_char.

Sourceval string_numeral : string arbitrary

Synonym for numeral_string added for convenience.

  • since 0.20
Sourceval numeral_string_of_size : int Gen.t -> string arbitrary

Generates strings with a distribution of characters of numeral_char.

Sourceval string_numeral_of_size : int Gen.t -> string arbitrary

Synonym for numeral_string_of_size added for convenience.

  • since 0.20
Sourceval list : 'a arbitrary -> 'a list arbitrary

Generates lists with length generated by Gen.nat.

Sourceval list_of_size : int Gen.t -> 'a arbitrary -> 'a list arbitrary

Generates lists with length from the given distribution.

Sourceval array : 'a arbitrary -> 'a array arbitrary

Generates arrays with length generated by Gen.nat.

Sourceval array_of_size : int Gen.t -> 'a arbitrary -> 'a array arbitrary

Generates arrays with length from the given distribution.

Sourceval option : ?ratio:float -> 'a arbitrary -> 'a option arbitrary

Choose between returning Some random value with optional ratio, or None.

Sourceval result : ?ratio:float -> 'a arbitrary -> 'e arbitrary -> ('a, 'e) result arbitrary

result ~ratio okgen errgen generates Ok v with v coming from okgen or Error e with e coming from errgen, depending on ratio. The latter is a float between 0. and 1. indicating the probability of a sample to be Ok _ rather than Error _.

  • since 0.24

Tuples of arbitrary generators

These shrink on gen1, then gen2, then ...

Sourceval pair : 'a arbitrary -> 'b arbitrary -> ('a * 'b) arbitrary

Combines two generators into a generator of pairs. Order of elements can matter (w.r.t shrinking, see Shrink.pair)

Sourceval triple : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> ('a * 'b * 'c) arbitrary

Combines three generators into a generator of 3-tuples. Order matters for shrinking, see Shrink.pair and the likes

Sourceval quad : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> ('a * 'b * 'c * 'd) arbitrary

Combines four generators into a generator of 4-tuples. Order matters for shrinking, see Shrink.pair and the likes

Sourceval tup2 : 'a arbitrary -> 'b arbitrary -> ('a * 'b) arbitrary

Combines two generators into a 2-tuple generator. Order of elements can matter (w.r.t shrinking, see Shrink.tup2) Prints as many elements as available printers

Sourceval tup3 : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> ('a * 'b * 'c) arbitrary

Combines three generators into a 3-tuple generator. Order of elements can matter (w.r.t shrinking, see Shrink.tup2) Prints as many elements as available printers

Sourceval tup4 : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> ('a * 'b * 'c * 'd) arbitrary

Combines four generators into a 4-tuple generator. Order of elements can matter (w.r.t shrinking, see Shrink.tup2) Prints as many elements as available printers

Sourceval tup5 : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> 'e arbitrary -> ('a * 'b * 'c * 'd * 'e) arbitrary

Combines five generators into a 5-tuple generator. Order of elements can matter (w.r.t shrinking, see Shrink.tup2) Prints as many elements as available printers

Sourceval tup6 : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> 'e arbitrary -> 'f arbitrary -> ('a * 'b * 'c * 'd * 'e * 'f) arbitrary

Combines six generators into a 6-tuple generator. Order of elements can matter (w.r.t shrinking, see Shrink.tup2) Prints as many elements as available printers

Sourceval tup7 : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> 'e arbitrary -> 'f arbitrary -> 'g arbitrary -> ('a * 'b * 'c * 'd * 'e * 'f * 'g) arbitrary

Combines seven generators into a 7-tuple generator. Order of elements can matter (w.r.t shrinking, see Shrink.tup2) Prints as many elements as available printers

Sourceval tup8 : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> 'e arbitrary -> 'f arbitrary -> 'g arbitrary -> 'h arbitrary -> ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h) arbitrary

Combines eight generators into a 8-tuple generator. Order of elements can matter (w.r.t shrinking, see Shrink.tup2) Prints as many elements as available printers

Sourceval tup9 : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> 'd arbitrary -> 'e arbitrary -> 'f arbitrary -> 'g arbitrary -> 'h arbitrary -> 'i arbitrary -> ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i) arbitrary

Combines nine generators into a 9-tuple generator. Order of elements can matter (w.r.t shrinking, see Shrink.tup2) Prints as many elements as available printers

Combinatoric arbitrary combinators

Sourceval choose : 'a arbitrary list -> 'a arbitrary

Choose among the given list of generators. The list must not be empty; if it is Invalid_argument is raised.

Sourceval oneofl : ?print:'a Print.t -> ?collect:('a -> string) -> 'a list -> 'a arbitrary

Pick an element randomly in the list.

Sourceval oneofa : ?print:'a Print.t -> ?collect:('a -> string) -> 'a array -> 'a arbitrary

Pick an element randomly in the array.

Sourceval oneof : 'a arbitrary list -> 'a arbitrary

Pick a generator among the list, randomly.

  • deprecated

    this function is badly specified and will not use shrinkers appropriately. Consider using Gen.oneof and then make to build a well behaved arbitrary instance.

Sourceval always : ?print:'a Print.t -> 'a -> 'a arbitrary

Always return the same element.

Sourceval frequency : ?print:'a Print.t -> ?small:('a -> int) -> ?shrink:'a Shrink.t -> ?collect:('a -> string) -> (int * 'a arbitrary) list -> 'a arbitrary

Similar to oneof but with frequencies.

Sourceval frequencyl : ?print:'a Print.t -> ?small:('a -> int) -> (int * 'a) list -> 'a arbitrary

Same as oneofl, but each element is paired with its frequency in the probability distribution (the higher, the more likely).

Sourceval frequencya : ?print:'a Print.t -> ?small:('a -> int) -> (int * 'a) array -> 'a arbitrary

Same as frequencyl, but with an array.

Sourceval map : ?rev:('b -> 'a) -> ('a -> 'b) -> 'a arbitrary -> 'b arbitrary

map f a returns a new arbitrary instance that generates values using a#gen and then transforms them through f.

  • parameter rev

    if provided, maps values back to type 'a so that the printer, shrinker, etc. of a can be used. We assume f is monotonic in this case (that is, smaller inputs are transformed into smaller outputs).

Sourceval map_same_type : ('a -> 'a) -> 'a arbitrary -> 'a arbitrary

Specialization of map when the transformation preserves the type, which makes shrinker, printer, etc. still relevant.

Sourceval map_keep_input : ?print:'b Print.t -> ?small:('b -> int) -> ('a -> 'b) -> 'a arbitrary -> ('a * 'b) arbitrary

map_keep_input f a generates random values from a, and maps them into values of type 'b using the function f, but it also keeps the original value. For shrinking, it is assumed that f is monotonic and that smaller input values will map into smaller values.

  • parameter print

    optional printer for the f's output.

Tests

A test is a universal property of type foo -> bool for some type foo, with an object of type foo arbitrary used to generate, print, etc. values of type foo.

The main features of this module are:

A test fails if the property does not hold for a given input. The simple form or the rich form) offer more elaborate forms to fail a test.

For more serious testing, it is recommended to create a testsuite and use a full-fledged runner:

  • QCheck_base_runner is a QCheck-only runner (useful if you don't have or don't need another test framework)
  • QCheck_alcotest interfaces to the Alcotest framework
  • QCheck_ounit interfaces to the to OUnit framework

Test Results

Sourcemodule TestResult : sig ... end

Module to represent the result of running a test

Defining Tests

Sourcemodule Test : sig ... end

Module related to individual tests. Since 0.18 most of it moved to QCheck2, and the type 'a cell was made a private implementation detail.

Sub-tests

The infrastructure used to find counter-examples to properties can also be used to find data satisfying a predicate, within a property being tested.

See https://github.com/c-cube/qcheck/issues/31

Sourceexception No_example_found of string
Sourceval find_example : ?name:string -> ?count:int -> f:('a -> bool) -> 'a Gen.t -> 'a Gen.t

find_example ~f gen uses gen to generate some values of type 'a, and checks them against f. If such a value is found, it is returned. Otherwise an exception is raised. NOTE this should only be used from within a property in Test.make.

  • parameter count

    number of attempts.

  • parameter name

    description of the example to find (used in the exception).

  • parameter f

    the property that the example must satisfy.

  • since 0.6
Sourceval find_example_gen : ?rand:Random.State.t -> ?name:string -> ?count:int -> f:('a -> bool) -> 'a Gen.t -> 'a

Toplevel version of find_example. find_example_gen ~f arb ~n is roughly the same as Gen.generate1 (find_example ~f arb |> gen).

  • parameter rand

    the random state to use to generate inputs.

  • since 0.6

Generating Functions

The QCheck module supports generation of pure function values. The implementation is inspired from https://blogs.janestreet.com/quickcheck-for-core/ and Koen Claessen's "Shrinking and Showing Functions".

Generated function arguments are of type Observable.t and function results are of type arbitrary.

Underneath the hood, generated function values have a table-based representation. They therefore need to be applied in a special way, e.g., with Fn.apply.

Observing arguments

Sourcemodule Observable : sig ... end

Observables are usable as arguments for random functions. The random function will observe its arguments in a way that is determined from the observable instance.

Deprecated function generator combinators

Sourceval fun1_unsafe : 'a arbitrary -> 'b arbitrary -> ('a -> 'b) arbitrary

Generator of functions of arity 1. The functions are always pure and total functions:

  • when given the same argument (as decided by Stdlib.(=)), it returns the same value
  • it never does side effects, like printing or never raise exceptions etc. The functions generated are really printable.

renamed from fun1 since 0.6

  • deprecated

    use fun_ instead.

  • since 0.6
Sourceval fun2_unsafe : 'a arbitrary -> 'b arbitrary -> 'c arbitrary -> ('a -> 'b -> 'c) arbitrary

Generator of functions of arity 2. The remark about fun1 also apply here. renamed from fun2 since 0.6

  • deprecated

    use fun_ instead since 0.6

Sourcetype _ fun_repr

Internal data for functions. A 'f fun_ is a function of type 'f, fundamentally.

Sourcetype _ fun_ =
  1. | Fun : 'f fun_repr * 'f -> 'f fun_

A function packed with the data required to print/shrink it. See Fn to see how to apply, print, etc. such a function.

One can also directly pattern match on it to obtain the executable function.

For example:

  QCheck.Test.make
    QCheck.(pair (fun1 Observable.int bool) (small_list int))
    (fun (Fun (_,f), l) -> l=(List.rev_map f l |> List.rev l))
Sourcemodule Fn : sig ... end

A utility module of helpers for printing, shrinking, and applying generated function values.

Defining function generators

Sourceval fun1 : 'a Observable.t -> 'b arbitrary -> ('a -> 'b) fun_ arbitrary

fun1 o ret makes random functions that take an argument observable via o and map to random values generated from ret. To write functions with multiple arguments, it's better to use Tuple or Observable.pair rather than applying fun_ several times (shrinking will be faster).

  • since 0.6
Sourceval fun2 : 'a Observable.t -> 'b Observable.t -> 'c arbitrary -> ('a -> 'b -> 'c) fun_ arbitrary
  • since 0.6
Sourceval fun3 : 'a Observable.t -> 'b Observable.t -> 'c Observable.t -> 'd arbitrary -> ('a -> 'b -> 'c -> 'd) fun_ arbitrary
  • since 0.6
Sourceval fun4 : 'a Observable.t -> 'b Observable.t -> 'c Observable.t -> 'd Observable.t -> 'e arbitrary -> ('a -> 'b -> 'c -> 'd -> 'e) fun_ arbitrary
  • since 0.6

Tuples of observables

To circumvent the arity boundaries of fun1, ..., fun4, one can instead define uncurried functions, instead accepting a tuple argument. A resulting function then needs to be applied with fun_nary.

Sourcemodule Tuple : sig ... end
Sourceval fun_nary : 'a Tuple.obs -> 'b arbitrary -> ('a Tuple.t -> 'b) fun_ arbitrary

fun_nary makes random n-ary functions. Example:

  let module O = Observable in
  fun_nary Tuple.(O.int @-> O.float @-> O.string @-> o_nil) bool
  • since 0.6
OCaml

Innovation. Community. Security.