mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
move more tests into testlib
This commit is contained in:
Simon Cruanes
parent
3b2cd786e2
commit
55b59b5b91
4 changed files with 108 additions and 123 deletions
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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();
|
||||
()
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue