Roundtrip tests with QuickCheck

dune-project

@@ -1,4 +1,4 @@
-(lang dune 2.0)
+(lang dune 2.2)
 (name ocaml-protoc)
 (generate_opam_files true)
 (version 3.0.1)
@@ -47,3 +47,32 @@
     (pbrt_yojson (= :version)))
   (tags (protobuf encode decode services rpc)))
 
+(package
+  (name pbrt_quickcheck)
+  (synopsis "Runtime library for ocaml-protoc to support tests based on quickcheck")
+  (depends
+    (ocaml (>= 4.08))
+    (pbrt (= :version))
+    (pbrt_yojson (= :version))
+    (ppx_deriving (>= 5.2))
+    (qcheck (>= 0.21))
+    (qcheck-core (>= 0.21))
+    (yojson (>= 1.6)))
+  (tags (protobuf encode decode quickcheck rpc)))
+
+(package
+  (name ocaml-protoc-tests)
+  (synopsis "Tests for ocaml-protoc and pbrt* packages")
+  (depends
+    (ocaml (>= 4.08))
+    (odoc :with-doc)
+    (ocaml-protoc (= :version))
+    (pbrt (= :version))
+    (pbrt_yojson (= :version))
+    (pbrt_services (= :version))
+    (ppx_deriving (>= 5.2))
+    (ppx_deriving_qcheck (>= 0.4))
+    (qcheck (>= 0.21))
+    (qcheck-core (>= 0.21))
+    (yojson (>= 1.6))))
+

ocaml-protoc-tests.opam

@@ -0,0 +1,38 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "3.0.1"
+synopsis: "Tests for ocaml-protoc and pbrt* packages"
+maintainer: ["Maxime Ransan <[email protected]>" "Simon Cruanes"]
+authors: ["Maxime Ransan <[email protected]>" "Simon Cruanes"]
+license: "MIT"
+homepage: "https://github.com/mransan/ocaml-protoc"
+bug-reports: "https://github.com/mransan/ocaml-protoc/issues"
+depends: [
+  "dune" {>= "2.2"}
+  "ocaml" {>= "4.08"}
+  "odoc" {with-doc}
+  "ocaml-protoc" {= version}
+  "pbrt" {= version}
+  "pbrt_yojson" {= version}
+  "pbrt_services" {= version}
+  "ppx_deriving" {>= "5.2"}
+  "ppx_deriving_qcheck" {>= "0.4"}
+  "qcheck" {>= "0.21"}
+  "qcheck-core" {>= "0.21"}
+  "yojson" {>= "1.6"}
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/mransan/ocaml-protoc.git"

ocaml-protoc.opam

@@ -9,7 +9,7 @@ tags: ["protoc" "protobuf" "codegen"]
 homepage: "https://github.com/mransan/ocaml-protoc"
 bug-reports: "https://github.com/mransan/ocaml-protoc/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
   "odoc" {with-doc}
   "pbrt" {= version}
   "pbrt_yojson" {= version & with-test}

pbrt.opam

@@ -9,7 +9,7 @@ tags: ["protobuf" "encode" "decode"]
 homepage: "https://github.com/mransan/ocaml-protoc"
 bug-reports: "https://github.com/mransan/ocaml-protoc/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
   "stdlib-shims"
   "odoc" {with-doc}
   "ocaml" {>= "4.08"}

pbrt_quickcheck.opam

@@ -0,0 +1,36 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "3.0.1"
+synopsis:
+  "Runtime library for ocaml-protoc to support tests based on quickcheck"
+maintainer: ["Maxime Ransan <[email protected]>" "Simon Cruanes"]
+authors: ["Maxime Ransan <[email protected]>" "Simon Cruanes"]
+license: "MIT"
+tags: ["protobuf" "encode" "decode" "quickcheck" "rpc"]
+homepage: "https://github.com/mransan/ocaml-protoc"
+bug-reports: "https://github.com/mransan/ocaml-protoc/issues"
+depends: [
+  "dune" {>= "2.2"}
+  "ocaml" {>= "4.08"}
+  "pbrt" {= version}
+  "pbrt_yojson" {= version}
+  "ppx_deriving" {>= "5.2"}
+  "qcheck" {>= "0.21"}
+  "qcheck-core" {>= "0.21"}
+  "yojson" {>= "1.6"}
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/mransan/ocaml-protoc.git"

pbrt_services.opam

@@ -9,7 +9,7 @@ tags: ["protobuf" "encode" "decode" "services" "rpc"]
 homepage: "https://github.com/mransan/ocaml-protoc"
 bug-reports: "https://github.com/mransan/ocaml-protoc/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
   "ocaml" {>= "4.08"}
   "pbrt" {= version}
   "pbrt_yojson" {= version}

pbrt_yojson.opam

@@ -10,7 +10,7 @@ tags: ["protobuf" "encode" "decode"]
 homepage: "https://github.com/mransan/ocaml-protoc"
 bug-reports: "https://github.com/mransan/ocaml-protoc/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
   "ocaml" {>= "4.08"}
   "odoc" {with-doc}
   "yojson" {>= "1.6"}

src/compilerlib/dune

@@ -12,10 +12,11 @@
    pb_codegen_decode_bs pb_codegen_decode_yojson pb_codegen_default
    pb_codegen_make pb_codegen_encode_binary pb_codegen_encode_bs
    pb_codegen_encode_yojson pb_codegen_formatting pb_codegen_ocaml_type_dump
-   pb_codegen_ocaml_type pb_codegen_pp pb_codegen_plugin pb_codegen_types
-   pb_codegen_services pb_codegen_util pb_exception pb_field_type pb_location
-   pb_logger pb_option pb_parsing pb_parsing_lexer pb_parsing_parser
-   pb_parsing_parse_tree pb_parsing_util pb_typing_graph pb_typing
-   pb_typing_recursion pb_typing_resolution pb_typing_type_tree
-   pb_typing_util pb_typing_validation pb_util pb_format_util)
+   pb_codegen_ocaml_type pb_codegen_pp pb_codegen_quickcheck
+   pb_codegen_plugin pb_codegen_types pb_codegen_services pb_codegen_util
+   pb_exception pb_field_type pb_location pb_logger pb_option pb_parsing
+   pb_parsing_lexer pb_parsing_parser pb_parsing_parse_tree pb_parsing_util
+   pb_typing_graph pb_typing pb_typing_recursion pb_typing_resolution
+   pb_typing_type_tree pb_typing_util pb_typing_validation pb_util
+   pb_format_util)
  (libraries stdlib-shims))

