suggested changes

src/irmin-pack/unix/errors.ml

@@ -72,7 +72,7 @@ type base_error =
   | `Inconsistent_store
   | `Split_forbidden_during_batch
   | `Multiple_empty_chunks
-  | `Cannot_run_during_gc ]
+  | `Forbidden_during_gc ]
 [@@deriving irmin ~pp]
 (** [base_error] is the type of most errors that can occur in a [result], except
     for errors that have associated exceptions (see below) and backend-specific

src/irmin-pack/unix/ext.ml

@@ -248,25 +248,26 @@ module Maker (Config : Conf.S) = struct
                 cancelled
             | None -> false
 
+          let direct_commit_key t key =
+            let state : _ Pack_key.state = Pack_key.inspect key in
+            match state with
+            | Direct _ -> Ok key
+            | Indexed h -> (
+                match Commit.CA.index_direct_with_kind t.commit h with
+                | None ->
+                    Error
+                      (`Commit_key_is_dangling
+                        (Irmin.Type.to_string XKey.t key))
+                | Some (k, _kind) -> Ok k)
+
           let start ~unlink ~use_auto_finalisation ~new_files_path t commit_key
               =
             let open Result_syntax in
             [%log.info "GC: Starting on %a" pp_key commit_key];
             let* () =
               if t.during_batch then Error `Gc_forbidden_during_batch else Ok ()
             in
-            let* commit_key =
-              let state : _ Pack_key.state = Pack_key.inspect commit_key in
-              match state with
-              | Direct _ -> Ok commit_key
-              | Indexed h -> (
-                  match Commit.CA.index_direct_with_kind t.commit h with
-                  | None ->
-                      Error
-                        (`Commit_key_is_dangling
-                          (Irmin.Type.to_string XKey.t commit_key))
-                  | Some (k, _kind) -> Ok k)
-            in
+            let* commit_key = direct_commit_key t commit_key in
             let root = Conf.root t.config in
             let* () =
               if not (File_manager.gc_allowed t.fm) then Error `Gc_disallowed
@@ -356,20 +357,34 @@ module Maker (Config : Conf.S) = struct
                     Some key)
 
           let create_one_commit_store t commit_key path =
-            let () = Io.mkdir path |> Errs.raise_if_error in
+            let () =
+              match Io.classify_path path with
+              | `Directory -> ()
+              | `No_such_file_or_directory ->
+                  Io.mkdir path |> Errs.raise_if_error
+              | _ -> Errs.raise_error `Invalid_layout
+            in
+            let commit_key =
+              direct_commit_key t commit_key |> Errs.raise_if_error
+            in
             let* launched =
               start_exn ~use_auto_finalisation:false ~new_files_path:path t
                 commit_key
             in
             let () =
-              if not launched then Errs.raise_error `Cannot_run_during_gc
+              if not launched then Errs.raise_error `Forbidden_during_gc
             in
-            let* () =
+            let* latest_gc_target_offset, suffix_start_offset =
               match t.running_gc with
               | None -> assert false
-              | Some { gc; _ } ->
-                  Gc.finalise_and_create_one_commit_store ~new_store_root:path
-                    t.config gc commit_key
+              | Some { gc; _ } -> Gc.finalise_without_swap gc
+            in
+            let generation = File_manager.generation t.fm + 1 in
+            let config = Irmin.Backend.Conf.add t.config Conf.Key.root path in
+            let () =
+              File_manager.create_one_commit_store t.fm config ~generation
+                ~latest_gc_target_offset ~suffix_start_offset commit_key
+              |> Errs.raise_if_error
             in
             let branch_path = Irmin_pack.Layout.V4.branch ~root:path in
             let* branch_store =

src/irmin-pack/unix/file_manager.ml

@@ -798,17 +798,18 @@ struct
     let chunk_num = pl.chunk_num in
     cleanup ~root ~generation ~chunk_start_idx ~chunk_num
 
-  let create_one_commit_store config ~generation ~new_store_root
-      ~latest_gc_target_offset ~suffix_start_offset commit_key =
+  let create_one_commit_store t config ~generation ~latest_gc_target_offset
+      ~suffix_start_offset commit_key =
     let open Result_syntax in
-    let root = Irmin_pack.Conf.root config in
+    let src_root = t.root in
+    let dst_root = Irmin_pack.Conf.root config in
     (* Step 1. Copy the dict *)
-    let src_dict = Irmin_pack.Layout.V4.dict ~root in
-    let dst_dict = Irmin_pack.Layout.V4.dict ~root:new_store_root in
+    let src_dict = Irmin_pack.Layout.V4.dict ~root:src_root in
+    let dst_dict = Irmin_pack.Layout.V4.dict ~root:dst_root in
     let* () = Io.copy_file ~src:src_dict ~dst:dst_dict in
     (* Step 2. Create an empty suffix and close it. *)
     let* suffix =
-      Suffix.create_rw ~root:new_store_root ~overwrite:false
+      Suffix.create_rw ~root:dst_root ~overwrite:false
         ~auto_flush_threshold:1_000_000 ~auto_flush_procedure:`Internal
         ~start_idx:1
     in
@@ -835,15 +836,15 @@ struct
         chunk_start_idx = 1;
       }
     in
-    let path = Irmin_pack.Layout.V4.control ~root:new_store_root in
+    let path = Irmin_pack.Layout.V4.control ~root:dst_root in
     let* control = Control.create_rw ~path ~overwrite:false pl in
     let* () = Control.close control in
     (* Step 4. Create the index. *)
     let* index =
       let log_size = Conf.index_log_size config in
       let throttle = Conf.merge_throttle config in
       Index.v ~fresh:true ~flush_callback:Fun.id ~readonly:false ~throttle
-        ~log_size new_store_root
+        ~log_size dst_root
     in
     (* Step 5. Add the commit to the index, close the index. *)
     let () =

src/irmin-pack/unix/file_manager_intf.ml

@@ -258,14 +258,14 @@ module type S = sig
   val split : t -> (unit, [> Errs.t ]) result
 
   val create_one_commit_store :
+    t ->
     Irmin.Backend.Conf.t ->
     generation:int ->
-    new_store_root:string ->
     latest_gc_target_offset:int63 ->
     suffix_start_offset:int63 ->
     Index.key Pack_key.t ->
     (unit, [> open_rw_error | close_error ]) result
-  (** [create_one_commit_store conf generation new_store_root key] is called
+  (** [create_one_commit_store t conf generation new_store_root key] is called
       when creating a new store at [new_store_root] from the existing one,
       containing only one commit, specified by the [key]. Ths new store will use
       configuration options from [conf] and set to [generation]. *)

src/irmin-pack/unix/gc.ml

@@ -282,17 +282,11 @@ module Make (Args : Gc_args.S) = struct
           | `Running -> Lwt.return_ok `Running
           | #Async.outcome as status -> go status)
 
-  let finalise_and_create_one_commit_store ~new_store_root config t commit_key =
+  let finalise_without_swap t =
     let* status = Async.await t.task in
     match status with
     | `Success ->
-        let () =
-          Fm.create_one_commit_store config ~generation:t.generation
-            ~new_store_root ~latest_gc_target_offset:t.latest_gc_target_offset
-            ~suffix_start_offset:t.new_suffix_start_offset commit_key
-          |> Errs.raise_if_error
-        in
-        Lwt.return_unit
+        Lwt.return (t.latest_gc_target_offset, t.new_suffix_start_offset)
     | _ ->
         let gc_output = read_gc_output ~root:t.root ~generation:t.generation in
         let r = gc_errors status gc_output |> Errs.raise_if_error in

src/irmin-pack/unix/gc.mli

@@ -53,7 +53,11 @@ module Make (Args : Gc_args.S) : sig
 
   val cancel : t -> bool
 
-  val finalise_and_create_one_commit_store :
-    new_store_root:string -> Irmin.Backend.Conf.t -> t -> Args.key -> unit Lwt.t
+  val finalise_without_swap : t -> (int63 * int63) Lwt.t
+  (** Waits for the current gc to finish and returns immediately without
+      swapping the files and doing the other finalisation steps from [finalise].
+
+      It returns the [latest_gc_target_offset] and the
+      [new_suffix_start_offset]. *)
 end
 with module Args = Args

src/irmin-pack/unix/io_errors.ml

@@ -76,7 +76,7 @@ module Make (Io : Io.S) : S with module Io = Io = struct
     | `Io_misc of Io.misc_error
     | `Split_forbidden_during_batch
     | `Multiple_empty_chunks
-    | `Cannot_run_during_gc ]
+    | `Forbidden_during_gc ]
   [@@deriving irmin]
 
   let raise_error = function