Allow defining libs with same name in multiple contexts

src/dune_rules/gen_rules.ml

@@ -111,11 +111,36 @@ 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 ~expander:(Memo.return (Expander.to_expander0 expander)))
+           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
@@ -1084,7 +1098,10 @@ end = struct
   module Input = struct
     type t = Lib_name.t * Path.t Lib_info.t * string option
 
-    let equal (x, _, _) (y, _, _) = Lib_name.equal x y
+    let equal (lib_name, info, _) (lib_name', info', _) =
+      Lib_name.equal lib_name lib_name' && Lib_info.equal info info'
+    ;;
+
     let hash (x, _, _) = Lib_name.hash x
     let to_dyn = Dyn.opaque
   end
@@ -1135,9 +1152,61 @@ 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 ] -> Memo.return status
+       | _ :: _ :: _ ->
+         Memo.return
+           (List.fold_left libs ~init:Status.Not_found ~f:(fun acc status ->
+              match acc, status with
+              | Status.Found a, Status.Found b ->
+                let a = info a
+                and b = info b in
+                let loc = Lib_info.loc b in
+                let dir_a = Lib_info.best_src_dir a in
+                let dir_b = Lib_info.best_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 +1841,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 +1861,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 +1897,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 +1934,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/lib_info.ml

@@ -659,3 +659,21 @@ let for_dune_package
          (let dir = Obj_dir.dir obj_dir in
           fun p -> if Path.is_managed p then Path.relative dir (Path.basename p) else p)
 ;;
+
+let equal
+  (type a)
+  (t : a t)
+  { loc; name; kind; src_dir; orig_src_dir; obj_dir; path_kind; _ }
+  =
+  let path_equal : a -> a -> bool =
+    match (path_kind : a path) with
+    | Local -> Path.Build.equal
+    | External -> Path.equal
+  in
+  Loc.equal t.loc loc
+  && Lib_name.equal t.name name
+  && Lib_kind.equal t.kind kind
+  && path_equal src_dir t.src_dir
+  && Option.equal path_equal orig_src_dir t.orig_src_dir
+  && Obj_dir.equal obj_dir t.obj_dir
+;;

src/dune_rules/lib_info.mli

@@ -229,3 +229,4 @@ val create
 
 val package : _ t -> Package.Name.t option
 val to_dyn : 'path Dyn.builder -> 'path t Dyn.builder
+val equal : 'a t -> 'a t -> bool

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,7 +74,7 @@ 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 =
             let expander = Expander0.get ~dir in
@@ -70,11 +84,18 @@ module DB = struct
       |> 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
@@ -107,7 +128,22 @@ 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 (Found lib) -> Lib.DB.Resolve_result.found lib)
+        | Some (Found lib) -> Lib.DB.Resolve_result.found 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)
       ~all:(fun () -> Memo.return @@ Lib_name.Map.keys map)
       ~lib_config
       ~instrument_with

src/dune_rules/stanzas/library.ml

@@ -369,6 +369,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: