26c801f9a37a draft — orbitz 8 years ago
Move files to their respective locations
2 files changed, 182 insertions(+), 0 deletions(-)

A => src/oth/oth.ml
A => src/oth/oth.mli
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