Merge pull request #272 from jmid/is_rec_typ_deriver_bug

Fix is_rec_typ deriver bug(s)

CHANGELOG.md

@@ -6,6 +6,9 @@
   `Test.check_exn` honor test polarity by raising
   `Test_unexpected_success` when a negative test (expected to have a
   counter example), unexpectedly succeeds.
+- fix issue with `ppx_deriving_qcheck` deriving a generator with unbound
+  `gen` for recursive types [#269](https://github.com/c-cube/qcheck/issues/269)
+  and a related issue when deriving a generator for a record type
 - ...
 
 ## 0.20

src/ppx_deriving_qcheck/ppx_deriving_qcheck.ml

@@ -111,8 +111,9 @@ let rec longident_to_str = function
       Printf.sprintf "%s %s" (longident_to_str lg1) (longident_to_str lg2)
 
 let rec is_rec_typ env = function
-  | { ptyp_desc = Ptyp_constr ({ txt = x; _ }, _); _ } ->
-     List.exists (fun typ_name -> longident_to_str x = typ_name) env.Env.curr_types
+  | { ptyp_desc = Ptyp_constr ({ txt = x; _ }, args); _ } ->
+     List.exists (fun typ_name -> longident_to_str x = typ_name) env.Env.curr_types ||
+     List.exists (is_rec_typ env) args
   | { ptyp_desc = Ptyp_tuple xs; _ } -> List.exists (is_rec_typ env) xs
   | { ptyp_desc = Ptyp_variant (rws, _, _); _ } ->
      List.exists (is_rec_row_field env) rws
@@ -128,7 +129,7 @@ and is_rec_row_field env rw =
 let is_rec_constr_decl env cd =
   match cd.pcd_args with
   | Pcstr_tuple cts -> List.exists (is_rec_typ env) cts
-  | _ -> false
+  | Pcstr_record ldcls -> List.exists (fun ldcl -> is_rec_typ env ldcl.pld_type) ldcls
 
 (** [is_rec_type_decl env typ] looks for elements of [env.curr_types]
     recursively in [typ]. *)

test/ppx_deriving_qcheck/deriver/qcheck/test_textual.ml

@@ -860,6 +860,41 @@ let test_unused_variable () =
   in
   check_eq ~expected ~actual "deriving variant with unused fuel parameter"
 
+(* Regression test: https://github.com/c-cube/qcheck/issues/269 *)
+let test_faulty_is_rec_typ_in_variant () =
+  let expected =
+    [
+      [%stri let rec gen_sized n =
+               QCheck.Gen.map (fun gen0 -> Foo gen0) (QCheck.Gen.list (gen_sized (n / 2)))];
+      [%stri let gen = QCheck.Gen.sized gen_sized];
+      [%stri let arb_sized n = QCheck.make @@ (gen_sized n)];
+      [%stri let arb = QCheck.make @@ gen];
+    ]
+  in
+  let actual = f @@ extract [%stri type t = Foo of t list]
+  in
+  check_eq ~expected ~actual "deriving rec type in a type constructor inside variant"
+
+let test_faulty_is_rec_constr_decl () =
+  let expected =
+    [
+      [%stri let rec gen_sized n =
+               match n with
+               | 0 -> QCheck.Gen.pure Foo
+               | _ ->
+                 QCheck.Gen.frequency
+                   [(1, (QCheck.Gen.pure Foo));
+                    (1,
+                     (QCheck.Gen.map (fun gen0 -> Bar { baz = gen0 })
+                        (gen_sized (n / 2))))]];
+      [%stri let gen = QCheck.Gen.sized gen_sized];
+      [%stri let arb_sized n = QCheck.make @@ (gen_sized n)];
+      [%stri let arb = QCheck.make @@ gen];
+    ]
+  in
+  let actual = f @@ extract [%stri type t = Foo | Bar of { baz : t }]
+  in
+  check_eq ~expected ~actual "deriving rec type in a type constructor inside record"
 
 let () =
   Alcotest.(
@@ -907,5 +942,13 @@ let () =
               "deriving variant with unused fuel parameter"
               `Quick
               test_unused_variable;
+            test_case
+              "deriving rec type in a type constructor inside variant"
+              `Quick
+              test_faulty_is_rec_typ_in_variant;
+            test_case
+              "deriving rec type in a type constructor inside record"
+              `Quick
+              test_faulty_is_rec_constr_decl;
           ] );
       ])