move more tests into testlib

src/core/tests/dune

@@ -1,5 +1,3 @@
-
-
 (executable
  (name check_labelled_mods)
  (modules check_labelled_mods)
@@ -18,27 +16,18 @@
  (modules test_random)
  (libraries containers))
 
-(executable
-  (name test_csexp)
-  (flags :standard -warn-error -a+8)
-  (modules test_csexp)
-  (libraries containers csexp qcheck-core qcheck))
-
 (rule
  (alias runtest)
  (locks /ctest)
  (package containers)
-  (action (run ./test_random.exe)))
+ (action
-
+  (run ./test_random.exe)))
-(rule
-  (alias runtest)
-  (locks /ctest)
-  (package containers)
-  (action (run ./test_csexp.exe)))
 
 ; what matters is that it compiles
+
 (rule
  (alias runtest)
  (locks /ctest)
  (package containers)
-  (action  (run ./check_labelled_mods.exe)))
+ (action
+  (run ./check_labelled_mods.exe)))

src/core/tests/test_csexp.ml

@@ -1,87 +0,0 @@
-
-module Q = QCheck
-module CS = CCCanonical_sexp
-
-
-module Csexp_arg = struct
-  open Csexp
-  type t = Csexp.t
-  let atom s = Atom s
-  let list l = List l
-  let match_ s ~atom ~list = match s with
-    | Atom s -> atom s
-    | List l -> list l
-  type loc = unit
-  let make_loc = None
-  let atom_with_loc ~loc:() = atom
-  let list_with_loc ~loc:() = list
-end
-
-module CS0 = CS.Make(Csexp_arg)
-module Sexp0 = CCSexp.Make(Csexp_arg)
-
-let gen_csexp (str:string Q.Gen.t) : CS0.t Q.Gen.t =
-  let open Q.Gen in
-  let open Csexp in
-  begin fix @@ fun self depth ->
-    let mklist n =
-      list_size (0 -- n) (self (depth+1)) >|= fun l -> List l
-    in
-    frequency @@ List.flatten [
-      [(3, str
-        >|= fun s -> Atom s)];
-      (match depth with
-        | 0 -> [4,mklist 25]
-        | 1 -> [2,mklist 7]
-        | 2 -> [1,mklist 2]
-        | _ -> []);
-    ]
-  end 0
-
-let rec shrink_csexp (s:Csexp.t) : Csexp.t Q.Iter.t =
-  let open Csexp in
-  let open Q.Iter in
-  match s with
-    | Atom s -> Q.Shrink.string s >|= fun s -> Atom s
-    | List l -> Q.Shrink.list ~shrink:shrink_csexp l >|= fun l -> List l
-
-let arb_csexp_pp =
-  let genstr = Q.Gen.(string_size ~gen:Q.Gen.printable (0--15)) in
-  Q.make ~print:Sexp0.to_string
-    ~shrink:shrink_csexp (gen_csexp genstr)
-
-let arb_csexp_arb =
-  (* binary-ready *)
-  let genchar = Q.Gen.(0 -- 255 >|=Char.chr) in
-  let genstr = Q.Gen.(string_size ~gen:genchar (0--15)) in
-  Q.make
-    ~print:Sexp0.to_string
-    ~shrink:shrink_csexp (gen_csexp genstr)
-
-module Make(X : sig val arb : Csexp.t Q.arbitrary end) = struct
-  open X
-  let test_print_cc_parse_csexp =
-    Q.Test.make ~count:2_000 ~name:"cc-print-csexp-parse" arb @@ fun sexp ->
-    let s = CS0.to_string sexp in
-    match Csexp.parse_string s with
-      | Ok sexp' -> sexp = sexp'
-      | Error (_,msg) -> Q.Test.fail_report msg
-
-  let test_print_csexp_parse_cc =
-    Q.Test.make ~count:2_000 ~name:"cc-parse-csexp-print" arb @@ fun sexp ->
-    let s = Csexp.to_string sexp in
-    match CS0.parse_string s with
-      | Ok sexp' -> sexp = sexp'
-      | Error msg -> Q.Test.fail_report msg
-
-  let suite = [test_print_cc_parse_csexp; test_print_csexp_parse_cc ]
-end
-
-let suite =
-  let module M1 = Make(struct let arb=arb_csexp_pp end) in
-  let module M2 = Make(struct let arb=arb_csexp_arb end) in
-  List.flatten [M1.suite; M2.suite]
-
-let () =
-  QCheck_base_runner.run_tests_main suite
-

