Allow defining libs with same name in multiple contexts

src/dune_rules/gen_rules.ml

@@ -111,11 +111,32 @@ end = struct
       let+ () = Toplevel.Stanza.setup ~sctx ~dir ~toplevel in
       empty_none
     | Library.T lib ->
-      let* enabled_if = Lib.DB.available (Scope.libs scope) (Library.best_name lib) in
-      if_available_buildable
-        ~loc:lib.buildable.loc
-        (fun () -> Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander)
-        enabled_if
+      let db = Scope.libs scope in
+      (* This check reveals conflicts between the private names of public libraries,
+         otherwise the user will see duplicated rules for their cmxs *)
+      let* res = Lib.DB.find_invalid db (Library.private_name lib) in
+      (match res with
+       | Some err -> User_error.raise [ User_message.pp err ]
+       | None ->
+         let* lib_info =
+           let* ocaml =
+             let ctx = Super_context.context sctx in
+             Context.ocaml ctx
+           in
+           let lib_config = ocaml.lib_config in
+           Memo.return (Library.to_lib_info lib ~dir ~lib_config)
+         in
+         let* enabled_in_context =
+           let* enabled = Lib_info.enabled lib_info in
+           match enabled with
+           | Disabled_because_of_enabled_if -> Memo.return false
+           | Normal | Optional -> Memo.return true
+         in
+         let* available = Lib.DB.available (Scope.libs scope) (Library.best_name lib) in
+         if_available_buildable
+           ~loc:lib.buildable.loc
+           (fun () -> Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander)
+           (enabled_in_context && available))
     | Foreign.Library.T lib ->
       Expander.eval_blang expander lib.enabled_if
       >>= if_available (fun () ->

src/dune_rules/lib.ml

@@ -132,6 +132,18 @@ module Error = struct
       ]
   ;;
 
+  let duplicated ~loc ~name ~dir_a ~dir_b =
+    User_error.make
+      ~loc
+      [ Pp.textf
+          "A library with name %S is defined in two folders: %s and %s. Either change \
+           one of the names, or enable them conditionally using the 'enabled_if' field."
+          (Lib_name.to_string name)
+          (Path.to_string_maybe_quoted dir_a)
+          (Path.to_string_maybe_quoted dir_b)
+      ]
+  ;;
+
   (* diml: it is not very clear what a "default implementation cycle" is *)
   let default_implementation_cycle cycle =
     make
@@ -406,12 +418,13 @@ type db =
 
 and resolve_result =
   | Not_found
-  | Found of Lib_info.external_
+  | Found of Lib_info.external_ list
   | Hidden of Lib_info.external_ Hidden.t
   | Invalid of User_message.t
   | Ignore
-  | Redirect_in_the_same_db of (Loc.t * Lib_name.t)
+  | Redirect_in_the_same_db of (Loc.t * Lib_name.t) list
   | Redirect of db * (Loc.t * Lib_name.t)
+  | Deprecated_library_name of (Loc.t * Lib_name.t)
 
 let lib_config (t : lib) = t.lib_config
 let name t = t.name
@@ -1130,19 +1143,75 @@ end = struct
     | Hidden h -> Hidden.error h ~loc ~name >>| Option.some
   ;;
 
+  let find_in_parent ~db ~name =
+    let open Memo.O in
+    let+ res =
+      match db.parent with
+      | None -> Memo.return Status.Not_found
+      | Some db -> find_internal db name
+    in
+    res
+  ;;
+
+  let to_status ~db ~name = function
+    | [] -> find_in_parent ~db ~name
+    | info :: [] -> instantiate db name info ~hidden:None
+    | a :: b :: _ ->
+      let loc = Lib_info.loc b in
+      let dir_a = Lib_info.src_dir a in
+      let dir_b = Lib_info.src_dir b in
+      Memo.return (Status.Invalid (Error.duplicated ~loc ~name ~dir_a ~dir_b))
+  ;;
+
   let resolve_name db name =
     let open Memo.O in
     db.resolve name
     >>= function
     | Ignore -> Memo.return Status.Ignore
