diff --git a/test/ppx_deriving_qcheck/deriver/qcheck/test_textual.ml b/test/ppx_deriving_qcheck/deriver/qcheck/test_textual.ml index 4ba46d1f..063968ad 100644 --- a/test/ppx_deriving_qcheck/deriver/qcheck/test_textual.ml +++ b/test/ppx_deriving_qcheck/deriver/qcheck/test_textual.ml @@ -118,7 +118,7 @@ let test_int64' () = * ] * in * let actual = f @@ extract [%stri type t = Bytes.t ] in - * + * * check_eq ~expected ~actual "deriving int64" *) let test_tuple () = @@ -820,28 +820,28 @@ let test_unused_variable () = | _ -> QCheck.Gen.frequency [(1, (QCheck.Gen.pure A)); - (1, (QCheck.Gen.map (fun gen0 -> B gen0) gen_myint))] - and gen_myint = QCheck.Gen.nat - ]; - [%stri - let gen_c = QCheck.Gen.sized gen_c_sized + (1, (QCheck.Gen.map (fun gen0 -> B gen0) (gen_myint_sized (n / 2))))] + and gen_myint_sized _n = QCheck.Gen.nat ]; + [%stri let gen_c = QCheck.Gen.sized gen_c_sized]; + [%stri let gen_myint = QCheck.Gen.sized gen_myint_sized]; [%stri let arb_c_sized n = QCheck.make @@ (gen_c_sized n)]; - [%stri let arb_myint = QCheck.make @@ gen_myint]; + [%stri let arb_myint_sized _n = QCheck.make @@ (gen_myint_sized _n)]; [%stri let arb_c = QCheck.make @@ gen_c]; + [%stri let arb_myint = QCheck.make @@ gen_myint]; [%stri - let rec gen_c_sized _n = + let rec gen_c_sized n = QCheck.Gen.frequency - [(1, (QCheck.Gen.map (fun gen0 -> A gen0) gen_myint)); - (1, (QCheck.Gen.map (fun gen0 -> B gen0) gen_myint))] - and gen_myint = QCheck.Gen.nat + [(1, (QCheck.Gen.map (fun gen0 -> A gen0) (gen_myint_sized (n / 2)))); + (1, (QCheck.Gen.map (fun gen0 -> B gen0) (gen_myint_sized (n / 2))))] + and gen_myint_sized _n = QCheck.Gen.nat ]; - [%stri - let gen_c = QCheck.Gen.sized gen_c_sized - ]; - [%stri let arb_c_sized _n = QCheck.make @@ (gen_c_sized _n)]; - [%stri let arb_myint = QCheck.make @@ gen_myint]; + [%stri let gen_c = QCheck.Gen.sized gen_c_sized]; + [%stri let gen_myint = QCheck.Gen.sized gen_myint_sized]; + [%stri let arb_c_sized n = QCheck.make @@ (gen_c_sized n)]; + [%stri let arb_myint_sized _n = QCheck.make @@ (gen_myint_sized _n)]; [%stri let arb_c = QCheck.make @@ gen_c]; + [%stri let arb_myint = QCheck.make @@ gen_myint]; ] in let actual = diff --git a/test/ppx_deriving_qcheck/deriver/qcheck2/dune b/test/ppx_deriving_qcheck/deriver/qcheck2/dune index 091a1bfd..bfd4b6e0 100644 --- a/test/ppx_deriving_qcheck/deriver/qcheck2/dune +++ b/test/ppx_deriving_qcheck/deriver/qcheck2/dune @@ -7,6 +7,7 @@ test_recursive test_tuple test_variants + test_mutual test_record) (libraries qcheck-alcotest ppxlib ppx_deriving_qcheck qcheck-core) (preprocess (pps ppxlib.metaquot ppx_deriving_qcheck))) diff --git a/test/ppx_deriving_qcheck/deriver/qcheck2/test_mutual.ml b/test/ppx_deriving_qcheck/deriver/qcheck2/test_mutual.ml new file mode 100644 index 00000000..8bf35478 --- /dev/null +++ b/test/ppx_deriving_qcheck/deriver/qcheck2/test_mutual.ml @@ -0,0 +1,54 @@ +open QCheck2 +open Helpers + +type tree = Leaf | Node of tree * tree +and name = { a: tree } +[@@deriving qcheck2] + +let rec pp_tree fmt x = + let open Format in + match x with + | Leaf -> + fprintf fmt "Leaf" + | Node (l, r) -> + fprintf fmt "Node (%a, %a)" + (pp_tree ) l + (pp_tree ) r + +let eq_tree = Alcotest.of_pp (pp_tree ) + +let gen_tree_ref = + let open Gen in + sized @@ fix (fun self -> + function + | 0 -> pure Leaf + | n -> + oneof [ + pure Leaf; + map2 (fun l r -> Node (l,r)) (self (n/2)) (self (n/2)); + ]) + +let test_tree_ref () = + + test_compare ~msg:"gen tree <=> derivation tree" + ~eq:(eq_tree ) + (gen_tree_ref) (gen_tree ) + +let test_leaf = + Test.make + ~name:"gen_tree_sized 0 = Node (_, Leaf, Leaf)" + (gen_tree_sized 0) + (function + | Leaf -> true + | Node (Leaf, Leaf) -> true + | _ -> false) + |> + QCheck_alcotest.to_alcotest + + +let () = Alcotest.run "Test_Recursive" + [("Recursive", + Alcotest.[ + test_case "test_tree_ref" `Quick test_tree_ref; + + ])]