libirmin: reuse a single eio scheduler across calls

src/libirmin/config.ml

@@ -93,7 +93,7 @@ module Make (I : Cstubs_inverted.INTERNAL) = struct
         try
           let hash = Option.map Irmin_cli.Resolver.Hash.find hash in
           let c =
-            Irmin_cli.Resolver.load_config ~env ~store:"irf" ?hash ?contents ()
+            Irmin_cli.Resolver.load_config ~env ~store:"fs" ?hash ?contents ()
           in
           Root.create_config c
         with _ -> null config)

src/libirmin/util.ml

@@ -14,10 +14,66 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+module Scheduler : sig
+  val run_env : (Irmin_cli.eio -> 'a) -> 'a
+  val run : (unit -> 'a) -> 'a
+end = struct
+  type env = Irmin_cli.eio
+
+  let run_env fn =
+    Eio_main.run @@ fun env ->
+    Lwt_eio.with_event_loop ~clock:env#clock @@ fun () ->
+    Eio.Switch.run @@ fun sw ->
+    let env :> env =
+      object
+        method cwd = Eio.Stdenv.cwd env
+        method clock = Eio.Stdenv.clock env
+        method sw = sw
+      end
+    in
+    fn env
+
+  open Effect.Shallow
+
+  let eio = ref (fiber run_env)
+
+  let () =
+    at_exit @@ fun () ->
+    continue_with !eio
+      (fun _ -> ())
+      { retc = (fun () -> ()); exnc = raise; effc = (fun _ -> None) }
+
+  let run_env (type ret) (fn : env -> ret) : ret =
+    let open struct
+      type _ Effect.t += Return : (ret, exn) result -> (env -> unit) Effect.t
+    end in
+    continue_with !eio
+      (fun env ->
+        let x = try Ok (fn env) with e -> Error e in
+        let next = Effect.perform (Return x) in
+        next env)
+      {
+        retc = (fun _ -> assert false);
+        exnc = raise;
+        effc =
+          (fun (type a) (e : a Effect.t) ->
+            match e with
+            | Return x ->
+                Some
+                  (fun (k : (a, _) continuation) ->
+                    eio := k;
+                    match x with Ok x -> x | Error e -> raise e)
+            | _ -> None);
+      }
+
+  let run fn = run_env (fun _ -> fn ())
+end
+
 module Make (I : Cstubs_inverted.INTERNAL) = struct
   include Ctypes
   include Types
   include Unsigned
+  include Scheduler
 
   let find_config_key config name =
     Irmin.Backend.Conf.Spec.find_key (Irmin.Backend.Conf.spec config) name
@@ -43,21 +99,6 @@ module Make (I : Cstubs_inverted.INTERNAL) = struct
 
   let fn name t f = I.internal ~runtime_lock:false ("irmin_" ^ name) t f
 
-  let run_env fn =
-    Eio_main.run @@ fun env ->
-    Lwt_eio.with_event_loop ~clock:env#clock @@ fun () ->
-    Eio.Switch.run @@ fun sw ->
-    let env =
-      object
-        method cwd = Eio.Stdenv.cwd env
-        method clock = Eio.Stdenv.clock env
-        method sw = sw
-      end
-    in
-    fn (env :> Irmin_cli.eio)
-
-  let run fn = run_env (fun _ -> fn ())
-
   module Root = struct
     let to_voidp t x = Ctypes.coerce t (ptr void) x
 

test/libirmin/test.c

@@ -17,10 +17,7 @@ TEST test_irmin_value_json(void) {
   PASS();
 }
 
-TEST test_irmin_store(void) {
-  // Setup config
-  AUTO IrminConfig *config = irmin_config_git_mem(NULL);
-
+TEST test_irmin_store(IrminConfig *config) {
   // Initialize repo and store
   AUTO IrminRepo *repo = irmin_repo_new(config);
   AUTO Irmin *store = irmin_main(repo);
@@ -104,6 +101,16 @@ TEST test_irmin_store(void) {
   PASS();
 }
 
+TEST test_irmin_store_git(void) {
+  AUTO IrminConfig *config = irmin_config_git_mem(NULL);
+  return test_irmin_store(config);
+}
+
+TEST test_irmin_store_fs(void) {
+  AUTO IrminConfig *config = irmin_config_fs("sha1", "string");
+  return test_irmin_store(config);
+}
+
 TEST test_irmin_tree(void) {
   // Setup config
   AUTO IrminConfig *config = irmin_config_mem(NULL, NULL);
@@ -158,7 +165,9 @@ int main(int argc, char *argv[]) {
   GREATEST_MAIN_BEGIN();
   irmin_log_level("error");
   RUN_TEST(test_irmin_value_json);
-  RUN_TEST(test_irmin_store);
+  RUN_TEST(test_irmin_store_git);
+  RUN_TEST(test_irmin_store_fs);
   RUN_TEST(test_irmin_tree);
+  caml_shutdown();
   GREATEST_MAIN_END();
 }