Remove unix dependency in irmin-test

bench/irmin-pack/dune

@@ -15,6 +15,7 @@
   repr
   ppx_repr
   bench_common
+  mtime
   rusage))
 
 (library

bench/irmin-pack/trace_collection.ml

@@ -152,10 +152,7 @@ module Make_stat (Store : Irmin.Generic_key.KV) = struct
         }
 
     let now () =
-      Mtime_clock.now ()
-      |> Mtime.to_uint64_ns
-      |> Int64.to_float
-      |> ( *. ) Mtime.ns_to_s
+      Mtime_clock.now () |> Mtime.to_uint64_ns |> Int64.to_float |> ( *. ) 1e-9
 
     let create store_path prev_merge_durations =
       Def.

irmin-test.opam

@@ -17,7 +17,7 @@ depends: [
   "ppx_irmin"    {= version}
   "ocaml"        {>= "4.02.3"}
   "dune"         {>= "2.9.0"}
-  "alcotest"     {>= "1.5.0"}
+  "alcotest-lwt" {>= "1.5.0"}
   "mtime"        {>= "1.0.0"}
   "astring"
   "fmt"
@@ -30,7 +30,6 @@ depends: [
   "metrics" {>= "0.2.0"}
   "hex" {with-test & >= "1.4.0"}
   "vector" {with-test & >= "1.0.0"}
-  "alcotest-lwt" {with-test & >= "1.5.0"}
 ]
 
 synopsis: "Irmin test suite"

src/irmin-test/common.ml

@@ -130,7 +130,7 @@ module Suite = struct
 end
 
 module type Store_tests = functor (S : Generic_key) -> sig
-  val tests : (string * (Suite.t -> unit -> unit)) list
+  val tests : (string * (Suite.t -> unit -> unit Lwt.t)) list
 end
 
 module Make_helpers (S : Generic_key) = struct
@@ -215,48 +215,47 @@ module Make_helpers (S : Generic_key) = struct
   let run (x : Suite.t) test =
     let repo_ptr = ref None in
     let config_ptr = ref None in
-    Lwt_main.run
-      (Lwt.catch
-         (fun () ->
-           let module Conf = Irmin.Backend.Conf in
-           let generate_random_root config =
-             let id = Random.int 100 |> string_of_int in
-             let root_value =
-               match Conf.find_root config with
-               | None -> "test_" ^ id
-               | Some v -> v ^ "_" ^ id
-             in
-             let root_key = Conf.(root (spec config)) in
-             Conf.add config root_key root_value
-           in
-           let config = generate_random_root x.config in
-           config_ptr := Some config;
-           let* () = x.init ~config in
-           let* repo = S.Repo.v config in
-           repo_ptr := Some repo;
-           let* () = test repo in
-           let* () =
-             (* [test] might have already closed the repo. That
-                [ignore_thunk_errors] shall be removed as soon as all stores
-                support double closes. *)
-             ignore_thunk_errors (fun () -> S.Repo.close repo)
-           in
-           x.clean ~config)
-         (fun exn ->
-           (* [test] failed, attempt an errorless cleanup and forward the right
-              backtrace to the user. *)
-           let bt = Printexc.get_raw_backtrace () in
-           let* () =
-             match !repo_ptr with
-             | Some repo -> ignore_thunk_errors (fun () -> S.Repo.close repo)
-             | None -> Lwt.return_unit
-           in
-           let+ () =
-             match !config_ptr with
-             | Some config -> ignore_thunk_errors (fun () -> x.clean ~config)
-             | None -> Lwt.return_unit
-           in
-           Printexc.raise_with_backtrace exn bt))
+    Lwt.catch
+      (fun () ->
+        let module Conf = Irmin.Backend.Conf in
+        let generate_random_root config =
+          let id = Random.int 100 |> string_of_int in
+          let root_value =
+            match Conf.find_root config with
+            | None -> "test_" ^ id
+            | Some v -> v ^ "_" ^ id
+          in
+          let root_key = Conf.(root (spec config)) in
+          Conf.add config root_key root_value
+        in
+        let config = generate_random_root x.config in
+        config_ptr := Some config;
+        let* () = x.init ~config in
+        let* repo = S.Repo.v config in
+        repo_ptr := Some repo;
+        let* () = test repo in
+        let* () =
+          (* [test] might have already closed the repo. That
+             [ignore_thunk_errors] shall be removed as soon as all stores
+             support double closes. *)
+          ignore_thunk_errors (fun () -> S.Repo.close repo)
+        in
+        x.clean ~config)
+      (fun exn ->
+        (* [test] failed, attempt an errorless cleanup and forward the right
+           backtrace to the user. *)
+        let bt = Printexc.get_raw_backtrace () in
+        let* () =
+          match !repo_ptr with
+          | Some repo -> ignore_thunk_errors (fun () -> S.Repo.close repo)
+          | None -> Lwt.return_unit
+        in
+        let+ () =
+          match !config_ptr with
+          | Some config -> ignore_thunk_errors (fun () -> x.clean ~config)
+          | None -> Lwt.return_unit
+        in
+        Printexc.raise_with_backtrace exn bt)
 end
 
 let filter_src src =
@@ -319,3 +318,7 @@ let check_raises_lwt msg exn (type a) (f : unit -> a Lwt.t) =
             msg (Printexc.to_string exn) (Printexc.to_string e))
 
 module T = Irmin.Type
