Allow defining libs with same name in multiple contexts

src/dune_rules/gen_rules.ml

@@ -111,11 +111,33 @@ 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 surfaces conflicts between private names of public libraries,
+         without it the user might get duplicated rules errors for cmxs
+         when the libraries are defined in the same folder and have the same private name *)
+      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
@@ -411,7 +423,9 @@ and resolve_result =
   | Invalid of User_message.t
   | Ignore
   | Redirect_in_the_same_db of (Loc.t * Lib_name.t)
+  | Multiple_results of resolve_result 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
@@ -1135,9 +1149,65 @@ end = struct
     db.resolve name
     >>= function
     | Ignore -> Memo.return Status.Ignore
+    | Deprecated_library_name (_, name') -> find_internal db name'
     | Redirect_in_the_same_db (_, name') -> find_internal db name'
     | Redirect (db', (_, name')) -> find_internal db' name'
     | Found info -> instantiate db name info ~hidden:None
+    | Multiple_results libs ->
+      let* libs =
+        Memo.List.filter_map
+          ~f:(function
+            | Ignore -> Memo.return (Some Status.Ignore)
+            | Deprecated_library_name (_, name') ->
+              find_internal db name' >>| fun f -> Some f
+            | Redirect_in_the_same_db (_, name') ->
+              find_internal db name' >>| fun f -> Some f
+            | Redirect (db', (_, name')) -> find_internal db' name' >>| fun f -> Some f
+            | Found info ->
+              let* enabled = Lib_info.enabled info in
+              (match enabled with
+               | Disabled_because_of_enabled_if -> Memo.return None
+               | Normal | Optional ->
+                 instantiate db name info ~hidden:None >>| fun f -> Some f)
+            | Multiple_results _libs ->
+              (* There can't be nested Multiple_results *) assert false
+            | Invalid e -> Memo.return (Some (Status.Invalid e))
+            | Not_found ->
+              (match db.parent with
+               | None -> Memo.return (Some Status.Not_found)
+               | Some db -> find_internal db name >>| fun f -> Some f)
+            | Hidden { lib = info; reason = hidden; path = _ } ->
+              (match db.parent with
+               | None -> Memo.return Status.Not_found
+               | Some db -> find_internal db name)
+              >>= (function
+               | Status.Found _ as x -> Memo.return (Some x)
+               | _ -> instantiate db name info ~hidden:(Some hidden) >>| fun f -> Some f))
+          libs
+      in
+      (match libs with
+       | [] -> assert false
+       | [ status ] ->
+         (* 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') *)
+         Memo.return status
+       | _ :: _ :: _ as statuses ->
+         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)))
     | Invalid e -> Memo.return (Status.Invalid e)
     | Not_found ->
       (match db.parent with
@@ -1772,21 +1842,16 @@ end
 
 module DB = struct
   module Resolve_result = struct
-    type t = resolve_result =
-      | Not_found
-      | Found of Lib_info.external_
-      | 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 of db * (Loc.t * Lib_name.t)
+    type t = resolve_result
 
     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 multiple_results libs = Multiple_results libs
+    let deprecated_library_name lib = Deprecated_library_name lib
 
-    let to_dyn x =
+    let rec to_dyn x =
       let open Dyn in
       match x with
       | Not_found -> variant "Not_found" []
@@ -1797,6 +1862,10 @@ module DB = struct
       | 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 ]
+      | Multiple_results redirects ->
+        variant "Multiple_results" [ (Dyn.list to_dyn) redirects ]
+      | Deprecated_library_name (_, name) ->
+        variant "Deprecated_library_name" [ Lib_name.to_dyn name ]
     ;;
   end
 
@@ -1829,7 +1898,7 @@ module DB = struct
           >>| function
           | 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 +1935,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

@@ -102,6 +102,8 @@ module DB : sig
     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 multiple_results : 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 +123,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

@@ -27,20 +27,34 @@ module DB = struct
     type t = private
       | Found of Lib_info.external_
       | Redirect of (Loc.t * Lib_name.t)
+      | Many of 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 many : t list -> t
+    val deprecated_library_name : Lib_name.t -> Loc.t * Lib_name.t -> Lib_name.t * t
     val found : Lib_info.external_ -> t
   end = struct
     type t =
       | Found of Lib_info.external_
       | Redirect of (Loc.t * Lib_name.t)
+      | Many of 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_)
     ;;
 
+    let many x = Many 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
   end
 
@@ -60,18 +74,25 @@ 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)
       |> 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 _, Found _
+          | Found _, Redirect _
+          | Redirect _, Found _
+          | Redirect _, Redirect _ -> Ok (Found_or_redirect.many [ v1; v2 ])
+          | Found info, Deprecated_library_name (loc, _)
+          | Deprecated_library_name (loc, _), Found info -> Error (loc, Lib_info.loc info)
+          | Deprecated_library_name (loc2, lib2), Redirect (loc1, lib1)
+          | Redirect (loc1, lib1), Deprecated_library_name (loc2, lib2) ->
             if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2)
+          | Deprecated_library_name (loc1, lib1), Deprecated_library_name (loc2, lib2) ->
+            if Lib_name.equal lib1 lib2 then Ok v1 else Error (loc1, loc2)
+          | Many _, _ | _, Many _ -> assert false
         in
         match res with
         | Ok x -> x
@@ -103,6 +124,21 @@ 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 (Many libs) ->
+             let results =
+               List.map
+                 ~f:(function
+                   | Found_or_redirect.Redirect lib ->
+                     Lib.DB.Resolve_result.redirect_in_the_same_db lib
+                   | Found lib -> Lib.DB.Resolve_result.found lib
+                   | Deprecated_library_name lib ->
+                     Lib.DB.Resolve_result.deprecated_library_name lib
+                   | Many _ -> assert false)
+                 libs
+             in
+             Lib.DB.Resolve_result.multiple_results results
+           | 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

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,17 @@ For public libraries
   > EOF
 
   $ dune build
-  Error: Library foo is defined twice:
-  - dune:7
-  - dune:3
-  [1]
+
+Mixing public and private libraries
+
+  $ cat > dune << EOF
+  > (library
+  >  (name foo)
+  >  (enabled_if (= %{context_name} "default")))
+  > (library
+  >  (name foo)
+  >  (public_name baz.foo)
+  >  (enabled_if (= %{context_name} "alt-context")))
+  > EOF
+
+  $ dune build