enable generator override and test disabling in qcheck-tests

src/compilerlib/pb_codegen_quickcheck.ml

@@ -18,12 +18,13 @@ let gen_sig ?and_:_ t sc =
     type_name type_name;
   F.empty_line sc;
   F.linep sc
-    "val quickcheck_tests_%s : ?examples:%s list -> unit -> QCheck2.Test.t list"
+    "val quickcheck_tests_%s : ?gen:%s QCheck2.Gen.t -> unit -> QCheck2.Test.t \
+     list"
     type_name type_name;
   F.linep sc
-    "(** [quickcheck_tests_%s ?examples ()] builds a test suite for the type \
-     %S. Inputs are generated with QuickCheck. Corner cases may be supplied \
-     via the [examples] parameters. *)"
+    "(** [quickcheck_tests_%s ?gen ()] builds a test suite for the type %S. \
+     Inputs are generated with QuickCheck. Use [gen] to override the \
+     generator. *)"
     type_name type_name;
   true
 
@@ -45,8 +46,8 @@ let gen_struct ?and_:_ t sc =
     ];
   F.linep sc "  }";
   F.empty_line sc;
-  F.linep sc "let quickcheck_tests_%s ?examples () =" type_name;
-  F.linep sc "  Pbrt_quickcheck.Test.make quickcheck_%s" type_name;
+  F.linep sc "let quickcheck_tests_%s ?gen () =" type_name;
+  F.linep sc "  Pbrt_quickcheck.Test.make ?gen quickcheck_%s" type_name;
 
   true
 
@@ -62,15 +63,24 @@ let plugin : Pb_codegen_plugin.t =
   end in
   (module P)
 
-let gen_all_tests_sig _ sc =
-  F.line sc "val all_quickcheck_tests : unit -> QCheck2.Test.t list"
+let gen_all_tests_sig ts sc =
+  F.line sc "val all_quickcheck_tests :";
+  List.iter (fun t -> F.linep sc "    ?include_%s:bool ->" (type_name t)) ts;
+  F.line sc "    unit -> QCheck2.Test.t list";
+  F.linep sc
+    "(** [all_quickcheck_tests ()] builds a test suite which, by default, \
+     includes tests for all known types. Use [~include_test:false] to exclude \
+     a particular test. *)"
 
 let gen_all_tests_struct ts sc =
-  F.line sc "let all_quickcheck_tests () =";
+  F.line sc "let all_quickcheck_tests";
+  List.iter (fun t -> F.linep sc "    ?(include_%s = true)" (type_name t)) ts;
+  F.line sc "    () =";
   F.line sc "  List.flatten [";
   List.iter
     (fun t ->
       let type_name = type_name t in
-      F.linep sc "    quickcheck_tests_%s ();" type_name)
+      F.linep sc "    if include_%s then quickcheck_tests_%s () else [];"
+        type_name type_name)
     ts;
-  F.line sc "  ]"
+  F.line sc "  ]"

src/runtime-qcheck/pbrt_quickcheck.ml

@@ -27,8 +27,12 @@ let json_roundtrip (type a) (m : a Type_class.t) (t : a) =
 module Test = struct
   type t = QCheck2.Test.t
 
-  let make (type a) ?(examples = []) (m : a Type_class.t) =
-    let gen = QCheck2.Gen.graft_corners m.gen examples () in
+  let make (type a) ?gen (m : a Type_class.t) =
+    let gen =
+      match gen with
+      | Some gen -> gen
+      | None -> m.gen
+    in
     let print a = Format.asprintf "%a" m.pp a in
     let encoder = Pbrt.Encoder.create () in
     [

src/runtime-qcheck/pbrt_quickcheck.mli

@@ -20,7 +20,8 @@ end
 module Test : sig
   type t = QCheck2.Test.t
 
-  val make : ?examples:'a list -> 'a Type_class.t -> t list
+  val make : ?gen:'a QCheck2.Gen.t -> 'a Type_class.t -> t list
   (** Generates a test suite for that type that checks that values roundtrip
-      through serializations. *)
+      through serializations. The generator to use can be overriden by
+      supplying [gen]. *)
 end

src/tests/roundtrip/main.ml

@@ -1,3 +1,8 @@
+type error = Messages.error = { error: string } [@@deriving qcheck2]
+
+let gen_error =
+  QCheck2.Gen.graft_corners gen_error [ { error = "Hello Error" } ] ()
+
 let () =
   (* Here we show how we can aggregate tests from several files and package them
      into a single executable. Individual tests may be added with specific
@@ -7,8 +12,6 @@ let () =
   QCheck_runner.run_tests_main
     (List.flatten
        [
-         Messages.quickcheck_tests_error
-           ~examples:[ { error = "Hello Error" } ]
-           ();
-         Messages.all_quickcheck_tests ();
+         Messages.quickcheck_tests_error ~gen:gen_error ();
+         Messages.all_quickcheck_tests ~include_error:false ();
        ])

src/tests/roundtrip/messages.ml.expected

@@ -294,8 +294,8 @@ let quickcheck_person =
     decode_json = decode_json_person;
   }
 
-let quickcheck_tests_person ?examples () =
-  Pbrt_quickcheck.Test.make quickcheck_person
+let quickcheck_tests_person ?gen () =
+  Pbrt_quickcheck.Test.make ?gen quickcheck_person
 
 let quickcheck_empty =
   { Pbrt_quickcheck.Type_class.
@@ -309,8 +309,8 @@ let quickcheck_empty =
     decode_json = decode_json_empty;
   }
 
