From 55b59b5b915085a105d609d841a3ce3ab641f774 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 2 Jul 2022 22:25:29 -0400 Subject: [PATCH] move more tests into testlib --- src/core/tests/dune | 59 ++++++++++-------------- src/core/tests/test_csexp.ml | 87 ------------------------------------ tests/core/dune | 2 +- tests/core/t_sexp.ml | 83 ++++++++++++++++++++++++++++++++++ 4 files changed, 108 insertions(+), 123 deletions(-) delete mode 100644 src/core/tests/test_csexp.ml diff --git a/src/core/tests/dune b/src/core/tests/dune index 7a26dadc..a270978b 100644 --- a/src/core/tests/dune +++ b/src/core/tests/dune @@ -1,44 +1,33 @@ - +(executable + (name check_labelled_mods) + (modules check_labelled_mods) + (flags :standard -warn-error -a -w -3-33-35-27-39-50 -nolabels) + (libraries containers)) (executable - (name check_labelled_mods) - (modules check_labelled_mods) - (flags :standard -warn-error -a -w -3-33-35-27-39-50 -nolabels) - (libraries containers)) + (name test_hash) + (modules test_hash) + (flags :standard -warn-error -a+8) + (libraries containers iter)) (executable - (name test_hash) - (modules test_hash) - (flags :standard -warn-error -a+8) - (libraries containers iter)) - -(executable - (name test_random) - (flags :standard -warn-error -a+8) - (modules test_random) - (libraries containers)) - -(executable - (name test_csexp) - (flags :standard -warn-error -a+8) - (modules test_csexp) - (libraries containers csexp qcheck-core qcheck)) + (name test_random) + (flags :standard -warn-error -a+8) + (modules test_random) + (libraries containers)) (rule - (alias runtest) - (locks /ctest) - (package containers) - (action (run ./test_random.exe))) - -(rule - (alias runtest) - (locks /ctest) - (package containers) - (action (run ./test_csexp.exe))) + (alias runtest) + (locks /ctest) + (package containers) + (action + (run ./test_random.exe))) ; what matters is that it compiles + (rule - (alias runtest) - (locks /ctest) - (package containers) - (action (run ./check_labelled_mods.exe))) + (alias runtest) + (locks /ctest) + (package containers) + (action + (run ./check_labelled_mods.exe))) diff --git a/src/core/tests/test_csexp.ml b/src/core/tests/test_csexp.ml deleted file mode 100644 index eb66022d..00000000 --- a/src/core/tests/test_csexp.ml +++ /dev/null @@ -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 - diff --git a/tests/core/dune b/tests/core/dune index 4c4c96a4..062b32b7 100644 --- a/tests/core/dune +++ b/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)) diff --git a/tests/core/t_sexp.ml b/tests/core/t_sexp.ml index f0004b43..7aa933c1 100644 --- a/tests/core/t_sexp.ml +++ b/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(); + ()