Fix and test variants

src/ppx_deriving_qcheck/QCheck_generators.ml

@@ -5,7 +5,7 @@ open Ppxlib
 
 (** {2. Type} *)
 
-let ty = "QCheck.Gen.t"
+let ty = Ldot (Ldot (Lident "QCheck", "Gen"), "t")
 
 (** {2. Primitive generators} *)
 

src/ppx_deriving_qcheck/ppx_deriving_qcheck.ml

@@ -318,7 +318,7 @@ and gen_from_variant ~loc ~env rws =
   in
   let gen = gen_sized ~loc is_rec to_gen rws in
   let typ_t = A.ptyp_constr (A.Located.mk @@ Lident env.curr_type) [] in
-  let typ_gen = A.Located.mk @@ Lident G.ty in
+  let typ_gen = A.Located.mk G.ty in
   let typ = A.ptyp_constr typ_gen [ typ_t ] in
   [%expr ([%e gen] : [%t typ])]
 

test/ppx_deriving_qcheck/deriver/dune

@@ -4,6 +4,7 @@
    test_primitives
    test_qualified_names
    test_recursive
-   test_tuple)
+   test_tuple
+   test_variants)
  (libraries qcheck-alcotest ppxlib ppx_deriving_qcheck qcheck)
  (preprocess (pps ppxlib.metaquot ppx_deriving_qcheck)))

test/ppx_deriving_qcheck/deriver/test_variants.ml

@@ -0,0 +1,81 @@
+open QCheck
+open Helpers
+
+(** {1. Test variants and polymorphic variants derivation} *)
+
+(** {2. Variants} *)
+
+type colors = Red | Green | Blue [@@deriving qcheck]
+
+let pp_colors fmt x =
+  let open Format in
+  match x with
+  | Red -> fprintf fmt "Red"
+  | Green -> fprintf fmt "Green"
+  | Blue -> fprintf fmt "Blue"
+
+let eq_colors = Alcotest.of_pp pp_colors
+
+let gen = Gen.oneofl [Red; Green; Blue]
+
+let test_variants () =
+  test_compare ~msg:"Gen.oneofl <=> deriving variants" ~eq:eq_colors gen gen_colors
+
+type poly_colors = [`Red | `Green | `Blue] [@@deriving qcheck]
+
+let pp_poly_colors fmt x =
+  let open Format in
+  match x with
+  | `Red -> fprintf fmt "`Red"
+  | `Green -> fprintf fmt "`Green"
+  | `Blue -> fprintf fmt "`Blue"
+
+let eq_poly_colors = Alcotest.of_pp pp_poly_colors
+
+let gen_poly : poly_colors Gen.t = Gen.oneofl [`Red; `Green; `Blue]
+
+let test_poly_variants () =
+  test_compare ~msg:"Gen.oneofl <=> deriving variants"
+    ~eq:eq_poly_colors gen_poly gen_poly_colors
+
+(** {2. Tests weight} *)
+
+type letters =
+  | A [@weight 0]
+  | B
+[@@deriving qcheck]
+
+let test_weight =
+  Test.make ~name:"gen_letters always produces B"
+    (make gen_letters)
+    (function
+     | A -> false
+     | B -> true)
+  |>
+    QCheck_alcotest.to_alcotest
+
+type poly_letters = [
+    | `A [@weight 0]
+    | `B
+  ]
+[@@deriving qcheck]
+
+let test_weight_poly =
+  Test.make ~name:"gen_poly_letters always produces B"
+    (make gen_poly_letters)
+    (function
+     | `A -> false
+     | `B -> true)
+  |>
+    QCheck_alcotest.to_alcotest
+
+(** {2. Execute tests} *)
+
+let () = Alcotest.run "Test_Variant"
+           [("Variants",
+             Alcotest.[
+                 test_case "test_variants" `Quick test_variants;
+                 test_case "test_poly_variants" `Quick test_poly_variants;
+                 test_weight;
+                 test_weight_poly
+           ])]