-let quickcheck_tests_empty ?examples () =
-  Pbrt_quickcheck.Test.make quickcheck_empty
+let quickcheck_tests_empty ?gen () =
+  Pbrt_quickcheck.Test.make ?gen quickcheck_empty
 
 let quickcheck_error =
   { Pbrt_quickcheck.Type_class.
@@ -324,8 +324,8 @@ let quickcheck_error =
     decode_json = decode_json_error;
   }
 
-let quickcheck_tests_error ?examples () =
-  Pbrt_quickcheck.Test.make quickcheck_error
+let quickcheck_tests_error ?gen () =
+  Pbrt_quickcheck.Test.make ?gen quickcheck_error
 
 let quickcheck_unit_or_error =
   { Pbrt_quickcheck.Type_class.
@@ -339,13 +339,18 @@ let quickcheck_unit_or_error =
     decode_json = decode_json_unit_or_error;
   }
 
-let quickcheck_tests_unit_or_error ?examples () =
-  Pbrt_quickcheck.Test.make quickcheck_unit_or_error
+let quickcheck_tests_unit_or_error ?gen () =
+  Pbrt_quickcheck.Test.make ?gen quickcheck_unit_or_error
 
-let all_quickcheck_tests () =
+let all_quickcheck_tests
+    ?(include_person = true)
+    ?(include_empty = true)
+    ?(include_error = true)
+    ?(include_unit_or_error = true)
+    () =
   List.flatten [
-    quickcheck_tests_person ();
-    quickcheck_tests_empty ();
-    quickcheck_tests_error ();
-    quickcheck_tests_unit_or_error ();
+    if include_person then quickcheck_tests_person () else [];
+    if include_empty then quickcheck_tests_empty () else [];
+    if include_error then quickcheck_tests_error () else [];
+    if include_unit_or_error then quickcheck_tests_unit_or_error () else [];
   ]

src/tests/roundtrip/messages.mli.expected

@@ -118,25 +118,31 @@ val decode_json_unit_or_error : Yojson.Basic.t -> unit_or_error
 val quickcheck_person : person Pbrt_quickcheck.Type_class.t
 (** [quickcheck_person] contains helpers to test the type person with quickcheck *)
 
-val quickcheck_tests_person : ?examples:person list -> unit -> QCheck2.Test.t list
-(** [quickcheck_tests_person ?examples ()] builds a test suite for the type "person". Inputs are generated with QuickCheck. Corner cases may be supplied via the [examples] parameters. *)
+val quickcheck_tests_person : ?gen:person QCheck2.Gen.t -> unit -> QCheck2.Test.t list
+(** [quickcheck_tests_person ?gen ()] builds a test suite for the type "person". Inputs are generated with QuickCheck. Use [gen] to override the generator. *)
 
 val quickcheck_empty : empty Pbrt_quickcheck.Type_class.t
 (** [quickcheck_empty] contains helpers to test the type empty with quickcheck *)
 
-val quickcheck_tests_empty : ?examples:empty list -> unit -> QCheck2.Test.t list
-(** [quickcheck_tests_empty ?examples ()] builds a test suite for the type "empty". Inputs are generated with QuickCheck. Corner cases may be supplied via the [examples] parameters. *)
+val quickcheck_tests_empty : ?gen:empty QCheck2.Gen.t -> unit -> QCheck2.Test.t list
+(** [quickcheck_tests_empty ?gen ()] builds a test suite for the type "empty". Inputs are generated with QuickCheck. Use [gen] to override the generator. *)
 
 val quickcheck_error : error Pbrt_quickcheck.Type_class.t
 (** [quickcheck_error] contains helpers to test the type error with quickcheck *)
 
-val quickcheck_tests_error : ?examples:error list -> unit -> QCheck2.Test.t list
-(** [quickcheck_tests_error ?examples ()] builds a test suite for the type "error". Inputs are generated with QuickCheck. Corner cases may be supplied via the [examples] parameters. *)
+val quickcheck_tests_error : ?gen:error QCheck2.Gen.t -> unit -> QCheck2.Test.t list
+(** [quickcheck_tests_error ?gen ()] builds a test suite for the type "error". Inputs are generated with QuickCheck. Use [gen] to override the generator. *)
 
 val quickcheck_unit_or_error : unit_or_error Pbrt_quickcheck.Type_class.t
 (** [quickcheck_unit_or_error] contains helpers to test the type unit_or_error with quickcheck *)
 
-val quickcheck_tests_unit_or_error : ?examples:unit_or_error list -> unit -> QCheck2.Test.t list
-(** [quickcheck_tests_unit_or_error ?examples ()] builds a test suite for the type "unit_or_error". Inputs are generated with QuickCheck. Corner cases may be supplied via the [examples] parameters. *)
+val quickcheck_tests_unit_or_error : ?gen:unit_or_error QCheck2.Gen.t -> unit -> QCheck2.Test.t list
+(** [quickcheck_tests_unit_or_error ?gen ()] builds a test suite for the type "unit_or_error". Inputs are generated with QuickCheck. Use [gen] to override the generator. *)
 
-val all_quickcheck_tests : unit -> QCheck2.Test.t list
+val all_quickcheck_tests :
+    ?include_person:bool ->
+    ?include_empty:bool ->
+    ?include_error:bool ->
+    ?include_unit_or_error:bool ->
+    unit -> QCheck2.Test.t list
+(** [all_quickcheck_tests ()] builds a test suite which, by default, includes tests for all known types. Use [~include_test:false] to exclude a particular test. *)

src/tests/roundtrip/test.outputs.expected

@@ -9,4 +9,4 @@ Unit
 exception Pbrt.Decoder.Failure(Malformed_variant("unit_or_error"))
 
 ================================================================================
-failure (0 tests failed, 1 tests errored, ran 10 tests)
+failure (0 tests failed, 1 tests errored, ran 8 tests)