diff --git a/src/compilerlib/pb_codegen_quickcheck.ml b/src/compilerlib/pb_codegen_quickcheck.ml index 52bf62bc..4b656d8d 100644 --- a/src/compilerlib/pb_codegen_quickcheck.ml +++ b/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 " ]" \ No newline at end of file diff --git a/src/runtime-qcheck/pbrt_quickcheck.ml b/src/runtime-qcheck/pbrt_quickcheck.ml index be44c474..03d4c0db 100644 --- a/src/runtime-qcheck/pbrt_quickcheck.ml +++ b/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 [ diff --git a/src/runtime-qcheck/pbrt_quickcheck.mli b/src/runtime-qcheck/pbrt_quickcheck.mli index 8bd8a832..bb37ea5c 100644 --- a/src/runtime-qcheck/pbrt_quickcheck.mli +++ b/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 diff --git a/src/tests/roundtrip/main.ml b/src/tests/roundtrip/main.ml index eb611d12..e74aece4 100644 --- a/src/tests/roundtrip/main.ml +++ b/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 (); ]) diff --git a/src/tests/roundtrip/messages.ml.expected b/src/tests/roundtrip/messages.ml.expected index bd12aee5..bdeaad7c 100644 --- a/src/tests/roundtrip/messages.ml.expected +++ b/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 []; ] \ No newline at end of file diff --git a/src/tests/roundtrip/messages.mli.expected b/src/tests/roundtrip/messages.mli.expected index 08781960..c1a0eda4 100644 --- a/src/tests/roundtrip/messages.mli.expected +++ b/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 \ No newline at end of file +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. *) \ No newline at end of file diff --git a/src/tests/roundtrip/test.outputs.expected b/src/tests/roundtrip/test.outputs.expected index 2553f9ce..07fdb365 100644 --- a/src/tests/roundtrip/test.outputs.expected +++ b/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)