src/compilerlib/pb_codegen_all.ml

@@ -139,6 +139,10 @@ let generate_services (self : ocaml_mod) services : unit =
   generate_for_all_services services self.mli generate_service_sig
     (Some "Services")
 
+let generate_all_quickeck_tests (self : ocaml_mod) ocaml_types : unit =
+  Pb_codegen_quickcheck.gen_all_tests_sig ocaml_types self.mli;
+  Pb_codegen_quickcheck.gen_all_tests_struct ocaml_types self.ml
+
 let generate_plugin (self : ocaml_mod) ocaml_types (p : Plugin.t) : unit =
   let (module P) = p in
   F.line self.ml "[@@@ocaml.warning \"-27-30-39\"]";
@@ -148,14 +152,16 @@ let generate_plugin (self : ocaml_mod) ocaml_types (p : Plugin.t) : unit =
   ()
 
 let codegen (proto : Ot.proto) ~generate_make:gen_make ~proto_file_options
-    ~proto_file_name ~services (plugins : Plugin.t list) : ocaml_mod =
+    ~proto_file_name ~services ~quickcheck (plugins : Plugin.t list) : ocaml_mod
+    =
   let self = new_ocaml_mod ~proto_file_options ~proto_file_name () in
   generate_type_and_default self proto.proto_types;
   if List.exists Pb_codegen_plugin.requires_mutable_records plugins then
     generate_mutable_records self proto.proto_types;
   if gen_make then generate_make self proto.proto_types;
   List.iter (generate_plugin self proto.proto_types) plugins;
-
+  if quickcheck then
+    generate_all_quickeck_tests self (List.flatten proto.proto_types);
   (* services come last, they need binary and json *)
   if services then generate_services self proto.proto_services;
   self

src/compilerlib/pb_codegen_all.mli

@@ -15,6 +15,7 @@ val codegen :
   proto_file_options:Pb_option.set ->
   proto_file_name:string ->
   services:bool ->
+  quickcheck:bool ->
   Plugin.t list ->
   ocaml_mod
 (** [codegen types] returns a full code listing for the [.ml]

src/compilerlib/pb_codegen_quickcheck.ml

@@ -0,0 +1,88 @@
+module Ot = Pb_codegen_ocaml_type
+module F = Pb_codegen_formatting
+
+let type_name t =
+  match t with
+  | { Ot.spec = Ot.Record { Ot.r_name; _ }; _ } -> r_name
+  | { Ot.spec = Ot.Variant v; _ } -> v.Ot.v_name
+  | { Ot.spec = Ot.Const_variant { Ot.cv_name; _ }; _ } -> cv_name
+  | { Ot.spec = Ot.Unit { Ot.er_name; _ }; _ } -> er_name
+
+let gen_sig ?and_:_ t sc =
+  let type_name = type_name t in
+  F.linep sc "val quickcheck_%s : %s Pbrt_quickcheck.Type_class.t" type_name
+    type_name;
+  F.linep sc
+    "(** [quickcheck_%s] contains helpers to test the type %s with quickcheck \
+     *)"
+    type_name type_name;
+  F.empty_line sc;
+  F.linep sc
+    "val quickcheck_tests_%s : ?gen:%s QCheck2.Gen.t -> unit -> QCheck2.Test.t \
+     list"
+    type_name type_name;
+  F.linep sc
+    "(** [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
+
+let gen_struct ?and_:_ t sc =
+  let type_name = type_name t in
+  F.linep sc "let quickcheck_%s =" type_name;
+  F.linep sc "  { Pbrt_quickcheck.Type_class.";
+  F.linep sc "    type_name = %S;" type_name;
+  let field f = F.linep sc "    %s = %s_%s;" f f type_name in
+  List.iter field
+    [
+      "pp";
+      "gen";
+      "equal";
+      "encode_pb";
+      "decode_pb";
+      "encode_json";
+      "decode_json";
+    ];
+  F.linep sc "  }";
+  F.empty_line sc;
+  F.linep sc "let quickcheck_tests_%s ?gen () =" type_name;
+  F.linep sc "  Pbrt_quickcheck.Test.make ?gen quickcheck_%s" type_name;
+
+  true
+
+let ocamldoc_title = "QuickCheck"
+let requires_mutable_records = false
+
+let plugin : Pb_codegen_plugin.t =
+  let module P = struct
+    let gen_sig = gen_sig
+    let gen_struct = gen_struct
+    let ocamldoc_title = ocamldoc_title
+    let requires_mutable_records = requires_mutable_records
+  end in
+  (module P)
+
+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. *)";
+  F.empty_line sc
+
+let gen_all_tests_struct ts sc =
+  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 "    if include_%s then quickcheck_tests_%s () else [];"
+        type_name type_name)
+    ts;
+  F.line sc "  ]";
+  F.empty_line sc