+
+module type Sleep = sig
+  val sleep : float -> unit Lwt.t
+end

src/irmin-test/dune

@@ -5,14 +5,13 @@
  (preprocess
   (pps ppx_irmin.internal))
  (libraries
-  alcotest
+  alcotest-lwt
   astring
   fmt
   irmin
   jsonm
   logs.fmt
   lwt
-  lwt.unix
   mtime
   mtime.clock.os)
  (instrumentation

src/irmin-test/irmin_test.mli

@@ -65,9 +65,10 @@ module Store : sig
     string ->
     ?slow:bool ->
     ?random_seed:int ->
-    misc:unit Alcotest.test list ->
+    sleep:(float -> unit Lwt.t) ->
+    misc:unit Alcotest_lwt.test list ->
     (Alcotest.speed_level * Suite.t) list ->
-    unit
+    unit Lwt.t
 end
 
 module Node = Node

src/irmin-test/store.ml

@@ -2412,9 +2412,9 @@ module Make (S : Generic_key) = struct
       S.Backend.Repo.close repo
     in
     (* Test collisions with the empty node (and its commit), *)
-    run x (test @@ fun () -> S.Tree.empty () |> Lwt.return);
+    let* () = run x (test @@ fun () -> S.Tree.empty () |> Lwt.return) in
     (* with a length one node, *)
-    run x (test @@ fun () -> add_entries (S.Tree.empty ()) 1);
+    run x (test @@ fun () -> add_entries (S.Tree.empty ()) 1) >>= fun () ->
     (* and with a length >256 node (which is the threshold for unstable inodes
        in irmin pack). *)
     run x (test @@ fun () -> add_entries (S.Tree.empty ()) 260)
@@ -2427,11 +2427,14 @@ let suite' l ?(prefix = "") (_, x) =
 
 let when_ b x = if b then x else []
 
-let suite (speed, x) =
+let suite sleep (speed, x) =
   let (module S) = Suite.store_generic_key x in
+  let module Zzz = struct
+    let sleep = sleep
+  end in
   let module T = Make (S) in
   let module T_graph = Store_graph.Make (S) in
-  let module T_watch = Store_watch.Make (Log) (S) in
+  let module T_watch = Store_watch.Make (Log) (Zzz) (S) in
   let with_tree_enabled =
     (* Disabled for flakiness. See https://github.com/mirage/irmin/issues/1090. *)
     not
@@ -2494,7 +2497,7 @@ let slow_suite (speed, x) =
     ]
     (speed, x)
 
-let run name ?(slow = false) ?random_seed ~misc tl =
+let run name ?(slow = false) ?random_seed ~sleep ~misc tl =
   let () =
     match random_seed with
     | Some x -> Random.init x
@@ -2503,6 +2506,6 @@ let run name ?(slow = false) ?random_seed ~misc tl =
   Printexc.record_backtrace true;
   (* Ensure that failures occuring in async lwt threads are raised. *)
   (Lwt.async_exception_hook := fun exn -> raise exn);
-  let tl1 = List.map suite tl in
+  let tl1 = List.map (suite sleep) tl in
   let tl1 = if slow then tl1 @ List.map slow_suite tl else tl1 in
-  Alcotest.run name (misc @ tl1)
+  Alcotest_lwt.run name (misc @ tl1)

src/irmin-test/store.mli

@@ -18,6 +18,7 @@ val run :
   string ->
   ?slow:bool ->
   ?random_seed:int ->
-  misc:unit Alcotest.test list ->
+  sleep:(float -> unit Lwt.t) ->
+  misc:unit Alcotest_lwt.test list ->
   (Alcotest.speed_level * Common.t) list ->
-  unit
+  unit Lwt.t

src/irmin-test/store_watch.ml

@@ -17,12 +17,16 @@
 open! Import
 open Common
 
-module Make (Log : Logs.LOG) (S : Generic_key) = struct
+module type Sleep = sig
+  val sleep : float -> unit Lwt.t
+end
+
+module Make (Log : Logs.LOG) (Zzz : Sleep) (S : Generic_key) = struct
   include Common.Make_helpers (S)
 
   let sleep ?(sleep_t = 0.01) () =
     let sleep_t = min sleep_t 1. in
-    Lwt.pause () >>= fun () -> Lwt_unix.sleep sleep_t
+    Lwt.pause () >>= fun () -> Zzz.sleep sleep_t
 
   let now_s () = Mtime.Span.to_s (Mtime_clock.elapsed ())
 
@@ -193,9 +197,7 @@ module Make (Log : Logs.LOG) (S : Generic_key) = struct
 
       let process ?sleep_t t head =
         let* () =
-          match sleep_t with
-          | None -> Lwt.return_unit
-          | Some s -> Lwt_unix.sleep s
+          match sleep_t with None -> Lwt.return_unit | Some s -> Zzz.sleep s
         in
         let () =
           match head with

src/irmin-test/store_watch.mli

@@ -14,4 +14,4 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module Make (_ : Logs.LOG) : Common.Store_tests
+module Make (_ : Logs.LOG) (_ : Common.Sleep) : Common.Store_tests

test/irmin-chunk/test.ml

@@ -22,7 +22,7 @@ let key_t : Test_chunk.Key.t Alcotest.testable = (module Test_chunk.Key)
 let value_t : Test_chunk.Value.t Alcotest.testable = (module Test_chunk.Value)
 
 let run f () =
-  Lwt_main.run (f ());
+  let+ () = f () in
   flush stderr;
   flush stdout
 
@@ -77,5 +77,7 @@ let stable =
     ] )
 
 let () =
