Fix root path issue with Irmin-git, and remove allow_duplicate fo…

…r root spec key

CHANGES.md

@@ -1,16 +1,23 @@
 ## Unreleased
 
-### Added
-
 ### Fixed
 
 - **irmin-client**
   - Fix a fd lead when using `clone` (#2322, @samoht)
 - **irmin**
   - Fix CI, update dependencies (#2321, @smorimoto)
 
+### Fixed
+
+- **irmin-git**
+  - Fixed issue with two subsequent `Irmin-git` repos, where one
+    repo would lose the ability to find its root path (#2326, @zazedd)
+
 ### Removed
 
+- **irmin**
+  - Removed `?allow_duplicate` parameter from the `Conf.key` function (#2326, @zazedd)
+
 ## 3.9.0 (2023-10-05)
 
 ### Added

src/irmin-cli/resolver.ml

@@ -446,8 +446,6 @@ let rec json_of_yaml : Yaml.value -> Yojson.Basic.t = function
 
 let parse_config ?root y spec =
   let config = Conf.empty spec in
-  (* Initialise root for the examples in README to pass. *)
-  let config = Conf.add config (Conf.root spec) "." in
   let config =
     List.fold_left
       (fun config k ->

src/irmin-git/conf.ml

@@ -49,15 +49,14 @@ module Key = struct
       "dot-git"
       Irmin.Type.(option string)
       None
+
+  let root = root spec
 end
 
 let init ?head ?bare ?level ?dot_git ?buffers root =
   let module C = Irmin.Backend.Conf in
   let config = C.empty spec in
-  (* Initialise an fresh root_key, otherwise [C.add config root_key root] has no
-     effect on current config. *)
-  let root_key = C.root spec in
-  let config = C.add config root_key root in
+  let config = C.add config Key.root root in
   let config =
     match bare with
     | None -> C.add config Key.bare (C.default Key.bare)

src/irmin-test/common.ml

@@ -219,14 +219,20 @@ module Make_helpers (S : Generic_key) = struct
       (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
+          let sp = Conf.spec config in
+          match Conf.Spec.find_key sp "root" with
+          | None -> config
+          | Some (K k) ->
+              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 v =
+                Irmin.Type.of_string (Conf.ty k) root_value |> Result.get_ok
+              in
+              Conf.add config k v
         in
         let config = generate_random_root x.config in
         config_ptr := Some config;

src/irmin/conf.ml

@@ -87,7 +87,7 @@ type t = Spec.t * Univ.t M.t
 
 let spec = fst
 
-let key ?docs ?docv ?doc ?(allow_duplicate = false) ~spec name ty default =
+let key ?docs ?docv ?doc ~spec name ty default =
   let () =
     String.iter
       (function
@@ -96,8 +96,7 @@ let key ?docs ?docv ?doc ?(allow_duplicate = false) ~spec name ty default =
       name
   in
   match Spec.find_key spec name with
-  | Some _ when allow_duplicate = false ->
-      Fmt.invalid_arg "duplicate key: %s" name
+  | Some _ -> Fmt.invalid_arg "duplicate key: %s" name
   | _ ->
       let to_univ, of_univ = Univ.create () in
       let k = { name; ty; default; to_univ; of_univ; doc; docv; docs } in
@@ -166,9 +165,8 @@ let equal t1 t2 =
 
 (* ~root *)
 let root spec =
-  key ~allow_duplicate:true ~spec ~docv:"ROOT"
-    ~doc:"The location of the Irmin store on disk." ~docs:"COMMON OPTIONS"
-    "root"
+  key ~spec ~docv:"ROOT" ~doc:"The location of the Irmin store on disk."
+    ~docs:"COMMON OPTIONS" "root"
     Type.(string)
     "."
 

src/irmin/conf.mli

@@ -59,7 +59,6 @@ val key :
   ?docs:string ->
   ?docv:string ->
   ?doc:string ->
-  ?allow_duplicate:bool ->
   spec:Spec.t ->
   string ->
   'a Type.t ->

test/irmin/test_conf.ml

@@ -50,9 +50,33 @@ let test_duplicate_key_names () =
   Alcotest.check_raises "Duplicate key" (Invalid_argument "duplicate key: name")
     (fun () -> ignore (key ~spec name Irmin.Type.bool false))
 
+let test_subsequent_root_paths () =
+  let spec = Spec.v "roots1" in
+  let module K = struct
+    let root = root spec
+  end in
+  let r1 = "_build/test-roots-1" in
+  let r2 = "_build/test-roots-2" in
+  let c1 = add (empty spec) K.root r1 in
+  let c2 = add (empty spec) K.root r2 in
+  Alcotest.(check string) "same string" (find_root c1 |> Option.get) r1;
+  Alcotest.(check string) "same string" (find_root c2 |> Option.get) r2
+
+let test_subsequent_root_paths_duplicate () =
+  let spec = Spec.v "roots2" in
+  let r1 = "_build/test-roots-duplicate-1" in
+  let root_key = root spec in
+  let _ = add (empty spec) root_key r1 in
+  Alcotest.check_raises "Duplicate key" (Invalid_argument "duplicate key: root")
+    (fun () -> ignore (root spec))
+
 let suite =
   [
     Alcotest_lwt.test_case_sync "conf" `Quick test_conf;
     Alcotest_lwt.test_case_sync "duplicate key names" `Quick
       test_duplicate_key_names;
+    Alcotest_lwt.test_case_sync "subsequent root paths" `Quick
+      test_subsequent_root_paths;
+    Alcotest_lwt.test_case_sync "subsequent root paths duplicate" `Quick
+      test_subsequent_root_paths_duplicate;
   ]