simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 11:15:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

feat(testlib): optional name for all tests

Browse source
This commit is contained in:
Simon Cruanes 2022-07-04 16:07:58 -04:00
parent 856e73d2b2
commit cc55e4cdfb
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 46 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
src/testlib/containers_testlib.ml
View file

@ -7,7 +7,7 @@ type 'a print = 'a -> string
module Test = struct module Test = struct
type run = type run =
| T of (unit -> bool) | T of { prop: unit -> bool }
| Eq : { eq: 'a eq option; print: 'a print option; lhs: 'a; rhs: 'a } -> run | Eq : { eq: 'a eq option; print: 'a print option; lhs: 'a; rhs: 'a } -> run
| Q : { | Q : {
count: int option; count: int option;
@ -17,11 +17,16 @@ module Test = struct
} }
-> run -> run
type t = { run: run; __FILE__: string; n: int } type t = { name: string option; run: run; __FILE__: string; n: int }
(** Location for this test *) (** Location for this test *)
let str_loc (self : t) : string = let str_loc (self : t) : string =
Printf.sprintf "(test :file '%s' :n %d)" self.__FILE__ self.n let what =
match self.name with
| None -> ""
| Some f -> spf " :name %S" f
in
Printf.sprintf "(test :file '%s'%s :n %d)" self.__FILE__ what self.n
[@@@ifge 4.08] [@@@ifge 4.08]
@ -38,12 +43,15 @@ module Test = struct
let run ~seed (self : t) : _ result = let run ~seed (self : t) : _ result =
match match
let what = CCOption.map_or ~default:"" (fun s -> s ^ " ") self.name in
match self.run with match self.run with
| T f -> | T { prop } ->
if f () then let fail msg = Error (spf "%sfailed: %s" what msg) in
Ok ()
else (match prop () with
Error "failed: returns false" | exception e -> fail (spf "raised %s" (Printexc.to_string e))
| true -> Ok ()
| false -> fail "returns false")
| Eq { eq; print; lhs; rhs } -> | Eq { eq; print; lhs; rhs } ->
let eq = let eq =
match eq with match eq with
@ -55,8 +63,9 @@ module Test = struct
else ( else (
let msg = let msg =
match print with match print with
| None -> "failed: not equal" | None -> spf "%sfailed: not equal" what
| Some p -> spf "failed: not equal:\nlhs=%s\nrhs=%s" (p lhs) (p rhs) | Some p ->
spf "%s failed: not equal:\nlhs=%s\nrhs=%s" what (p lhs) (p rhs)
in in
Error msg Error msg
) )
@ -97,18 +106,18 @@ module Test = struct
| QCheck.TestResult.Success -> Ok () | QCheck.TestResult.Success -> Ok ()
| QCheck.TestResult.Failed { instances } -> | QCheck.TestResult.Failed { instances } ->
let msg = let msg =
Format.asprintf "@[<v2>failed on instances:@ %a@]" Format.asprintf "@[<v2>%sfailed on instances:@ %a@]" what
(Fmt.list ~sep:(Fmt.return ";@ ") pp_cex) (Fmt.list ~sep:(Fmt.return ";@ ") pp_cex)
instances instances
in in
Error msg Error msg
| QCheck.TestResult.Failed_other { msg } -> | QCheck.TestResult.Failed_other { msg } ->
let msg = spf "failed: %s" msg in let msg = spf "%sfailed: %s" what msg in
Error msg Error msg
| QCheck.TestResult.Error { instance; exn; backtrace } -> | QCheck.TestResult.Error { instance; exn; backtrace } ->
let msg = let msg =
Format.asprintf "@[<v2>raised %s@ on instance %a@ :backtrace %s@]" Format.asprintf "@[<v2>%sraised %s@ on instance %a@ :backtrace %s@]"
(Printexc.to_string exn) pp_cex instance backtrace what (Printexc.to_string exn) pp_cex instance backtrace
in in
Error msg) Error msg)
with with
@ -119,11 +128,16 @@ end
module type S = sig module type S = sig
module Q = QCheck module Q = QCheck
val t : (unit -> bool) -> unit val t : ?name:string -> (unit -> bool) -> unit
val eq : ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit val eq : ?name:string -> ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit
val q : val q :
?count:int -> ?long_factor:int -> 'a Q.arbitrary -> ('a -> bool) -> unit ?name:string ->
?count:int ->
?long_factor:int ->
'a Q.arbitrary ->
('a -> bool) ->
unit
val assert_equal : val assert_equal :
?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> 'a -> 'a -> unit ?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> 'a -> 'a -> unit
@ -144,18 +158,18 @@ struct
let add_ t = all_ := t :: !all_ let add_ t = all_ := t :: !all_
let n_ = ref 0 let n_ = ref 0
let mk run : Test.t = let mk ?name run : Test.t =
let n = !n_ in let n = !n_ in
incr n_; incr n_;
{ __FILE__ = X.file; n; run } { __FILE__ = X.file; name; n; run }
let t f : unit = add_ @@ mk @@ Test.T f let t ?name f : unit = add_ @@ mk ?name @@ Test.T { prop = f }
let eq ?cmp ?printer lhs rhs : unit = let eq ?name ?cmp ?printer lhs rhs : unit =
add_ @@ mk @@ Test.Eq { eq = cmp; print = printer; lhs; rhs } add_ @@ mk ?name @@ Test.Eq { eq = cmp; print = printer; lhs; rhs }
let q ?count ?long_factor arb prop : unit = let q ?name ?count ?long_factor arb prop : unit =
add_ @@ mk @@ Test.Q { arb; prop; count; long_factor } add_ @@ mk ?name @@ Test.Q { arb; prop; count; long_factor }
let assert_equal ?printer ?(cmp = ( = )) x y : unit = let assert_equal ?printer ?(cmp = ( = )) x y : unit =
if not @@ cmp x y then ( if not @@ cmp x y then (

11
src/testlib/containers_testlib.mli
View file

@ -8,11 +8,16 @@ end
module type S = sig module type S = sig
module Q = QCheck module Q = QCheck
val t : (unit -> bool) -> unit val t : ?name:string -> (unit -> bool) -> unit
val eq : ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit val eq : ?name:string -> ?cmp:'a eq -> ?printer:'a print -> 'a -> 'a -> unit
val q : val q :
?count:int -> ?long_factor:int -> 'a Q.arbitrary -> ('a -> bool) -> unit ?name:string ->
?count:int ->
?long_factor:int ->
'a Q.arbitrary ->
('a -> bool) ->
unit
val assert_equal : val assert_equal :
?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> 'a -> 'a -> unit ?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> 'a -> 'a -> unit