-    | Redirect_in_the_same_db (_, name') -> find_internal db name'
+    | Deprecated_library_name (_, name') -> find_internal db name'
+    | Redirect_in_the_same_db redirects ->
+      let result = List.map ~f:(fun (_, name') -> find_internal db name') redirects in
+      let* statuses =
+        Memo.List.map result ~f:(fun redirect ->
+          let* r = redirect in
+          Memo.return r)
+      in
+      Memo.return
+        (List.fold_left statuses ~init:Status.Not_found ~f:(fun acc status ->
+           match acc, status with
+           | Status.Found a, Status.Found b ->
+             let a = info a in
+             let b = info b in
+             let loc = Lib_info.loc b in
+             let dir_a = Lib_info.src_dir a in
+             let dir_b = Lib_info.src_dir b in
+             Status.Invalid (Error.duplicated ~loc ~name ~dir_a ~dir_b)
+           | Invalid _, _ -> acc
+           | (Found _ as lib), (Hidden _ | Ignore | Not_found | Invalid _)
+           | (Hidden _ | Ignore | Not_found), (Found _ as lib) -> lib
+           | (Hidden _ | Ignore | Not_found), (Hidden _ | Ignore | Not_found | Invalid _)
+             -> acc))
     | Redirect (db', (_, name')) -> find_internal db' name'
-    | Found info -> instantiate db name info ~hidden:None
+    | Found libs ->
+      (match libs with
+       | [] | _ :: [] ->
+         (* In case we have 0 or 1 results found, convert to [Status.t] directly.
+            This allows to provide better errors later on,
+            e.g. `Library "foo" in _build/default is hidden (unsatisfied 'enabled_if') *)
+         to_status ~db ~name libs
+       | _ :: _ :: _ ->
+         (* If there are multiple results found, we optimistically pre-filter to
+            remove those that are disabled *)
+         let* filtered_libs =
+           Memo.List.filter libs ~f:(fun lib ->
+             let+ enabled = Lib_info.enabled lib in
+             match enabled with
+             | Disabled_because_of_enabled_if -> false
+             | Normal | Optional -> true)
+         in
+         to_status ~db ~name filtered_libs)
     | Invalid e -> Memo.return (Status.Invalid e)
-    | Not_found ->
-      (match db.parent with
-       | None -> Memo.return Status.Not_found
-       | Some db -> find_internal db name)
+    | Not_found -> find_in_parent ~db ~name
     | Hidden { lib = info; reason = hidden; path = _ } ->
       (match db.parent with
        | None -> Memo.return Status.Not_found
@@ -1774,29 +1843,35 @@ module DB = struct
   module Resolve_result = struct
     type t = resolve_result =
       | Not_found
-      | Found of Lib_info.external_
+      | Found of Lib_info.external_ list
       | Hidden of Lib_info.external_ Hidden.t
       | Invalid of User_message.t
       | Ignore
-      | Redirect_in_the_same_db of (Loc.t * Lib_name.t)
+      | Redirect_in_the_same_db of (Loc.t * Lib_name.t) list
       | Redirect of db * (Loc.t * Lib_name.t)
+      | Deprecated_library_name of (Loc.t * Lib_name.t)
 
     let found f = Found f
     let not_found = Not_found
     let redirect db lib = Redirect (db, lib)
-    let redirect_in_the_same_db lib = Redirect_in_the_same_db lib
+    let redirect_in_the_same_db libs = Redirect_in_the_same_db libs
+    let deprecated_library_name lib = Deprecated_library_name lib
 
     let to_dyn x =
       let open Dyn in
       match x with
       | Not_found -> variant "Not_found" []
       | Invalid e -> variant "Invalid" [ Dyn.string (User_message.to_string e) ]
-      | Found lib -> variant "Found" [ Lib_info.to_dyn Path.to_dyn lib ]
+      | Found libs -> variant "Found" [ (Dyn.list (Lib_info.to_dyn Path.to_dyn)) libs ]
       | Hidden h -> variant "Hidden" [ Hidden.to_dyn (Lib_info.to_dyn Path.to_dyn) h ]
       | Ignore -> variant "Ignore" []
       | Redirect (_, (_, name)) -> variant "Redirect" [ Lib_name.to_dyn name ]
-      | Redirect_in_the_same_db (_, name) ->
-        variant "Redirect_in_the_same_db" [ Lib_name.to_dyn name ]
+      | Redirect_in_the_same_db redirects ->
+        variant
+          "Redirect_in_the_same_db"
+          [ (Dyn.list (fun (_, name) -> Lib_name.to_dyn name)) redirects ]
+      | Deprecated_library_name (_, name) ->
+        variant "Deprecated_library_name" [ Lib_name.to_dyn name ]
     ;;
   end
 
@@ -1827,9 +1902,9 @@ module DB = struct
           let open Memo.O in
           Findlib.find findlib name
           >>| function
-          | Ok (Library pkg) -> Found (Dune_package.Lib.info pkg)
+          | Ok (Library pkg) -> Found [ Dune_package.Lib.info pkg ]
           | Ok (Deprecated_library_name d) ->
-            Redirect_in_the_same_db (d.loc, d.new_public_name)
+            Deprecated_library_name (d.loc, d.new_public_name)
           | Ok (Hidden_library pkg) -> Hidden (Hidden.unsatisfied_exist_if pkg)
           | Error e ->
             (match e with
@@ -1866,6 +1941,14 @@ module DB = struct
     | Ignore | Not_found | Invalid _ | Hidden _ -> None
   ;;
 
+  let find_invalid t name =
+    let open Memo.O in
+    Resolve_names.find_internal t name
+    >>| function
+    | Invalid err -> Some err
+    | Found _ | Ignore | Not_found | Hidden _ -> None
+  ;;
+
   let find_even_when_hidden t name =
     let open Memo.O in
     Resolve_names.find_internal t name

src/dune_rules/lib.mli

@@ -98,10 +98,11 @@ module DB : sig
     type t
 
     val not_found : t
-    val found : Lib_info.external_ -> t
+    val found : Lib_info.external_ list -> t
     val to_dyn : t Dyn.builder
     val redirect : db -> Loc.t * Lib_name.t -> t
-    val redirect_in_the_same_db : Loc.t * Lib_name.t -> t
+    val redirect_in_the_same_db : (Loc.t * Lib_name.t) list -> t
+    val deprecated_library_name : Loc.t * Lib_name.t -> t
   end
 
   (** Create a new library database. [resolve] is used to resolve library names
@@ -121,6 +122,7 @@ module DB : sig
     -> t
 
   val find : t -> Lib_name.t -> lib option Memo.t
+  val find_invalid : t -> Lib_name.t -> User_message.t option Memo.t
   val find_even_when_hidden : t -> Lib_name.t -> lib option Memo.t
   val available : t -> Lib_name.t -> bool Memo.t
 

src/dune_rules/scope.ml

@@ -25,20 +25,32 @@ module DB = struct
 
   module Found_or_redirect : sig
     type t = private
-      | Found of Lib_info.external_
-      | Redirect of (Loc.t * Lib_name.t)
+      | Found of Lib_info.external_ list
+      | Redirect of (Loc.t * Lib_name.t) list
+      | Deprecated_library_name of (Loc.t * Lib_name.t)
 
     val redirect : Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t
-    val found : Lib_info.external_ -> t
+    val redirect_many : (Loc.t * Lib_name.t) list -> t
+    val deprecated_library_name : Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t
+    val found : Lib_info.external_ list -> t
   end = struct
     type t =
-      | Found of Lib_info.external_
-      | Redirect of (Loc.t * Lib_name.t)
+      | Found of Lib_info.external_ list
+      | Redirect of (Loc.t * Lib_name.t) list
+      | Deprecated_library_name of (Loc.t * Lib_name.t)
 
     let redirect from (loc, to_) =
       if Lib_name.equal from to_
       then Code_error.raise ~loc "Invalid redirect" [ "to_", Lib_name.to_dyn to_ ]
-      else from, Redirect (loc, to_)
+      else from, Redirect [ loc, to_ ]
+    ;;
+
+    let redirect_many x = Redirect x
+
+    let deprecated_library_name from (loc, to_) =
+      if Lib_name.equal from to_
+      then Code_error.raise ~loc "Invalid redirect" [ "to_", Lib_name.to_dyn to_ ]
+      else from, Deprecated_library_name (loc, to_)
     ;;
 
     let found x = Found x
@@ -60,17 +72,28 @@ module DB = struct
           Found_or_redirect.redirect old_public_name s.new_public_name
         | Deprecated_library_name s ->
           let old_public_name = Deprecated_library_name.old_public_name s in
-          Found_or_redirect.redirect old_public_name s.new_public_name
+          Found_or_redirect.deprecated_library_name old_public_name s.new_public_name
         | Library (dir, (conf : Library.t)) ->
           let info = Library.to_lib_info conf ~dir ~lib_config |> Lib_info.of_local in
-          Library.best_name conf, Found_or_redirect.found info)
+          Library.best_name conf, Found_or_redirect.found [ info ])
       |> Lib_name.Map.of_list_reducei ~f:(fun name (v1 : Found_or_redirect.t) v2 ->
         let res =
           match v1, v2 with
-          | Found info1, Found info2 -> Error (Lib_info.loc info1, Lib_info.loc info2)
-          | Found info, Redirect (loc, _) | Redirect (loc, _), Found info ->
-            Error (loc, Lib_info.loc info)
-          | Redirect (loc1, lib1), Redirect (loc2, lib2) ->
+          | Found info1, Found info2 ->
+            Ok (Found_or_redirect.found (List.rev_append info1 info2))
+          | Found info, Redirect redirect | Redirect redirect, Found info ->
+            let loc, _ = List.hd redirect in
+            Error (loc, Lib_info.loc (List.hd info))
+          | Found info, Deprecated_library_name (loc, _)
+          | Deprecated_library_name (loc, _), Found info ->
+            Error (loc, Lib_info.loc (List.hd info))
+          | Deprecated_library_name (loc2, lib2), Redirect redirect
+          | Redirect redirect, Deprecated_library_name (loc2, lib2) ->
+            let loc1, lib1 = List.hd redirect in
+            if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2)
+          | Redirect redirect1, Redirect redirect2 ->
+            Ok (Found_or_redirect.redirect_many (List.rev_append redirect1 redirect2))
+          | Deprecated_library_name (loc1, lib1), Deprecated_library_name (loc2, lib2) ->
             if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2)
         in
         match res with
@@ -103,6 +126,8 @@ module DB = struct
           (match Lib_name.Map.find map name with
            | None -> Lib.DB.Resolve_result.not_found
            | Some (Redirect lib) -> Lib.DB.Resolve_result.redirect_in_the_same_db lib
+           | Some (Deprecated_library_name lib) ->
+             Lib.DB.Resolve_result.deprecated_library_name lib
            | Some (Found lib) -> Lib.DB.Resolve_result.found lib))
       ~all:(fun () -> Lib_name.Map.keys map |> Memo.return)
       ~lib_config
@@ -119,7 +144,7 @@ module DB = struct
     | Some (Project project) ->
       let scope = find_by_project (Fdecl.get t) project in
       Lib.DB.Resolve_result.redirect scope.db (Loc.none, name)
-    | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db name
+    | Some (Name name) -> Lib.DB.Resolve_result.redirect_in_the_same_db [ name ]
   ;;
 
   let public_theories ~find_db ~installed_theories coq_stanzas =

src/dune_rules/stanzas/library.ml

@@ -366,6 +366,7 @@ let best_name t =
   | Public p -> snd p.name
 ;;
 
+let private_name t = Lib_name.of_local t.name
 let is_virtual t = Option.is_some t.virtual_modules
 let is_impl t = Option.is_some t.implements
 

src/dune_rules/stanzas/library.mli

@@ -72,6 +72,7 @@ val foreign_lib_files
 val archive : t -> dir:Path.Build.t -> ext:string -> Path.Build.t
 
 val best_name : t -> Lib_name.t
+val private_name : t -> Lib_name.t
 val is_virtual : t -> bool
 val is_impl : t -> bool
 val obj_dir : dir:Path.Build.t -> t -> Path.Build.t Obj_dir.t

test/blackbox-tests/test-cases/deprecated-library-name/features.t

@@ -248,8 +248,8 @@ We check that there is an error when there is an actual ambiguity:
 
   $ (cd d && dune build --root . @all)
   Error: Library top2 is defined twice:
-  - dune:13
   - dune:5
+  - dune:13
   [1]
 
 Another case of ambiguity:

test/blackbox-tests/test-cases/enabled_if/eif-library-name-collision-same-folder.t

@@ -29,10 +29,16 @@ in the same dune file
   > EOF
 
   $ dune build --display=short
-  Error: Library foo is defined twice:
-  - dune:4
-  - dune:1
-  [1]
+        ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} [alt-context]
+        ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt}
+      ocamlopt .foo.objs/native/foo.{cmx,o} [alt-context]
+        ocamlc foo.cma [alt-context]
+      ocamlopt .foo.objs/native/foo.{cmx,o}
+        ocamlc foo.cma
+      ocamlopt foo.{a,cmxa} [alt-context]
+      ocamlopt foo.{a,cmxa}
+      ocamlopt foo.cmxs [alt-context]
+      ocamlopt foo.cmxs
 
 For public libraries
 
@@ -48,7 +54,3 @@ For public libraries
   > EOF
 
   $ dune build
-  Error: Library foo is defined twice:
-  - dune:7
-  - dune:3
-  [1]