A => src/oth/oth.ml +108 -0
@@ 0,0 1,108 @@
+open Core.Std
+
+(*
+ * This isn't here actually but will be used to propogate
+ * options at some point
+ *)
+module State = struct
+ type t = { log : string -> unit }
+
+ let create () =
+ { log = print_string }
+end
+
+module Test = struct
+ type t = (State.t -> unit)
+end
+
+(*
+ * Global state, boo, but refactorable later.
+ *
+ * Used to track if the run of tests was successful
+ *)
+let test_success = ref true
+
+let dev_null = Fn.const ()
+
+let run_tests state test =
+ test state
+
+let serial tests state =
+ List.iter ~f:(run_tests state) tests
+
+let parallel = serial
+
+let time_call f =
+ let start = Time.now () in
+ let res = f () in
+ let stop = Time.now () in
+ let sec = Core.Span.to_sec (Time.diff stop start) in
+ (sec, res)
+
+let test ?(desc = "") ~name f state =
+ let t = fun () -> Result.try_with (fun () -> f state) in
+ match time_call t with
+ | (time, Ok ()) -> begin
+ state.State.log (sprintf "Test: %s\t\tPASSED (%0.2f sec)\n" name time);
+ ()
+ end
+ | (time, Error exn) -> begin
+ state.State.log
+ (sprintf "Test: %s\t\tFAILED (%0.2f sec)\nDescription:\n%s\nExn:\n%s\n"
+ name
+ time
+ desc
+ (Exn.to_string exn));
+ test_success := false;
+ ()
+ end
+
+let name ~name tst state =
+ let t = fun () -> run_tests state tst in
+ let (time, ()) = time_call t in
+ state.State.log
+ (sprintf "Test: %s\t\tELAPSED (%0.2f sec)\n" name time);
+ ()
+
+let result_test rtest state =
+ let res = rtest state in
+ assert (Result.is_ok res);
+ ()
+
+let test_with_revops ?desc ~name ~revops tst =
+ test
+ ?desc
+ ~name
+ (fun state -> Revops.run_in_context revops (Fn.flip tst state))
+
+let exit_of_success () =
+ match !test_success with
+ | true -> 0
+ | false -> 1
+
+let run_all_tests state t =
+ run_tests state t;
+ exit (exit_of_success ())
+
+let run t =
+ run_all_tests (State.create ()) t
+
+let loop n t =
+ let rec loop state = function
+ | i when i >= n ->
+ ()
+ | i ->
+ let () = run_tests state t in
+ loop state (i + 1)
+ in
+ (fun state -> loop state 0)
+
+let timeout span t = failwith "timeout not implemented"
+
+let verbose t state =
+ let state = { State.log = print_string } in
+ t state
+
+let silent t state =
+ let state = { State.log = dev_null } in
+ t state
A => src/oth/oth.mli +74 -0
@@ 0,0 1,74 @@
+open Core.Std
+
+module State : sig
+ type t
+end
+
+module Test : sig
+ type t
+end
+
+(*
+ * Run a test and terminate the process when complete.
+ * The exit code will be 0 on success and non zero on failure.
+ *
+ * Information will only be printed in the case of a test failure
+ *)
+val run : Test.t -> unit
+
+(*
+ * Takes a list of tests and make them runnable in parallel
+ *)
+val parallel : Test.t list -> Test.t
+
+(*
+ * Run multiple tests in serial
+ *)
+val serial : Test.t list -> Test.t
+
+(*
+ * Execute a test multiple times
+ *)
+val loop : int -> Test.t -> Test.t
+
+(*
+ * Run a test and timeout if it does not finish in a given amount of time
+ *)
+val timeout : Core.Span.t -> Test.t -> Test.t
+
+(*
+ * Turn a function into a test
+ *)
+val test : ?desc:string -> name:string -> (State.t -> unit) -> Test.t
+
+(*
+ * Name a test. This is useful for naming loops or
+ * grouped tests where you want to see the time and a name output
+ * but not for each individual run
+ *)
+val name : name:string -> Test.t -> Test.t
+
+(*
+ * Turn a test that returns a result into one that returns a unit.
+ * This asserts that the result is on the 'Ok' path.
+ *)
+val result_test :
+ (State.t -> (unit, 'err) Result.t) ->
+ State.t ->
+ unit
+
+(*
+ * Turn a function into a test with a setup and teardown phase
+ *)
+val test_with_revops :
+ ?desc:string ->
+ name:string ->
+ revops:'a Revops.Oprev.t ->
+ ('a -> State.t -> unit) ->
+ Test.t
+
+(*
+ * Combinators for making the output verbose or silent
+ *)
+val verbose : Test.t -> Test.t
+val silent : Test.t -> Test.t