Merge pull request #391 from jmid/revisit-oneof-opt-args

The Great Renaming, Chapter 17: Revisiting `QCheck.oneof` optional arguments

Author: jmid

CHANGELOG.md

@@ -102,7 +102,8 @@
   - Add `QCheck.Gen.oneof_array` and deprecate `QCheck.Gen.oneofa`
   - Add `QCheck.oneof_list` and deprecate `QCheck.oneofl`
   - Add `QCheck.oneof_array` and deprecate `QCheck.oneofa`
-  - Un-deprecate `QCheck.oneof` with a better specification and deprecate `QCheck.choose` for consistency
+  - Un-deprecate `QCheck.oneof` with a better specification and optional parameters
+    like `QCheck.oneof_weighted` and deprecate `QCheck.choose` for consistency
   - Add `QCheck2.Gen.oneof_list` and deprecate `QCheck2.Gen.oneofl`
   - Add `QCheck2.Gen.oneof_array` and deprecate `QCheck2.Gen.oneofa`
 - Add missing `QCheck2.Gen.map_keep_input` for consistency

src/core/QCheck.ml

@@ -1276,14 +1276,15 @@ let make_int ?collect gen =
 let adapt_ o gen =
   make ?print:o.print ?small:o.small ?shrink:o.shrink ?collect:o.collect gen
 
-let oneof l = match l with
+let oneof ?print ?small ?shrink l = match l with
   | [] -> raise (Invalid_argument "QCheck.oneof")
   | l ->
-      let a = Array.of_list l in
-      adapt_ a.(0)
-        (fun st ->
-          let arb = a.(RS.int st (Array.length a)) in
-          arb.gen st)
+    let first = List.hd l in
+    let print = _opt_sum print first.print in
+    let small = _opt_sum small first.small in
+    let shrink = _opt_sum shrink first.shrink in
+    let gens = List.map (fun x -> x.gen) l in
+    make ?print ?small ?shrink (Gen.oneof gens)
 
 let unit : unit arbitrary =
   make ~small:small1 ~shrink:Shrink.nil ~print:Print.unit Gen.unit
@@ -1864,14 +1865,14 @@ let fun4 o1 o2 o3 o4 ret =
 (* Generator combinators *)
 
 (** given a list, returns generator that picks at random from list *)
-let oneof_list ?print xs = make ?print (Gen.oneof_list xs)
+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 xs = make ?print (Gen.oneof_array 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 = oneof
+let choose l = oneof l
 
 (** Generator that always returns given value *)
 let always ?print x =

src/core/QCheck.mli

@@ -1769,7 +1769,7 @@ val choose : 'a arbitrary list -> 'a arbitrary
     be empty; if it is [Invalid_argument] is raised.
     @deprecated use {!oneof} instead. *)
 
-val oneof_list : ?print:'a Print.t -> 'a list -> 'a arbitrary
+val oneof_list : ?print:'a Print.t -> ?small:('a -> int) -> 'a list -> 'a arbitrary
 (** Pick an element randomly in the list.
     @since NEXT_RELEASE *)
 
@@ -1778,7 +1778,7 @@ val oneofl : ?print:'a Print.t -> ?collect:('a -> string) ->
 (** Pick an element randomly in the list.
     @deprecated use {!oneof_list} instead. *)
 
-val oneof_array : ?print:'a Print.t -> 'a array -> 'a arbitrary
+val oneof_array : ?print:'a Print.t -> ?small:('a -> int) -> 'a array -> 'a arbitrary
 (** Pick an element randomly in the array.
     @since NEXT_RELEASE *)
 
@@ -1787,10 +1787,12 @@ val oneofa : ?print:'a Print.t -> ?collect:('a -> string) ->
 (** Pick an element randomly in the array.
     @deprecated use {!oneof_array} instead. *)
 
-val oneof : 'a arbitrary list -> 'a arbitrary
+val oneof : ?print:'a Print.t -> ?small:('a -> int) ->
+  ?shrink:'a Shrink.t -> 'a arbitrary list -> 'a arbitrary
 (** Pick a generator among the list, randomly.
-    The resulting generator uses the printer, shrinker, etc.
-    from the first element in the argument list, if available.
+    The resulting generator uses any optional [print], [small], and [shrink]
+    parameter passed, and otherwise those from the first element in the argument
+    list, if available.
 
     Consider using {!Gen.oneof} and then {!make} to build
     an arbitrary instance with a different behaviour.