Fix #3727

src/dune_rules/dune_file.ml

@@ -1809,20 +1809,43 @@ module Include_subdirs = struct
     enum opts_list
 end
 
+module Library_redirect = struct
+  type 'old_name t =
+    { project : Dune_project.t
+    ; loc : Loc.t
+    ; old_name : 'old_name
+    ; new_public_name : Loc.t * Lib_name.t
+    }
+
+  module Local = struct
+    type nonrec t = (Loc.t * Lib_name.Local.t) t
+
+    let of_lib (lib : Library.t) : t option =
+      let open Option.O in
+      let* public = lib.public in
+      if Lib_name.equal (Lib_name.of_local lib.name) (snd public.name) then
+        None
+      else
+        Some
+          { loc = Loc.none
+          ; project = lib.project
+          ; old_name = lib.name
+          ; new_public_name = public.name
+          }
+  end
+end
+
 module Deprecated_library_name = struct
-  module Old_public_name = struct
-    type kind =
+  module Old_name = struct
+    type deprecation =
       | Not_deprecated
       | Deprecated of { deprecated_package : Package.Name.t }
 
-    type t =
-      { kind : kind
-      ; public : Public_lib.t
-      }
+    type t = Public_lib.t * deprecation
 
     let decode =
       let+ public = Public_lib.decode ~allow_deprecated_names:true in
-      let kind =
+      let deprecation =
         let deprecated_package =
           Lib_name.package_name (Public_lib.name public)
         in
@@ -1833,25 +1856,22 @@ module Deprecated_library_name = struct
         else
           Deprecated { deprecated_package }
       in
-      { kind; public }
+      (public, deprecation)
   end
 
-  type t =
-    { loc : Loc.t
-    ; project : Dune_project.t
-    ; old_public_name : Old_public_name.t
-    ; new_public_name : Loc.t * Lib_name.t
-    }
+  type t = Old_name.t Library_redirect.t
+
+  let old_public_name (t : t) = Public_lib.name (fst t.old_name)
 
   let decode =
     fields
       (let+ loc = loc
        and+ project = Dune_project.get_exn ()
-       and+ old_public_name = field "old_public_name" Old_public_name.decode
+       and+ old_name = field "old_public_name" Old_name.decode
        and+ new_public_name =
          field "new_public_name" (located Lib_name.decode)
        in
-       { loc; project; old_public_name; new_public_name })
+       { Library_redirect.loc; project; old_name; new_public_name })
 end
 
 type Stanza.t +=
@@ -1866,6 +1886,7 @@ type Stanza.t +=
   | Tests of Tests.t
   | Include_subdirs of Loc.t * Include_subdirs.t
   | Toplevel of Toplevel.t
+  | Library_redirect of Library_redirect.Local.t
   | Deprecated_library_name of Deprecated_library_name.t
   | Cram of Cram_stanza.t
 

src/dune_rules/dune_file.mli

@@ -330,24 +330,44 @@ module Include_subdirs : sig
     | Include of qualification
 end
 
+(** The purpose of [Library_redirect] stanza is to create a redirection from an
+    [old_name] to a [new_public_name].
+
+    This is used in two cases:
+
+    - When a library changes its public name, a redirection is created for
+      backwards compatibility with the code using its old name.
+      (deprecated_library_name stanza in dune files)
+
+    - When hiding public libraries with [--only-packages] (or [-p]), we use this
+      stanza to make sure that their project-local names remain in scope. *)
+module Library_redirect : sig
+  type 'old_name t =
+    { project : Dune_project.t
+    ; loc : Loc.t
+    ; old_name : 'old_name
+    ; new_public_name : Loc.t * Lib_name.t
+    }
+
+  module Local : sig
+    type nonrec t = (Loc.t * Lib_name.Local.t) t
+
+    val of_lib : Library.t -> t option
+  end
+end
+
 module Deprecated_library_name : sig
-  module Old_public_name : sig
-    type kind =
+  module Old_name : sig
+    type deprecation =
       | Not_deprecated
       | Deprecated of { deprecated_package : Package.Name.t }
 
-    type t =
-      { kind : kind
-      ; public : Public_lib.t
-      }
+    type t = Public_lib.t * deprecation
   end
 
-  type t =
-    { loc : Loc.t
-    ; project : Dune_project.t
-    ; old_public_name : Old_public_name.t
-    ; new_public_name : Loc.t * Lib_name.t
-    }
+  type t = Old_name.t Library_redirect.t
+
+  val old_public_name : t -> Lib_name.t
 end
 
 type Stanza.t +=