src/compilerlib/pb_codegen_quickcheck.mli

@@ -0,0 +1,16 @@
+(** Plugin that generates values for QuickCheck tests. *)
+
+include Pb_codegen_plugin.S
+
+val plugin : Pb_codegen_plugin.t
+
+(** {2 Aggregating all tests}
+
+    In addition to generate a test for each message type, we also generate an
+    aggregate values with all the available tests, so they're easy to run. *)
+
+val gen_all_tests_sig :
+  Pb_codegen_ocaml_type.type_ list -> Pb_codegen_formatting.scope -> unit
+
+val gen_all_tests_struct :
+  Pb_codegen_ocaml_type.type_ list -> Pb_codegen_formatting.scope -> unit

src/compilerlib/pb_codegen_types.ml

@@ -83,10 +83,42 @@ let gen_const_variant ?and_ { Ot.cv_name; cv_constructors } sc =
 let gen_unit ?and_ { Ot.er_name } sc =
   F.linep sc "%s %s = unit" (type_decl_of_and and_) er_name
 
-let print_ppx_extension { Ot.type_level_ppx_extension; _ } sc =
-  match type_level_ppx_extension with
-  | None -> ()
-  | Some ppx_content -> F.linep sc "[@@%s]" ppx_content
+type ocaml_file_kind =
+  | Struct
+  | Sig
+
+let print_ppx_extension { Ot.type_level_ppx_extension; _ } sc ~ocaml_file_kind =
+  (* Here we document the hack that is used below. The issue is that [qcheck2]
+     doesn't currently support being present in signatures, yet it is needed by
+     the implementation of the [--quickcheck] flag. What we achieve here is that
+     we filter this extension out if it is present and we are generating a
+     signature. This can all be reverted once [qcheck] supports signatures. *)
+  let type_level_ppx_extension =
+    match type_level_ppx_extension, ocaml_file_kind with
+    | None, (Struct | Sig) -> type_level_ppx_extension
+    | Some _, Struct -> type_level_ppx_extension
+    | Some ppx_content, Sig ->
+      let parts = String.split_on_char ',' ppx_content in
+      let has_qcheck, parts =
+        List.fold_right
+          (fun part (has_qcheck, acc) ->
+            if has_qcheck then
+              true, part :: acc
+            else if String.equal (String.trim part) "qcheck2" then
+              true, acc
+            else
+              false, part :: acc)
+          parts (false, [])
+      in
+      if has_qcheck then (
+        match parts with
+        | [] -> None
+        | _ :: _ -> Some (String.concat "," parts)
+      ) else
+        type_level_ppx_extension
+  in
+  type_level_ppx_extension
+  |> Option.iter (fun ppx_content -> F.linep sc "[@@%s]" ppx_content)
 
 let gen_struct_full ~with_mutable_records ?and_ t scope =
   let { Ot.spec; _ } = t in
@@ -95,7 +127,7 @@ let gen_struct_full ~with_mutable_records ?and_ t scope =
   | Ot.Variant v -> gen_variant ?and_ v scope
   | Ot.Const_variant v -> gen_const_variant ?and_ v scope
   | Ot.Unit v -> gen_unit ?and_ v scope);
-  print_ppx_extension t scope;
+  print_ppx_extension t scope ~ocaml_file_kind:Struct;
 
   (match spec with
   | Ot.Record r when with_mutable_records -> gen_record_mutable r scope
@@ -113,7 +145,7 @@ let gen_sig ?and_ t scope =
   | Ot.Variant v -> gen_variant ?and_ v scope
   | Ot.Const_variant v -> gen_const_variant ?and_ v scope
   | Ot.Unit v -> gen_unit ?and_ v scope);
-  print_ppx_extension t scope;
+  print_ppx_extension t scope ~ocaml_file_kind:Sig;
   true
 
 let ocamldoc_title = "Types"