feat(testlib): allow ?long arg

This commit is contained in:
Simon Cruanes 2022-07-05 21:28:54 -04:00
parent 8b751754ba
commit af77f371fd
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 12 additions and 5 deletions

View file

@ -44,7 +44,7 @@ module Test = struct
[@@@endif]
let run ~seed (self : t) : _ result =
let run ?(long = false) ~seed (self : t) : _ result =
match
let what = CCOption.map_or ~default:"" (fun s -> s ^ " ") self.name in
match self.run with
@ -113,7 +113,7 @@ module Test = struct
in
(* TODO: if verbose, print stats, etc. *)
let res = Q.Test.check_cell ~rand cell in
let res = Q.Test.check_cell ~long ~rand cell in
(match get_state res with
| QCheck.TestResult.Success -> Ok ()
@ -229,7 +229,12 @@ let make ~__FILE__ () : (module S) =
let getenv_opt s = try Some (Sys.getenv s) with _ -> None
let run_all ?seed:seed_hex ~descr (l : Test.t list list) : unit =
let long =
match getenv_opt "LONG" with
| Some ("true" | "1") -> true
| _ -> false
let run_all ?seed:seed_hex ?(long = long) ~descr (l : Test.t list list) : unit =
let start = Unix.gettimeofday () in
(* generate or parse seed *)
@ -264,7 +269,7 @@ let run_all ?seed:seed_hex ~descr (l : Test.t list list) : unit =
NOTE: we probably want this to be silent?
Format.printf "> run %s@." (Test.str_loc t);
*)
match Test.run ~seed t with
match Test.run ~long ~seed t with
| Ok () -> ()
| Error msg ->
Format.printf "FAILED: %s@." (Test.str_loc t);

View file

@ -32,4 +32,6 @@ module type S = sig
end
val make : __FILE__:string -> unit -> (module S)
val run_all : ?seed:string -> descr:string -> Test.t list list -> unit
val run_all :
?seed:string -> ?long:bool -> descr:string -> Test.t list list -> unit