@@ -362,6 +382,7 @@ type Stanza.t +=
   | Tests of Tests.t
   | Include_subdirs of Loc.t * Include_subdirs.t
   | Toplevel of Toplevel.t
+  | Library_redirect of Library_redirect.Local.t
   | Deprecated_library_name of Deprecated_library_name.t
   | Cram of Cram_stanza.t
 

src/dune_rules/gen_meta.ml

@@ -164,7 +164,7 @@ let gen ~(package : Package.t) ~add_directory_entry entries =
           | _package :: path ->
             (pub_name, gen_lib pub_name ~path (Lib.Local.to_lib lib) ~version) )
         | Deprecated_library_name
-            { old_public_name = { public = old_public_name; _ }
+            { old_name = old_public_name, _
             ; new_public_name = _, new_public_name
             ; _
             } ->

src/dune_rules/gen_rules.ml

@@ -375,11 +375,19 @@ let filter_out_stanzas_from_hidden_packages ~visible_pkgs =
   List.filter_map ~f:(fun stanza ->
       match Dune_file.stanza_package stanza with
       | None -> Some stanza
-      | Some package ->
+      | Some package -> (
         if Package.Name.Map.mem visible_pkgs package.name then
           Some stanza
         else
-          None)
+          match stanza with
+          | Library l ->
+            (* A public library should still be referable by its private name
+               even we filter it out. Therefore, we create a private -> public
+               name mapping for the filtered libraries *)
+            let open Option.O in
+            let+ dln = Library_redirect.Local.of_lib l in
+            Library_redirect dln
+          | _ -> None ))
 
 let gen ~contexts ?only_packages conf =
   let open Fiber.O in

src/dune_rules/install_rules.ml