-  Irmin_test.Store.run "irmin-chunk" ~slow:true ~misc:[ simple; stable ]
-    [ (`Quick, Test_chunk.suite) ]
+  Lwt_main.run
+  @@ Irmin_test.Store.run "irmin-chunk" ~slow:true ~misc:[ simple; stable ]
+       ~sleep:Lwt_unix.sleep
+       [ (`Quick, Test_chunk.suite) ]

test/irmin-fs/dune

@@ -11,7 +11,7 @@
 (executable
  (name test)
  (modules test)
- (libraries alcotest irmin irmin-test test_fs))
+ (libraries alcotest lwt.unix irmin irmin-test test_fs))
 
 (executable
  (name test_unix)

test/irmin-fs/test.ml

@@ -15,5 +15,6 @@
  *)
 
 let () =
-  Irmin_test.Store.run "irmin-fs" ~slow:true ~misc:[]
-    [ (`Quick, Test_fs.suite) ]
+  Lwt_main.run
+  @@ Irmin_test.Store.run "irmin-fs" ~slow:true ~misc:[] ~sleep:Lwt_unix.sleep
+       [ (`Quick, Test_fs.suite) ]

test/irmin-fs/test_unix.ml

@@ -15,5 +15,7 @@
  *)
 
 let () =
-  Irmin_test.Store.run "irmin-fs.unix" ~slow:false ~misc:[]
-    [ (`Quick, Test_fs_unix.suite) ]
+  Lwt_main.run
+  @@ Irmin_test.Store.run "irmin-fs.unix" ~slow:false ~sleep:Lwt_unix.sleep
+       ~misc:[]
+       [ (`Quick, Test_fs_unix.suite) ]

test/irmin-git/test.ml

@@ -17,5 +17,6 @@
 let misc = [ ("misc", Test_git.(misc mem)) ]
 
 let () =