tests/core/dune

@@ -3,4 +3,4 @@
  (flags :standard -strict-sequence -warn-error -a+8 -open CCShims_)
  (modes native)
  (libraries containers containers.bencode containers.unix threads
-   containers_testlib iter gen uutf))
+   containers_testlib iter gen uutf csexp))

tests/core/t_sexp.ml

@@ -78,3 +78,86 @@ t @@ fun () ->
       print_endline @@ Printexc.to_string e ^ "\n" ^ st;
       assert false);
   true;;
+
+module CS = CCCanonical_sexp
+
+
+module Csexp_arg = struct
+  open Csexp
+  type t = Csexp.t
+  let atom s = Atom s
+  let list l = List l
+  let match_ s ~atom ~list = match s with
+    | Atom s -> atom s
+    | List l -> list l
+  type loc = unit
+  let make_loc = None
+  let atom_with_loc ~loc:() = atom
+  let list_with_loc ~loc:() = list
+end
+
+module CS0 = CS.Make(Csexp_arg)
+module Sexp0 = CCSexp.Make(Csexp_arg)
+
+let gen_csexp (str:string Q.Gen.t) : CS0.t Q.Gen.t =
+  let open Q.Gen in
+  let open Csexp in
+  begin fix @@ fun self depth ->
+    let mklist n =
+      list_size (0 -- n) (self (depth+1)) >|= fun l -> List l
+    in
+    frequency @@ List.flatten [
+      [(3, str
+        >|= fun s -> Atom s)];
+      (match depth with
+        | 0 -> [4,mklist 25]
+        | 1 -> [2,mklist 7]
+        | 2 -> [1,mklist 2]
+        | _ -> []);
+    ]
+  end 0
+
+let rec shrink_csexp (s:Csexp.t) : Csexp.t Q.Iter.t =
+  let open Csexp in
+  let open Q.Iter in
+  match s with
+    | Atom s -> Q.Shrink.string s >|= fun s -> Atom s
+    | List l -> Q.Shrink.list ~shrink:shrink_csexp l >|= fun l -> List l
+
+let arb_csexp_pp =
+  let genstr = Q.Gen.(string_size ~gen:Q.Gen.printable (0--15)) in
+  Q.make ~print:Sexp0.to_string
+    ~shrink:shrink_csexp (gen_csexp genstr)
+
+let arb_csexp_arb =
+  (* binary-ready *)
+  let genchar = Q.Gen.(0 -- 255 >|=Char.chr) in
+  let genstr = Q.Gen.(string_size ~gen:genchar (0--15)) in
+  Q.make
+    ~print:Sexp0.to_string
+    ~shrink:shrink_csexp (gen_csexp genstr)
+
+module Make(X : sig val arb : Csexp.t Q.arbitrary end)() = struct
+  open X;;
+
+  q ~count:2_000 arb @@ fun sexp ->
+    let s = CS0.to_string sexp in
+    match Csexp.parse_string s with
+      | Ok sexp' -> sexp = sexp'
+      | Error (_,msg) -> Q.Test.fail_report msg;;
+
+  q ~count:2_000 arb @@ fun sexp ->
+    let s = Csexp.to_string sexp in
+    match CS0.parse_string s with
+      | Ok sexp' -> sexp = sexp'
+      | Error msg -> Q.Test.fail_report msg;;
+
+  let init () = ()
+end
+
+let () =
+  let module M1 = Make(struct let arb=arb_csexp_pp end)() in
+  let module M2 = Make(struct let arb=arb_csexp_arb end)() in
+  M1.init();
+  M2.init();
+  ()