@@ -321,11 +321,10 @@ end = struct
       List.fold_left lib_entries ~init:Lib_name.Map.empty ~f:(fun acc stanza ->
           match stanza with
           | Super_context.Lib_entry.Deprecated_library_name
-              { old_public_name = { kind = Deprecated _; _ }; _ } ->
+              { old_name = _, Deprecated _; _ } ->
             acc
           | Super_context.Lib_entry.Deprecated_library_name
-              { old_public_name =
-                  { public = old_public_name; kind = Not_deprecated }
+              { old_name = old_public_name, Not_deprecated
               ; new_public_name = _, new_public_name
               ; loc
               ; project = _
@@ -393,10 +392,7 @@ end = struct
     let deprecated_dune_packages =
       List.filter_map lib_entries ~f:(function
         | Super_context.Lib_entry.Deprecated_library_name
-            ( { old_public_name =
-                  { kind = Deprecated _; public = old_public_name }
-              ; _
-              } as t ) ->
+            ({ old_name = old_public_name, Deprecated _; _ } as t) ->
           Some
             ( Lib_name.package_name (Dune_file.Public_lib.name old_public_name)
             , t )
@@ -411,8 +407,8 @@ end = struct
             | Some entries ->
               List.fold_left entries ~init:Lib_name.Map.empty
                 ~f:(fun acc
-                        { Dune_file.Deprecated_library_name.old_public_name =
-                            { public = old_public_name; _ }
+                        { Dune_file.Library_redirect.old_name =
+                            old_public_name, _
                         ; new_public_name = _, new_public_name
                         ; loc
                         ; _
@@ -448,10 +444,8 @@ end = struct
       let entries = Super_context.lib_entries_of_package sctx pkg.name in
       List.partition_map entries ~f:(function
         | Super_context.Lib_entry.Deprecated_library_name
-            { old_public_name =
-                { kind = Deprecated { deprecated_package }; public }
-            ; _
-            } as entry -> (
+            { old_name = public, Deprecated { deprecated_package }; _ } as entry
+          -> (
           match Dune_file.Public_lib.sub_dir public with
           | None -> Left (deprecated_package, entry)
           | Some _ -> Right entry )

src/dune_rules/lib.ml

@@ -1658,42 +1658,64 @@ module DB = struct
   module Library_related_stanza = struct
     type t =
       | Library of Path.Build.t * Dune_file.Library.t
+      | Library_redirect of Dune_file.Library_redirect.Local.t
       | Deprecated_library_name of Dune_file.Deprecated_library_name.t
   end
 
-  module Found_or_redirect = struct
+  module Found_or_redirect : sig
+    type t = private
+      | Found of Lib_info.external_
+      | Redirect 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
+  end = struct
     type t =
       | Found of Lib_info.external_
       | Redirect 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 found x = Found x
   end
 
   let create_from_stanzas ~parent ~lib_config stanzas =
     let map : Found_or_redirect.t Lib_name.Map.t =
       List.concat_map stanzas ~f:(fun stanza ->
           match (stanza : Library_related_stanza.t) with
-          | Deprecated_library_name
-              { old_public_name = { public = old_public_name; _ }
-              ; new_public_name
-              ; _
-              } ->
-            [ ( Dune_file.Public_lib.name old_public_name
-              , Found_or_redirect.Redirect new_public_name )
-            ]
+          | Library_redirect s ->
+            let old_public_name = Lib_name.of_local s.old_name in
+            [ Found_or_redirect.redirect old_public_name s.new_public_name ]
+          | Deprecated_library_name s ->
+            let old_public_name =
+              Dune_file.Deprecated_library_name.old_public_name s
+            in
+            [ Found_or_redirect.redirect old_public_name s.new_public_name ]
           | Library (dir, (conf : Dune_file.Library.t)) -> (
             let info =
               Dune_file.Library.to_lib_info conf ~dir ~lib_config
               |> Lib_info.of_local
             in
             match conf.public with
-            | None -> [ (Dune_file.Library.best_name conf, Found info) ]
+            | None ->
+              [ (Dune_file.Library.best_name conf, Found_or_redirect.found info)
+              ]
             | Some p ->
               let name = Dune_file.Public_lib.name p in
               if Lib_name.equal name (Lib_name.of_local conf.name) then
-                [ (name, Found info) ]
+                [ (name, Found_or_redirect.found info) ]
               else
                 let loc = Dune_file.Public_lib.loc p in
-                [ (name, Found info)
-                ; (Lib_name.of_local conf.name, Redirect (loc, name))
+                [ (name, Found_or_redirect.found info)
+                ; Found_or_redirect.redirect
+                    (Lib_name.of_local conf.name)
+                    (loc, name)
                 ] ))
       |> Lib_name.Map.of_list_reducei
            ~f:(fun name (v1 : Found_or_redirect.t) v2 ->

src/dune_rules/lib.mli

@@ -180,6 +180,7 @@ module DB : sig
   module Library_related_stanza : sig
     type t =
       | Library of Path.Build.t * Dune_file.Library.t
+      | Library_redirect of Dune_file.Library_redirect.Local.t
       | Deprecated_library_name of Dune_file.Deprecated_library_name.t
   end
 

src/dune_rules/scope.ml

@@ -60,25 +60,29 @@ module DB = struct
           match stanza with
           | Library (_, { project; public = Some p; _ }) ->
             Some (Dune_file.Public_lib.name p, Project project)
-          | Library _ -> None
-          | Deprecated_library_name
-              { old_public_name = { public = old_public_name; _ }
-              ; new_public_name
-              ; _
-              } ->
-            Some
-              (Dune_file.Public_lib.name old_public_name, Name new_public_name))
+          | Library _
+          | Library_redirect _ ->
+            None
+          | Deprecated_library_name s ->
+            let old_name =
+              Dune_file.Deprecated_library_name.old_public_name s
+            in
+            Some (old_name, Name s.new_public_name))
       |> Lib_name.Map.of_list
       |> function
       | Ok x -> x
       | Error (name, _, _) -> (
         match
           List.filter_map stanzas ~f:(fun stanza ->
+              let named p loc = Option.some_if (name = p) loc in
               match stanza with
-              | Library (_, { buildable = { loc; _ }; public = Some p; _ })
-              | Deprecated_library_name
-                  { loc; old_public_name = { public = p; _ }; _ } ->
-                Option.some_if (name = Dune_file.Public_lib.name p) loc
+              | Library (_, { buildable = { loc; _ }; public = Some p; _ }) ->
+                named (Dune_file.Public_lib.name p) loc
+              | Deprecated_library_name d ->
+                let old_name =
+                  Dune_file.Deprecated_library_name.old_public_name d
+                in
+                named old_name d.loc
               | _ -> None)
         with
         | []
@@ -108,6 +112,7 @@ module DB = struct
           let project =
             match stanza with
             | Library (_, lib) -> lib.project
+            | Library_redirect x -> x.project
             | Deprecated_library_name x -> x.project
           in
           (Dune_project.root project, stanza))
@@ -173,6 +178,7 @@ module DB = struct
             , coq_acc )
           | Dune_file.Deprecated_library_name d ->
             (Deprecated_library_name d :: acc, coq_acc)
+          | Dune_file.Library_redirect d -> (Library_redirect d :: acc, coq_acc)
           | Coq_stanza.Theory.T coq_lib ->
             let ctx_dir =
               Path.Build.append_source context.build_dir dune_file.dir