-  Irmin_test.Store.run "irmin-git" ~slow:true ~misc
-    [ (`Quick, Test_git.suite); (`Quick, Test_git.suite_generic) ]
+  Lwt_main.run
+  @@ Irmin_test.Store.run "irmin-git" ~slow:true ~misc ~sleep:Lwt_unix.sleep
+       [ (`Quick, Test_git.suite); (`Quick, Test_git.suite_generic) ]

test/irmin-git/test_git.ml

@@ -228,14 +228,13 @@ let misc (module S : G) =
   let s = (module S : S) in
   let g = (module S : G) in
   let generic = (module Generic (Irmin.Contents.String) : S) in
-  let run f x () = Lwt_main.run (f x) in
   [
-    ("Testing sort order", `Quick, run test_sort_order s);
-    ("Testing sort order (generic)", `Quick, run test_sort_order generic);
-    ("Testing listing refs", `Quick, run test_list_refs g);
-    ("git -> mem", `Quick, run test_import_export s);
-    ("git blobs", `Quick, run test_blobs s);
-    ("git blobs of generic", `Quick, run test_blobs s);
+    ("Testing sort order", `Quick, fun () -> test_sort_order s);
+    ("Testing sort order (generic)", `Quick, fun () -> test_sort_order generic);
+    ("Testing listing refs", `Quick, fun () -> test_list_refs g);
+    ("git -> mem", `Quick, fun () -> test_import_export s);
+    ("git blobs", `Quick, fun () -> test_blobs s);
+    ("git blobs of generic", `Quick, fun () -> test_blobs s);
   ]
 
 let mem = (module Mem (Irmin.Contents.String) : G)

test/irmin-git/test_git.mli

@@ -29,5 +29,5 @@ module type G = sig
   module Git : Irmin_git.G
 end
 
-val misc : (module G) -> unit Alcotest.test_case list
+val misc : (module G) -> unit Alcotest_lwt.test_case list
 val mem : (module G)

test/irmin-git/test_unix.ml

@@ -16,4 +16,8 @@
 
 let misc = [ ("misc", Test_git.misc Test_git_unix.store) ]
 let suites = [ (`Quick, Test_git_unix.suite) ]
-let () = Irmin_test.Store.run "irmin-git.unix" ~misc ~slow:false suites
+
+let () =
+  Lwt_main.run
+  @@ Irmin_test.Store.run "irmin-git.unix" ~misc ~slow:false
+       ~sleep:Lwt_unix.sleep suites

test/irmin-http/test.ml

@@ -16,4 +16,5 @@
 
 let () =
   Test_http.(with_server servers) (fun () ->
-      Irmin_test.Store.run "irmin-http" ~misc:[] Test_http.(suites servers))
+      Irmin_test.Store.run "irmin-http" ~misc:[] ~sleep:Lwt_unix.sleep
+        Test_http.(suites servers))

test/irmin-http/test_http.ml

@@ -233,6 +233,6 @@ let with_server servers f =
     let id = int_of_string Sys.argv.(3) in
     Logs.set_reporter (Irmin_test.reporter ~prefix:"S" ());
     serve servers n id)
-  else f ()
+  else Lwt_main.run (f ())
 
 type test = Alcotest.speed_level * Irmin_test.Suite.t

test/irmin-http/test_http.mli

@@ -18,4 +18,4 @@ type test = Alcotest.speed_level * Irmin_test.Suite.t
 
 val servers : test list
 val suites : test list -> test list
-val with_server : test list -> (unit -> unit) -> unit
+val with_server : test list -> (unit -> unit Lwt.t) -> unit

test/irmin-mem/dune

@@ -6,7 +6,7 @@
 (executable
  (name test)
  (modules test)
- (libraries alcotest irmin-test test_mem))
+ (libraries alcotest lwt.unix irmin-test test_mem))
 
 (rule
  (alias runtest)

test/irmin-mem/test.ml

@@ -15,5 +15,6 @@
  *)
 
 let () =
-  Irmin_test.Store.run "irmin-mem" ~slow:true ~misc:[]
-    [ (`Quick, Test_mem.suite) ]
+  Lwt_main.run
+  @@ Irmin_test.Store.run "irmin-mem" ~slow:true ~misc:[] ~sleep:Lwt_unix.sleep
+       [ (`Quick, Test_mem.suite) ]