Map hidden private names to public names

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
ocaml · Aug 26, 2020 · 6173bca · 6173bca
1 parent 249aa39
commit 6173bca
Show file tree

Hide file tree

Showing 11 changed files with 91 additions and 41 deletions.
diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml
@@ -1835,13 +1835,20 @@ module Deprecated_library_name = struct
       Public (public, deprecation)
   end
 
-  type t =
+  type 'old_name t =
     { loc : Loc.t
     ; project : Dune_project.t
-    ; old_name : Old_name.t
+    ; old_name : 'old_name
     ; new_public_name : Loc.t * Lib_name.t
     }
 
+  type stanza = Old_name.t t
+
+  let old_public_name (s : stanza) =
+    match s.old_name with
+    | Local (loc, name) -> Lib_name.of_local (loc, name)
+    | Public (old_public_name, _) -> Public_lib.name old_public_name
+
   let decode =
     fields
       (let+ loc = loc
@@ -1851,6 +1858,15 @@ module Deprecated_library_name = struct
          field "new_public_name" (located Lib_name.decode)
        in
        { loc; project; old_name; new_public_name })
+
+  let of_lib (lib : Library.t) =
+    let open Option.O in
+    let+ public = lib.public in
+    { loc = Loc.none
+    ; project = lib.project
+    ; old_name = Old_name.Local lib.name
+    ; new_public_name = public.name
+    }
 end
 
 type Stanza.t +=
@@ -1865,7 +1881,7 @@ type Stanza.t +=
   | Tests of Tests.t
   | Include_subdirs of Loc.t * Include_subdirs.t
   | Toplevel of Toplevel.t
-  | Deprecated_library_name of Deprecated_library_name.t
+  | Deprecated_library_name of Deprecated_library_name.stanza
   | Cram of Cram_stanza.t
 
 module Stanzas = struct

diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli
@@ -341,12 +341,18 @@ module Deprecated_library_name : sig
       | Public of Public_lib.t * deprecation
   end
 
-  type t =
+  type 'old_name t =
     { loc : Loc.t
     ; project : Dune_project.t
-    ; old_name : Old_name.t
+    ; old_name : 'old_name
     ; new_public_name : Loc.t * Lib_name.t
     }
+
+  type stanza = Old_name.t t
+
+  val old_public_name : stanza -> Lib_name.t
+
+  val of_lib : Library.t -> stanza option
 end
 
 type Stanza.t +=
@@ -361,7 +367,7 @@ type Stanza.t +=
   | Tests of Tests.t
   | Include_subdirs of Loc.t * Include_subdirs.t
   | Toplevel of Toplevel.t
-  | Deprecated_library_name of Deprecated_library_name.t
+  | Deprecated_library_name of Deprecated_library_name.stanza
   | Cram of Cram_stanza.t
 
 val stanza_package : Stanza.t -> Package.t option

diff --git a/src/dune_rules/gen_meta.ml b/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_name = Public (old_public_name, _)
+            { old_name = old_public_name, _
             ; new_public_name = _, new_public_name
             ; _
             } ->

diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml
@@ -375,11 +375,16 @@ 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 ->
+            let open Option.O in
+            let+ dln = Deprecated_library_name.of_lib l in
+            Deprecated_library_name dln
+          | _ -> None ))
 
 let gen ~contexts ?only_packages conf =
   let open Fiber.O in

diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml
@@ -321,10 +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_name = Public (_, Deprecated _); _ } ->
+              { old_name = _, Deprecated _; _ } ->
             acc
           | Super_context.Lib_entry.Deprecated_library_name
-              { old_name = Public (old_public_name, Not_deprecated)
+              { old_name = old_public_name, Not_deprecated
               ; new_public_name = _, new_public_name
               ; loc
               ; project = _
@@ -392,7 +392,7 @@ end = struct
     let deprecated_dune_packages =
       List.filter_map lib_entries ~f:(function
         | Super_context.Lib_entry.Deprecated_library_name
-            ({ old_name = Public (old_public_name, Deprecated _); _ } as t) ->
+            ({ old_name = old_public_name, Deprecated _; _ } as t) ->
           Some
             ( Lib_name.package_name (Dune_file.Public_lib.name old_public_name)
             , t )
@@ -408,7 +408,7 @@ end = struct
               List.fold_left entries ~init:Lib_name.Map.empty
                 ~f:(fun acc
                         { Dune_file.Deprecated_library_name.old_name =
-                            Public (old_public_name, _)
+                            old_public_name, _
                         ; new_public_name = _, new_public_name
                         ; loc
                         ; _
@@ -444,8 +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_name = Public (public, Deprecated { deprecated_package }); _ }
-          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 )

diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml
@@ -1658,7 +1658,7 @@ module DB = struct
   module Library_related_stanza = struct
     type t =
       | Library of Path.Build.t * Dune_file.Library.t
-      | Deprecated_library_name of Dune_file.Deprecated_library_name.t
+      | Deprecated_library_name of Dune_file.Deprecated_library_name.stanza
   end
 
   module Found_or_redirect = struct
@@ -1671,11 +1671,11 @@ module DB = struct
     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_name = Public (old_public_name, _); new_public_name; _ } ->
-            [ ( Dune_file.Public_lib.name old_public_name
-              , Found_or_redirect.Redirect new_public_name )
-            ]
+          | Deprecated_library_name s ->
+            let old_public_name =
+              Dune_file.Deprecated_library_name.old_public_name s
+            in
+            [ (old_public_name, Found_or_redirect.Redirect s.new_public_name) ]
           | Library (dir, (conf : Dune_file.Library.t)) -> (
             let info =
               Dune_file.Library.to_lib_info conf ~dir ~lib_config

diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli
@@ -180,7 +180,7 @@ module DB : sig
   module Library_related_stanza : sig
     type t =
       | Library of Path.Build.t * Dune_file.Library.t
-      | Deprecated_library_name of Dune_file.Deprecated_library_name.t
+      | Deprecated_library_name of Dune_file.Deprecated_library_name.stanza
   end
 
   (** Create a database from a list of library stanzas *)

diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml
@@ -61,20 +61,26 @@ module DB = struct
           | Library (_, { project; public = Some p; _ }) ->
             Some (Dune_file.Public_lib.name p, Project project)
           | Library _ -> None
-          | Deprecated_library_name
-              { old_name = Public (old_public_name, _); new_public_name; _ } ->
-            Some
-              (Dune_file.Public_lib.name old_public_name, Name new_public_name))
+          | 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_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
         | []

diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml
@@ -169,11 +169,14 @@ end
 module Lib_entry = struct
   type t =
     | Library of Lib.Local.t
-    | Deprecated_library_name of Dune_file.Deprecated_library_name.t
+    | Deprecated_library_name of
+        ( Dune_file.Public_lib.t
+        * Dune_file.Deprecated_library_name.Old_name.deprecation )
+        Dune_file.Deprecated_library_name.t
 
   let name = function
     | Library lib -> Lib.Local.to_lib lib |> Lib.name
-    | Deprecated_library_name { old_name = Public (old_public_name, _); _ } ->
+    | Deprecated_library_name { old_name = old_public_name, _; _ } ->
       Dune_file.Public_lib.name old_public_name
 end
 
@@ -513,9 +516,10 @@ let create ~(context : Context.t) ?host ~projects ~packages ~stanzas =
               , Lib_entry.Library (Option.value_exn (Lib.Local.of_lib lib)) )
               :: acc )
           | Dune_file.Deprecated_library_name
-              ({ old_name = Public (old_public_name, _); _ } as d) ->
+              ({ old_name = Public (old_public_name, deprecated); _ } as d) ->
             ( (Dune_file.Public_lib.package old_public_name).name
-            , Lib_entry.Deprecated_library_name d )
+            , Lib_entry.Deprecated_library_name
+                { d with old_name = (old_public_name, deprecated) } )
             :: acc
           | _ -> acc)
       |> Package.Name.Map.of_list_multi

diff --git a/src/dune_rules/super_context.mli b/src/dune_rules/super_context.mli
@@ -33,7 +33,10 @@ val host : t -> t
 module Lib_entry : sig
   type t =
     | Library of Lib.Local.t
-    | Deprecated_library_name of Dune_file.Deprecated_library_name.t
+    | Deprecated_library_name of
+        ( Dune_file.Public_lib.t
+        * Dune_file.Deprecated_library_name.Old_name.deprecation )
+        Dune_file.Deprecated_library_name.t
 end
 
 val lib_entries_of_package : t -> Package.Name.t -> Lib_entry.t list

diff --git a/test/blackbox-tests/test-cases/github3727.t b/test/blackbox-tests/test-cases/github3727.t
@@ -34,11 +34,21 @@ visible regardless if the stanzas were filtered.
   $ dune exec ./bin.exe
   private_foo
 
+  $ rm -rf _build
+  $ dune build -p foo
+  $ dune install foo --prefix ./_install
+  Installing _install/lib/foo/META
+  Installing _install/lib/foo/bar/private_foo.a
+  Installing _install/lib/foo/bar/private_foo.cma
+  Installing _install/lib/foo/bar/private_foo.cmi
+  Installing _install/lib/foo/bar/private_foo.cmt
+  Installing _install/lib/foo/bar/private_foo.cmx
+  Installing _install/lib/foo/bar/private_foo.cmxa
+  Installing _install/lib/foo/bar/private_foo.cmxs
+  Installing _install/lib/foo/bar/private_foo.ml
+  Installing _install/lib/foo/dune-package
+
+  $ export OCAMLPATH=$PWD/_install/lib
   $ dune build -p bar
-  File "dune", line 8, characters 12-23:
-  8 |  (libraries private_foo)
-                  ^^^^^^^^^^^
-  Error: Library "private_foo" not found.
-  Hint: try:
-    dune external-lib-deps --missing -p bar @install
-  [1]
+  $ _build/install/default/bin/bin
+  private_foo