fix deprecated lib tests

brings the changes from ocaml#10231

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

src/dune_rules/lib.ml

@@ -424,6 +424,7 @@ and resolve_result =
   | 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)
 
 let lib_config (t : lib) = t.lib_config
 let name t = t.name
@@ -1167,6 +1168,7 @@ end = struct
     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 =
@@ -1847,11 +1849,13 @@ module DB = struct
       | 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)
 
     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 deprecated_library_name lib = Deprecated_library_name lib
 
     let to_dyn x =
       let open Dyn in
@@ -1866,6 +1870,8 @@ module DB = struct
         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
 
@@ -1898,7 +1904,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

src/dune_rules/lib.mli

@@ -102,6 +102,7 @@ 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) 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

src/dune_rules/scope.ml

@@ -27,14 +27,17 @@ module DB = struct
     type t = private
       | 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 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_ 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_
@@ -43,6 +46,13 @@ module DB = struct
     ;;
 
     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
   end
 
@@ -62,7 +72,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
@@ -76,10 +86,18 @@ module DB = struct
             Ok (Found_or_redirect.found (List.rev_append info1 info2))
           | Found info, Redirect redirect | Redirect redirect, Found info ->
             let loc, _ = List.hd redirect in
-            (* todo: should this not be an error? *)
             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
         | Ok x -> x
@@ -108,12 +126,13 @@ module DB = struct
       ~parent:(Some parent)
       ~resolve:(fun name ->
         Memo.return
-        @@
-        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)
-      ~all:(fun () -> Memo.return @@ Lib_name.Map.keys map)
+          (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
       ~instrument_with
   ;;

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

@@ -184,15 +184,6 @@ Check that we can use the short name in library dependencies.
   > EOF
 
   $ (cd d && dune build --root . @all)
-  File "dune", line 2, characters 0-68:
-  2 | (library
-  3 |  (name menhirLib)
-  4 |  (public_name menhir.lib)
-  5 |  (modules lib))
-  Error: A library with name "menhirLib" 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.
-  [1]
 
 Checks that we can migrate top-level libraries across packages.
 
@@ -256,6 +247,10 @@ We check that there is an error when there is an actual ambiguity:
   > EOF
 
   $ (cd d && dune build --root . @all)
+  Error: Library top2 is defined twice:
+  - dune:5
+  - dune:13
+  [1]
 
 Another case of ambiguity: