attempt to fix mixed public/private cases

Signed-off-by: Javier Chávarri <javier.chavarri@gmail.com>

src/dune_rules/lib.ml

@@ -418,11 +418,12 @@ type db =
 
 and resolve_result =
   | Not_found
-  | Found of Lib_info.external_ list
+  | 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) list
+  | 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)
 
@@ -1143,73 +1144,70 @@ 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
     | 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_in_the_same_db (_, name') -> find_internal db name'
     | Redirect (db', (_, name')) -> find_internal db' name'
-    | Found libs ->
+    | 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') *)
-         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)
+         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
@@ -1844,35 +1842,28 @@ end
 
 module DB = struct
   module Resolve_result = struct
-    type t = resolve_result =
-      | Not_found
-      | 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) list
-      | Redirect of db * (Loc.t * Lib_name.t)
-      | Deprecated_library_name of (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 libs = Redirect_in_the_same_db libs
+    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" []
       | Invalid e -> variant "Invalid" [ Dyn.string (User_message.to_string e) ]
-      | Found libs -> variant "Found" [ (Dyn.list (Lib_info.to_dyn Path.to_dyn)) libs ]
+      | Found lib -> variant "Found" [ Lib_info.to_dyn Path.to_dyn lib ]
       | 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 redirects ->
-        variant
-          "Redirect_in_the_same_db"
-          [ (Dyn.list (fun (_, name) -> Lib_name.to_dyn name)) redirects ]
+      | 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 ]
     ;;
@@ -1905,7 +1896,7 @@ 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) ->
             Deprecated_library_name (d.loc, d.new_public_name)
           | Ok (Hidden_library pkg) -> Hidden (Hidden.unsatisfied_exist_if pkg)

src/dune_rules/lib.mli

@@ -98,10 +98,11 @@ module DB : sig
     type t
 
     val not_found : t
-    val found : Lib_info.external_ list -> t
+    val found : Lib_info.external_ -> 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) list -> 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
 

src/dune_rules/scope.ml

@@ -25,27 +25,29 @@ module DB = struct
 
   module Found_or_redirect : sig
     type t = private
-      | Found of Lib_info.external_ list
-      | Redirect of (Loc.t * Lib_name.t) list
+      | 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 redirect_many : (Loc.t * Lib_name.t) list -> 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_ list -> t
+    val found : Lib_info.external_ -> t
   end = struct
     type t =
-      | Found of Lib_info.external_ list
-      | Redirect of (Loc.t * Lib_name.t) list
+      | 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_ ]
+      else from, Redirect (loc, to_)
     ;;
 
-    let redirect_many x = Redirect x
+    let many x = Many x
 
     let deprecated_library_name from (loc, to_) =
       if Lib_name.equal from to_
@@ -75,26 +77,22 @@ module DB = struct
           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 ->
-            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 _, 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 (List.hd info))
-          | Deprecated_library_name (loc2, lib2), Redirect redirect
-          | Redirect redirect, Deprecated_library_name (loc2, lib2) ->
-            let loc1, lib1 = List.hd redirect in
+          | 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)
-          | 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)
+          | Many _, _ | _, Many _ -> assert false
         in
         match res with
         | Ok x -> x
@@ -126,6 +124,19 @@ 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))
@@ -144,7 +155,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 =

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

@@ -54,3 +54,17 @@ For public libraries
   > EOF
 
   $ dune build
+
+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

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

@@ -55,3 +55,20 @@ For public libraries
   > EOF
 
   $ dune build
+
+Mixing public and private libraries
+
+  $ cat > a/dune << EOF
+  > (library
+  >  (name foo)
+  >  (enabled_if (= %{context_name} "default")))
+  > EOF
+
+  $ cat > b/dune << EOF
+  > (library
+  >  (name foo)
+  >  (public_name baz.foo)
+  >  (enabled_if (= %{context_name} "alt-context")))
+  > EOF
+
+  $ dune build

test/blackbox-tests/test-cases/lib-collision/lib-collision-private-same-folder.t

@@ -16,7 +16,7 @@ Without any consumers of the libraries
 
   $ dune build
   Error:
-  File "dune", line 1, characters 0-21:
+  File "dune", line 3, characters 0-21:
   Error: A library with name "foo" is defined in two folders: _build/default
   and _build/default. Either change one of the names, or enable them
   conditionally using the 'enabled_if' field.
@@ -41,7 +41,7 @@ With some consumer of the library
 
   $ dune build
   Error:
-  File "dune", line 1, characters 0-21:
+  File "dune", line 3, characters 0-21:
   Error: A library with name "foo" is defined in two folders: _build/default
   and _build/default. Either change one of the names, or enable them
   conditionally using the 'enabled_if' field.