diff --git a/doc/changes/changed/14373.md b/doc/changes/changed/14373.md index b7d5df56381..9c8cbf1d937 100644 --- a/doc/changes/changed/14373.md +++ b/doc/changes/changed/14373.md @@ -1,5 +1,5 @@ -- `(deps (package ...))` now exposes only the directly declared packages to - the action's environment (`OCAMLPATH`, `PATH`, etc.). Previously, other - packages in the workspace could be discoverable via the shared install - staging area. Actions that relied on undeclared packages being visible - must declare them explicitly. (#14373, @Alizter) +- `(deps (package ...))` now exposes the declared packages and the workspace + libraries in their OCaml library closure to the action's environment. + Previously, every package in the workspace could be discoverable via the + shared install staging area. Non-library entries and unrelated libraries + remain available only from explicitly declared packages. (#14373, @Alizter) diff --git a/doc/changes/fixed/15511.md b/doc/changes/fixed/15511.md new file mode 100644 index 00000000000..ec4597ac29a --- /dev/null +++ b/doc/changes/fixed/15511.md @@ -0,0 +1,7 @@ +- Make `(deps (package ...))` include the workspace libraries in the transitive + OCaml and Melange closures of the libraries it installs, including + complete deprecated-name redirect chains and their package metadata, PPX + runtime dependencies, and virtual-library default implementations. This lets OCaml tools resolve the same library closure + before and after installation without exposing the libraries' complete + owning packages or following the broader, and not always available, package + dependency graph. (#15511, @Alizter) diff --git a/doc/concepts/dependency-spec.rst b/doc/concepts/dependency-spec.rst index 3a838d7f8d0..8aca7036bb4 100644 --- a/doc/concepts/dependency-spec.rst +++ b/doc/concepts/dependency-spec.rst @@ -40,9 +40,14 @@ Dependencies in ``dune`` files can be specified using one of the following: from the workspace. - ``(package )`` builds the files installed by ```` and adds them to the action's environment: bin entries on ``PATH``, libraries on - ``OCAMLPATH``, stublibs on ``CAML_LD_LIBRARY_PATH``, and so on. Only the - named package is added; transitive package dependencies must be listed - separately. + ``OCAMLPATH``, stublibs on ``CAML_LD_LIBRARY_PATH``, and so on. For a + workspace package, Dune also adds the workspace libraries in the transitive + OCaml and Melange closures of the libraries it installs. Only those + libraries' artifacts and metadata are added, not the other contents of their + owning packages. + This makes the same library closure findable before and after installation. + Dune does not follow dependencies from package metadata; non-library package + dependencies must be listed separately. - ``(env_var )`` depends on the value of the environment variable ````. If this variable becomes set, becomes unset, or changes value, the target will be rebuilt. diff --git a/doc/dev/install-layouts.md b/doc/dev/install-layouts.md index 77badb1ebdc..66fae936075 100644 --- a/doc/dev/install-layouts.md +++ b/doc/dev/install-layouts.md @@ -1,11 +1,13 @@ -# Install Layouts for Package Sets +# Install Layouts for Package and Library Sets ## Overview `(deps (package ...))` materializes a scoped install layout under -`_build/install//.packages//` containing only the declared -package dependencies. This replaces the old alias-based mechanism where `(deps -(package foo))` depended on the `.foo-files` install alias, which populated the +`_build/install//.packages//` containing the declared packages +and the workspace library artifacts needed by their OCaml and Melange library +closures. +This replaces the old alias-based mechanism where `(deps (package foo))` +depended on the `.foo-files` install alias, which populated the `_build/install/` staging area shared by all packages. ## Motivation @@ -13,11 +15,11 @@ package dependencies. This replaces the old alias-based mechanism where `(deps The `_build/install/` staging area shared by all packages causes several problems: -1. Actions can silently depend on packages they did not declare via the shared - environment variables (OCAMLPATH, PATH, etc.). Whether an action succeeds - can depend on what other packages happened to be built, making builds - non-deterministic. `(strict_package_deps)` validates that dependencies are - declared but does not prevent undeclared packages from being visible at +1. Actions can silently depend on arbitrary packages they did not declare via + the shared environment variables (OCAMLPATH, PATH, etc.). Whether an action + succeeds can depend on what other packages happened to be built, making + builds non-deterministic. `(strict_package_deps)` validates that dependencies + are declared but does not prevent unrelated packages from being visible at runtime. 2. The shared staging area can cause rule collisions and dependency cycles. @@ -54,28 +56,91 @@ problems: non-lock-dir contexts; with a lock-dir active, external packages can only resolve as `Build` (if they are in `dune.lock`) or as not found. -### Immediate deps only - -The layout includes only the immediate packages listed in `(deps (package -...))`. No transitive expansion is performed. Actions should declare what -they need explicitly. - -This is a deliberate design choice: - -1. Transitive closure cannot traverse lock-dir packages (they are not - workspace packages), so it gives incomplete results in mixed - workspace/lock-dir setups. Immediate deps avoid this inconsistency. - -2. Workspace package compilation is handled by dune internally via `Lib.DB`, - not via OCAMLPATH. The only consumer of OCAMLPATH in the layout is - user-written rule actions, where explicit deps are appropriate. - -3. Immediate deps keep layout *contents* tractable for the "in-and-out" problem - ([#8652]). This is orthogonal to whether per-package layouts exist at all. - When a lock-dir package depends on a workspace package, that workspace - package's layout can be provided to the lock-dir package's build env without - first computing a transitive closure that would have to cross back into other - lock-dir packages. +### Action package dependencies versus package metadata + +Two different dependencies are involved here: + +- `(deps (package foo))` is an action dependency. It asks Dune to build or + locate the installable contents of `foo`, make them available to the action, + and track those contents as inputs. + +- `(package (name foo) (depends ...))` records package metadata. It describes + what must be available when `foo` is built or installed, but it does not say + which artifacts an arbitrary action intends to use. + +The install layout never computes the transitive closure of the second kind. +For example, if package `foo` has a package dependency on `bar`, then +`(deps (package foo))` does not expose `bar`'s executable, data files, or +unrelated libraries. An action using those must also declare +`(package bar)`. The only implicit expansion is the narrower OCaml library +closure described below. + +### Library closure, not package closure + +The layout starts with the packages listed in `(deps (package ...))`. For each +workspace package, Dune also finds the libraries it installs, computes their +transitive OCaml and Melange library closures, and adds only the install entries +belonging to those workspace libraries. It does not add the libraries' complete owning +packages or traverse dependencies in package metadata. + +This distinction preserves two important properties: + +1. Installed and workspace packages have the same library semantics. The + `META` or `dune-package` entry for an installed library records the other + libraries it requires, and OCaml tools recursively resolve those libraries. + A scoped workspace layout must therefore make the same libraries findable. + Otherwise, metadata in the layout can refer to libraries outside it and a + command that works after installation can fail in the workspace. + +2. Package closure cannot be defined consistently. Dune knows package + dependencies for workspace and lock-directory packages, but `dune-package` + does not record them and findlib packages do not provide a reliable package + dependency graph. Following package dependencies only when that information + happens to be available would make `(package ...)` depend on where a package + came from. + +Package dependencies are also broader than the requirement imposed by OCaml +library metadata: they can bring in tools, data, test dependencies, and +unrelated libraries. Such dependencies must still be listed explicitly when an +action uses them. + +Dune starts from both the libraries and deprecated-library redirect targets +installed by each declared package. It then traverses each root library's +resolved `requires`, PPX runtime dependencies, and any virtual library default +implementation independently rather than trying to link all the package's +libraries together. A package may provide independent libraries or competing +implementations of a virtual library, so its libraries need not form one valid +link-time closure. Dune requires a public virtual library and its default +implementation to belong to the same package, but they remain separate +libraries and both are selected when the default is needed. Resolution errors +are reported rather than silently producing an incomplete layout. Every +intermediate name in a deprecated-library redirect chain is retained, including +metadata emitted under deprecated package names. + +Library metadata is normally grouped by package. For each owning package in +the support closure, Dune therefore generates a filtered `META` and +`dune-package` containing only the selected libraries and relevant deprecated +library redirects. The layout similarly contains only those libraries' +interfaces, archives, runtime files, headers, and stubs. Unrelated sibling +libraries and non-library entries such as binaries, data, and documentation +are excluded. + +Package sites and their directories are also excluded. The filtered +`dune-package` consequently uses an empty sites map instead of advertising +paths that the support layout does not materialize. + +The consuming action depends on every path materialized in the layout. A +support library therefore adds dependencies on its selected interfaces, +archives, stubs, headers, runtime files, and filtered metadata—not merely an +`OCAMLPATH` entry. The symlink or generated-file rule for each layout path then +tracks the corresponding workspace artifact or metadata input. Changes in a +transitively required workspace library consequently invalidate the action. + +Installed libraries in the closure are already visible through the context +environment; only workspace library artifacts need adding to the scoped +layout. Because rule actions are opaque, a support library on `OCAMLPATH` is +also directly queryable with `ocamlfind`. The distinction is one of dependency +selection and layout contents, not an access-control boundary. ### Environment variables @@ -100,12 +165,13 @@ entirely. The `env` lazy in `Super_context.create` (`src/dune_rules/super_context.ml`) is just `Context.installed_env` plus `Site_env.add_packages_env`, with no staging -paths attached. Actions only see declared dependencies via layout env vars -consed in `extend_action`. This is what makes the strict-deps property hold for -workspace build outputs: no workspace-built artifact is reachable via -dune-managed env vars unless declared. The user's inherited shell env (PATH, -OCAMLPATH, findlib config) is still visible via `Context.installed_env`, as -documented in "Environment variables" above. +paths attached. Actions only see the named packages and the selected artifacts +of their library closure via layout env vars consed in `extend_action`. This is +what makes the strict-deps property hold for workspace build outputs: no +unrelated workspace-built artifact is reachable via dune-managed env vars. +The user's inherited shell env (PATH, OCAMLPATH, findlib config) is still +visible via `Context.installed_env`, as documented in "Environment variables" +above. ### `dune exec` and the staging area @@ -138,26 +204,22 @@ staging cons above, this means: the staging dir is populated. The dune-site / sites cram tests consequently run `dune build @install` before `dune exec`. - Cram tests that exercise dune-site libraries (`(libraries dune-site - dune-site.plugins)`) must declare both `(package dune-site)` and - `(package dune-private-libs)` in their cram-level `dune` setup. - `dune-site` re-exports `dune-private-libs.dune-section`, and the layout - does not auto-expand transitive package deps (see "Immediate deps only" - above). The same pattern applies to other re-exporting libraries. - `(package stdune)`, for example, requires `(package dyn) (package - ordering) (package pp) (package top-closure) (package csexp) (package - fs-io)`. This is the explicit-deps tradeoff in its most visible form: - the immediate-deps-only design surfaces a library's transitive - dependencies at the call site rather than implicitly pulling them in. + dune-site.plugins)`) can declare `(package dune-site)` in their cram-level + `dune` setup. `dune-site` re-exports `dune-private-libs.dune-section`, so the + library closure also adds that library's install artifacts and filtered + metadata. It does not add the other contents of `dune-private-libs`. The same + rule applies to other re-exporting libraries. Package dependencies that are + not represented in the library graph must still be declared explicitly. The current staging cons is sufficient for the existing test surface and matches pre-install-layouts behaviour. ### Package set structure and `_root` section collisions -The layout merges all packages' install entries into a single directory tree. -For scoped sections (`lib`, `share`, `doc`, `etc`), each package installs -under its own subdirectory (`lib//`), so collisions are impossible -by construction. The unordered set is the correct data structure. +The layout merges the explicit packages' install entries and the selected +support libraries' entries into a single directory tree. For scoped sections +(`lib`, `share`, `doc`, `etc`), entries install under their owning package's +subdirectory (`lib//`), so collisions are impossible by construction. Collisions can only occur in `_root` sections (`lib_root`, `share_root`, `libexec_root`), which install directly to the section root without package @@ -189,12 +251,15 @@ the core layout mechanism. ### Layout key (digest derivation) The `` component of `_build/install//.packages//` is -the hex `Digest.repr` of the sorted package-name list of the set (see -`Install_layout.Key.encode` in `src/dune_rules/install_layout.ml`). The sort -makes the digest order-independent. A reverse table maps each digest back to -its original set so `gen_rules` can decode the layout dir's name when the -engine asks for rules. Hash collisions are detected at insertion time and raise -a `Code_error`. +the hex `Digest.repr` of the sorted explicit-package names and support-library +identities. A support-library identity contains both its owning package and +library name, so package-private names remain unambiguous across workspace +scopes. See `Install_layout.Key.encode` in +`src/dune_rules/install_layout.ml`. The sorting makes the digest +order-independent. A reverse table maps each digest back to its original +request so `gen_rules` can decode the layout dir's name when the engine asks +for rules. Hash collisions are detected at insertion time and raise a +`Code_error`. ### `For_rocq_only` escape hatch diff --git a/src/dune_rules/install_layout.ml b/src/dune_rules/install_layout.ml index f11d1f893dd..1a84cda7e36 100644 --- a/src/dune_rules/install_layout.ml +++ b/src/dune_rules/install_layout.ml @@ -1,26 +1,124 @@ open Import +module Library = struct + module T = struct + type t = + { package : Package.Name.t + ; name : Lib_name.t + } + + let compare a b = + match Package.Name.compare a.package b.package with + | Eq -> Lib_name.compare a.name b.name + | ordering -> ordering + ;; + + let hash { package; name } = + Tuple.T2.hash Package.Name.hash Lib_name.hash (package, name) + ;; + + let to_dyn { package; name } = + Dyn.record [ "package", Package.Name.to_dyn package; "name", Lib_name.to_dyn name ] + ;; + end + + include T + include Comparable.Make (T) + + let make ~package ~name = { package; name } + let package t = t.package + let name t = t.name + + let repr = + Repr.view + Repr.(pair Package.Name.repr Lib_name.repr) + ~to_:(fun { package; name } -> package, name) + ;; +end + +module Redirect = Library + +type support = + { libraries : Library.Set.t + ; redirects : Redirect.Set.t + } + +type request = + { packages : Package.Name.Set.t + ; libraries : Library.Set.t + ; redirects : Redirect.Set.t + } + +let request_equal a b = + Package.Name.Set.equal a.packages b.packages + && Library.Set.equal a.libraries b.libraries + && Redirect.Set.equal a.redirects b.redirects +;; + +let request_hash { packages; libraries; redirects } = + Tuple.T3.hash + (List.hash Package.Name.hash) + (List.hash Library.hash) + (List.hash Redirect.hash) + ( Package.Name.Set.to_list packages + , Library.Set.to_list libraries + , Redirect.Set.to_list redirects ) +;; + +let request_to_dyn { packages; libraries; redirects } = + Dyn.record + [ "packages", Package.Name.Set.to_dyn packages + ; "libraries", Library.Set.to_dyn libraries + ; "redirects", Redirect.Set.to_dyn redirects + ] +;; + +type generated_entry = + { package : Package.Name.t + ; section : Section.t + ; dst : Install.Entry.Dst.t + ; contents : string Action_builder.t + } + +type library_entries = + { install_entries : (Package.Name.t * Install.Entry.Sourced.Unexpanded.t) list + ; generated_entries : generated_entry list + } + +type materialized_source = + | Symlink of Path.t Install.Entry.Expanded.t + | Contents of string Action_builder.t + +type materialized_entry = + { package : Package.Name.t + ; section : Section.t + ; dst : Install.Entry.Dst.t + ; kind : Install.Entry.Expanded.kind + ; source : materialized_source + } + module Key : sig - val encode : Package.Name.Set.t -> string - val decode : string -> Package.Name.Set.t option + val encode : request -> string + val decode : string -> request option end = struct - let reverse_table : (Digest.t, Package.Name.Set.t) Table.t = - Table.create (module Digest) 128 - ;; + let reverse_table : (Digest.t, request) Table.t = Table.create (module Digest) 128 - let encode packages = - let sorted = Package.Name.Set.to_list packages in - let y = Digest.repr Repr.(list Package.Name.repr) sorted in + let encode ({ packages; libraries; redirects } as request) = + let y = + Digest.repr + Repr.(triple (list Package.Name.repr) (list Library.repr) (list Redirect.repr)) + ( Package.Name.Set.to_list packages + , Library.Set.to_list libraries + , Redirect.Set.to_list redirects ) + in (match Table.find reverse_table y with - | None -> Table.set reverse_table y packages - | Some packages' -> - if not (Package.Name.Set.equal packages packages') + | None -> Table.set reverse_table y request + | Some request' -> + if not (request_equal request request') then Code_error.raise - "Hash collision between sets of packages" - [ "cached", Package.Name.Set.to_dyn packages' - ; "new", Package.Name.Set.to_dyn packages - ]); + "Hash collision between install layout requests" + [ "cached", request_to_dyn request'; "new", request_to_dyn request ]); Digest.to_string y ;; @@ -31,14 +129,16 @@ end = struct ;; end -let entry_resolver_fdecl - : (Context_name.t -> Package.Name.t -> Install.Entry.Sourced.Unexpanded.t list Memo.t) - Fdecl.t - = - Fdecl.create Dyn.opaque -;; +type resolvers = + { package_entries : + Context_name.t -> Package.Name.t -> Install.Entry.Sourced.Unexpanded.t list Memo.t + ; library_support : Context_name.t -> Package.Name.Set.t -> support Memo.t + ; library_entries : + Context_name.t -> Library.Set.t -> Redirect.Set.t -> library_entries Memo.t + } -let set_entry_resolver f = Fdecl.set entry_resolver_fdecl f +let resolvers_fdecl : resolvers Fdecl.t = Fdecl.create Dyn.opaque +let set_resolvers resolvers = Fdecl.set resolvers_fdecl resolvers let dir ~context ~key = Path.Build.L.relative (Install.Context.dir ~context) [ ".packages"; key ] @@ -49,43 +149,91 @@ let dir ~context ~key = materialised path under the layout. Collisions (two packages installing to the same destination, which can only happen in _root sections) are reported as user errors naming the conflicting packages and entry. *) -let compute_entries context_name root packages = +let compute_entries context_name root { packages; libraries; redirects } = + let overlapping items package = + Library.Set.to_list items + |> List.filter ~f:(fun item -> Package.Name.Set.mem packages (package item)) + in + let overlapping_libraries = overlapping libraries Library.package + and overlapping_redirects = overlapping redirects Redirect.package in + if List.is_non_empty overlapping_libraries || List.is_non_empty overlapping_redirects + then + Code_error.raise + "Install layout request contains support metadata owned by explicit packages" + [ "packages", Package.Name.Set.to_dyn packages + ; "libraries", Dyn.list Library.to_dyn overlapping_libraries + ; "redirects", Dyn.list Redirect.to_dyn overlapping_redirects + ]; let open Memo.O in - let get_entries = Fdecl.get entry_resolver_fdecl in - Package.Name.Set.to_list packages - |> Memo.parallel_map ~f:(fun pkg -> + let { package_entries; library_entries; _ } = Fdecl.get resolvers_fdecl in + let resolve_entry (pkg, (s : Install.Entry.Sourced.Unexpanded.t)) = let install_paths = let roots = Install.Roots.opam_from_prefix Path.root ~relative:Path.relative in Install.Paths.make ~relative:Path.relative ~package:pkg ~roots in - let+ entries = get_entries context_name pkg in - List.filter_map entries ~f:(fun (s : Install.Entry.Sourced.Unexpanded.t) -> - let entry = s.entry in - match entry.kind with - | Install.Entry.Unexpanded.Source_tree -> None - | File | Directory -> - let relative = - Install.Entry.relative_installed_path entry ~paths:install_paths - |> Path.as_in_source_tree_exn - in - let dst = Path.Build.append_source root relative in - let expanded = - Install.Entry.Expanded.set_src - (Install.Entry.Unexpanded.expand entry) - (Path.build entry.src) - in - Some (dst, (pkg, expanded)))) - >>| List.concat - >>| Path.Build.Map.of_list - >>| function - | Ok m -> Path.Build.Map.map m ~f:snd - | Error (_, (pkg_a, entry_a), (pkg_b, _)) -> + let entry = s.entry in + match entry.kind with + | Install.Entry.Unexpanded.Source_tree -> None + | File | Directory -> + let relative = + Install.Entry.relative_installed_path entry ~paths:install_paths + |> Path.as_in_source_tree_exn + in + let dst = Path.Build.append_source root relative in + let expanded = + Install.Entry.Expanded.set_src + (Install.Entry.Unexpanded.expand entry) + (Path.build entry.src) + in + Some + ( dst + , { package = pkg + ; section = expanded.section + ; dst = expanded.dst + ; kind = expanded.kind + ; source = Symlink expanded + } ) + in + let resolve_generated { package; section; dst; contents } = + let install_paths = + let roots = Install.Roots.opam_from_prefix Path.root ~relative:Path.relative in + Install.Paths.make ~relative:Path.relative ~package ~roots + in + let relative = + Install.Entry.Dst.install_path install_paths section dst + |> Path.as_in_source_tree_exn + in + let path = Path.Build.append_source root relative in + ( path + , { package + ; section + ; dst + ; kind = Install.Entry.Expanded.File + ; source = Contents contents + } ) + in + let* package_entries = + Package.Name.Set.to_list packages + |> Memo.parallel_map ~f:(fun pkg -> + let+ entries = package_entries context_name pkg in + List.map entries ~f:(fun entry -> pkg, entry)) + >>| List.concat + and* { install_entries = library_entries; generated_entries } = + library_entries context_name libraries redirects + in + let entries = + List.append package_entries library_entries |> List.filter_map ~f:resolve_entry + in + let entries = List.append entries (List.map generated_entries ~f:resolve_generated) in + match Path.Build.Map.of_list entries with + | Ok m -> Memo.return m + | Error (_, entry_a, entry_b) -> User_error.raise ~hints:[ Pp.text "Rename one of the install entries." ] [ Pp.textf "%S and %S both install %S to section %s." - (Package.Name.to_string pkg_a) - (Package.Name.to_string pkg_b) + (Package.Name.to_string entry_a.package) + (Package.Name.to_string entry_b.package) (Install.Entry.Dst.to_string entry_a.dst) (Section.to_string entry_a.section) ; Pp.text @@ -96,48 +244,56 @@ let compute_entries context_name root packages = ;; let entries = - let set_hash s = List.hash Package.Name.hash (Package.Name.Set.to_list s) in let memo = Memo.create "install-layout-entries" ~input: (module struct - type t = Context_name.t * Package.Name.Set.t + type t = Context_name.t * request - let equal = Tuple.T2.equal Context_name.equal Package.Name.Set.equal - let hash = Tuple.T2.hash Context_name.hash set_hash - let to_dyn = Tuple.T2.to_dyn Context_name.to_dyn Package.Name.Set.to_dyn + let equal = Tuple.T2.equal Context_name.equal request_equal + let hash = Tuple.T2.hash Context_name.hash request_hash + let to_dyn = Tuple.T2.to_dyn Context_name.to_dyn request_to_dyn end) - (fun (context, packages) -> - let key = Key.encode packages in + (fun (context, request) -> + let key = Key.encode request in let root = dir ~context ~key in - compute_entries context root packages) + compute_entries context root request) in - fun context packages -> Memo.exec memo (context, packages) + fun context request -> Memo.exec memo (context, request) ;; -let files context_name packages = +let files context_name request = let open Memo.O in - let+ entries = entries context_name packages in + let+ entries = entries context_name request in Path.Build.Map.keys entries |> List.map ~f:Path.build ;; -let deps context_name packages = +let deps context_name request = let open Action_builder.O in - let* files = Action_builder.of_memo (files context_name packages) in + let* files = Action_builder.of_memo (files context_name request) in Action_builder.paths files ;; -let root context_name packages = dir ~context:context_name ~key:(Key.encode packages) +let root context_name request = dir ~context:context_name ~key:(Key.encode request) -let env context_name packages = +let env_for_request context_name request = let open Action_builder.O in - let+ () = deps context_name packages in - let layout_root = root context_name packages in + let+ () = deps context_name request in + let layout_root = root context_name request in let roots = Install.Roots.opam_from_prefix layout_root ~relative:Path.Build.relative in Install.Roots.add_to_env roots Env.empty ;; +let env context_name packages = + let open Action_builder.O in + let { library_support; _ } = Fdecl.get resolvers_fdecl in + let* { libraries; redirects } = + Action_builder.of_memo (library_support context_name packages) + in + env_for_request context_name { packages; libraries; redirects } +;; + let make_dispatch ~dir ~directory_targets subdirs f = let rules = Rules.collect_unit f in Build_config.Gen_rules.make @@ -160,8 +316,8 @@ let gen_rules context_name ~dir rest = | [ key ] -> (match Key.decode key with | None -> Memo.return Build_config.Gen_rules.no_rules - | Some packages -> - let+ entries = entries context_name packages in + | Some request -> + let+ entries = entries context_name request in let directory_targets = Path.Build.Map.filter_map entries ~f:(fun entry -> match (entry.kind : Install.Entry.Expanded.kind) with @@ -170,11 +326,14 @@ let gen_rules context_name ~dir rest = in make_dispatch ~dir ~directory_targets Subdir_set.empty (fun () -> Path.Build.Map.to_seq entries - |> Memo.parallel_iter_seq ~f:(fun (dst, { Install.Entry.kind; src; _ }) -> + |> Memo.parallel_iter_seq ~f:(fun (dst, { kind; source; _ }) -> let { Action_builder.With_targets.build; targets } = - match (kind : Install.Entry.Expanded.kind) with - | File -> Action_builder.symlink ~src ~dst - | Directory -> Action_builder.symlink_dir ~src ~dst + match source, (kind : Install.Entry.Expanded.kind) with + | Symlink { src; _ }, File -> Action_builder.symlink ~src ~dst + | Symlink { src; _ }, Directory -> Action_builder.symlink_dir ~src ~dst + | Contents contents, File -> Action_builder.write_file_dyn dst contents + | Contents _, Directory -> + Code_error.raise "Generated install layout entry is a directory" [] in Rules.Produce.rule (Rule.make ~info:(Rule.Info.of_loc_opt None) ~targets build)))) | _ :: _ :: _ -> @@ -197,17 +356,18 @@ module For_rocq_only = struct keeping METAs, .cmi, .cmxs etc. — all upstream of theory compilation. *) let lib_root context_name packages = let open Action_builder.O in + let request = + { packages; libraries = Library.Set.empty; redirects = Redirect.Set.empty } + in let* lib_paths = - Action_builder.of_memo (entries context_name packages) - >>| Path.Build.Map.foldi - ~init:[] - ~f:(fun dst (entry : Path.t Install.Entry.Expanded.t) acc -> - match (entry.section : Section.t) with - | Lib | Libexec -> Path.build dst :: acc - | _ -> acc) + Action_builder.of_memo (entries context_name request) + >>| Path.Build.Map.foldi ~init:[] ~f:(fun dst (entry : materialized_entry) acc -> + match (entry.section : Section.t) with + | Lib | Libexec -> Path.build dst :: acc + | _ -> acc) in let+ () = Action_builder.paths lib_paths in - let layout_root = root context_name packages in + let layout_root = root context_name request in (Install.Roots.opam_from_prefix layout_root ~relative:Path.Build.relative).lib_root ;; end diff --git a/src/dune_rules/install_layout.mli b/src/dune_rules/install_layout.mli index 62d4410581b..2001730341f 100644 --- a/src/dune_rules/install_layout.mli +++ b/src/dune_rules/install_layout.mli @@ -1,13 +1,53 @@ open Import -val set_entry_resolver - : (Context_name.t -> Package.Name.t -> Install.Entry.Sourced.Unexpanded.t list Memo.t) - -> unit - -(** Env extension for an action depending on a package set. Returns an env - with PATH, OCAMLPATH, etc. prepended for the layout root, and registers - the action's dependency on every install entry the layout produces for - the set. *) +module Library : sig + type t + + val make : package:Package.Name.t -> name:Lib_name.t -> t + val package : t -> Package.Name.t + val name : t -> Lib_name.t + val repr : t Repr.t + val to_dyn : t -> Dyn.t + + module Map : Map.S with type key = t + module Set : Set.S with type elt = t +end + +module Redirect = Library + +type support = + { libraries : Library.Set.t + ; redirects : Redirect.Set.t + } + +type generated_entry = + { package : Package.Name.t + ; section : Section.t + ; dst : Install.Entry.Dst.t + ; contents : string Action_builder.t + } + +type library_entries = + { install_entries : (Package.Name.t * Install.Entry.Sourced.Unexpanded.t) list + ; generated_entries : generated_entry list + } + +type resolvers = + { package_entries : + Context_name.t -> Package.Name.t -> Install.Entry.Sourced.Unexpanded.t list Memo.t + ; library_support : Context_name.t -> Package.Name.Set.t -> support Memo.t + ; library_entries : + Context_name.t -> Library.Set.t -> Redirect.Set.t -> library_entries Memo.t + } + +val set_resolvers : resolvers -> unit + +(** Env extension for an action depending on a package set and its workspace + library support closure. Returns an env with PATH, OCAMLPATH, etc. prepended + for the layout root, and registers the action's dependency on every install + entry the layout produces. Only the selected support libraries' install + entries and metadata are included; their owning packages' other entries are + not. *) val env : Context_name.t -> Package.Name.Set.t -> Env.t Action_builder.t (** Engine dispatch for [_build/install//.packages/]. Called diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index f38b5364cd7..a3f0cf68047 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -106,11 +106,27 @@ let check_runtime_deps_relative_path local_path ~loc ~lib_info = | Some _ -> () ;; +let compare_install_entries + (a : Install.Entry.Sourced.Unexpanded.t) + (b : Install.Entry.Sourced.Unexpanded.t) + = + Install.Entry.Unexpanded.compare a.entry b.entry +;; + module Stanzas_to_entries : sig val stanzas_to_entries : Super_context.t -> Install.Entry.Sourced.Unexpanded.t list Package.Name.Map.t Memo.t + + val library_entries + : Super_context.t + -> Install.Entry.Sourced.Unexpanded.t list Install_layout.Library.Map.t Memo.t end = struct + type t = + { packages : Install.Entry.Sourced.Unexpanded.t list Package.Name.Map.t + ; libraries : Install.Entry.Sourced.Unexpanded.t list Install_layout.Library.Map.t + } + let lib_ppxs ctx ~scope ~(lib : Library.t) = match lib.kind with | Virtual | Parameter | Dune_file (Normal | Ppx_deriver _) -> Memo.return [] @@ -121,8 +137,16 @@ end = struct >>| List.singleton ;; - let lib_files ~ocaml_modules ~dir_contents ~dir ~lib_config lib = - let+ foreign_archives = + let lib_files ~scope ~dir_contents ~dir ~lib_config lib = + let+ modules = + let* ml_sources = Dir_contents.ml dir_contents ~for_:Ocaml in + Ml_sources.modules + ml_sources + ~libs:(Scope.libs scope) + ~for_:(Library (Lib_info.lib_id lib |> Lib_id.to_local_exn)) + >>| Modules.With_vlib.modules + >>| Option.some + and+ foreign_archives = match Lib_info.kind lib with | Dune_file _ -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) @@ -147,7 +171,7 @@ end = struct [ byte ; native ; foreign_archives - ; Lib_info.eval_native_archives_exn lib ~modules:ocaml_modules + ; Lib_info.eval_native_archives_exn lib ~modules ; jsoo_files ])) (List.rev_map ~f:(fun f -> Section.Libexec, f) (Lib_info.plugins lib).native) @@ -198,13 +222,12 @@ end = struct let doc_install_files ~loc mld_contents = List.rev_map mld_contents ~f:(fun (mld : Doc_sources.mld) -> - make_entry - None + Install.Entry.Unexpanded.make ~kind:Install.Entry.Unexpanded.File ~dst:(sprintf "odoc-pages/%s" (Path.Local.to_string mld.in_doc)) - ~loc Section.Doc - mld.path) + mld.path + |> Install.Entry.Sourced.Unexpanded.create ~loc) ;; let lib_install_files @@ -221,9 +244,6 @@ end = struct let+ ocaml = Context.ocaml ctx in ocaml.lib_config in - let make_stublib_entry file = - make_entry None ~loc ~kind:Install.Entry.Unexpanded.File Stublibs file - in let make_entry ?(loc = loc) = make_entry lib_subdir ~loc in let* expander = Super_context.expander sctx ~dir in let info = @@ -242,7 +262,7 @@ end = struct lib_modes in let lib_name = Library.best_name lib in - let* modules_by_mode = + let* installable_modules = let lib_modes = Compilation_mode.Set.of_lib_mode_set lib_modes in Memo.parallel_map (Compilation_mode.Set.to_list lib_modes) ~f:(fun for_ -> let+ modules = @@ -251,18 +271,7 @@ end = struct ~libs:(Scope.libs scope) ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) and+ impl = Virtual_rules.impl sctx ~lib ~scope ~for_ in - let installable_modules = - Virtual_rules.impl_modules impl modules |> Modules.With_vlib.split_by_lib - in - for_, modules, installable_modules) - in - let ocaml_modules = - List.find_map modules_by_mode ~f:(function - | Ocaml, modules, _ -> Some (Modules.With_vlib.modules modules) - | Melange, _, _ -> None) - in - let installable_modules = - List.map modules_by_mode ~f:(fun (for_, _, modules) -> for_, modules) + for_, Virtual_rules.impl_modules impl modules |> Modules.With_vlib.split_by_lib) in let lib_src_dir = Lib_info.src_dir info in let sources = @@ -455,11 +464,15 @@ end = struct if Module.kind m = Virtual then [] else common ~for_ m |> set_dir m)) in modules_vlib @ modules_impl - and+ lib_files = lib_files ~ocaml_modules ~dir ~dir_contents ~lib_config info + and+ lib_files = lib_files ~scope ~dir ~dir_contents ~lib_config info and+ execs = lib_ppxs ctx ~scope ~lib and+ dll_files = dll_files ~modes:ocaml ~dynlink:lib.dynlink ~ctx info - >>| List.rev_map ~f:make_stublib_entry + >>| List.rev_map ~f:(fun a -> + let entry = + Install.Entry.Unexpanded.make ~kind:Install.Entry.Unexpanded.File Stublibs a + in + Install.Entry.Sourced.Unexpanded.create ~loc entry) in let install_c_headers = List.rev_map lib.install_c_headers ~f:(fun (loc, base) -> @@ -616,24 +629,30 @@ end = struct >>= function | None -> Memo.return None | Some (stanza, package) -> - let+ entries = + let+ entries, library = match Stanza.repr stanza with | Install_conf.T i | Executables.T { install_conf = Some i; _ } -> - entries_of_install_stanza ~dir ~expander ~package_db i + let+ entries = entries_of_install_stanza ~dir ~expander ~package_db i in + entries, None | Library.T lib -> let sub_dir = Library.sub_dir lib in let* dir_contents = Dir_contents.get sctx ~dir in - lib_install_files sctx ~scope ~dir ~sub_dir lib ~dir_contents - | Rocq_stanza.Theory.T theory -> Rocq_rules.install_rules ~sctx ~dir theory + let+ entries = lib_install_files sctx ~scope ~dir ~sub_dir lib ~dir_contents in + entries, Some (Library.best_name lib) + | Rocq_stanza.Theory.T theory -> + let+ entries = Rocq_rules.install_rules ~sctx ~dir theory in + entries, None | Documentation.T stanza -> let* dir_contents = Dir_contents.get sctx ~dir in let+ mld_contents = Dir_contents.mlds ~stanza dir_contents in - doc_install_files ~loc:stanza.loc mld_contents - | Plugin.T t -> Plugin_rules.install_rules ~sctx ~package_db ~dir t - | _ -> Memo.return [] + doc_install_files ~loc:stanza.loc mld_contents, None + | Plugin.T t -> + let+ entries = Plugin_rules.install_rules ~sctx ~package_db ~dir t in + entries, None + | _ -> Memo.return ([], None) in let name = Package.Id.name package in - Some (name, entries) + Some (name, library, entries) ;; module Package_map_traversals = Memo.Map (Package.Name.Map) @@ -716,26 +735,33 @@ end = struct named_entries :: acc) |> Memo.all_concurrently in - List.fold_left entries ~init ~f:(fun acc named_entries -> - match named_entries with - | None -> acc - | Some (name, entries) -> Package.Name.Map.Multi.add_all acc name entries) - |> Package.Name.Map.map ~f:(fun entries -> - (* Sort entries so that the ordering in [dune-package] is independent - of Dune's current implementation. *) - (* jeremiedimino: later on, we group this list by section and sort - each section. It feels like we should just do this here once and - for all. *) - List.sort - entries - ~compare: - (fun - (a : Install.Entry.Sourced.Unexpanded.t) - (b : Install.Entry.Sourced.Unexpanded.t) - -> Install.Entry.Unexpanded.compare a.entry b.entry)) + let packages = + List.fold_left entries ~init ~f:(fun acc named_entries -> + match named_entries with + | None -> acc + | Some (name, _, entries) -> Package.Name.Map.Multi.add_all acc name entries) + |> Package.Name.Map.map ~f:(fun entries -> + (* Sort entries so that the ordering in [dune-package] is independent + of Dune's current implementation. *) + (* jeremiedimino: later on, we group this list by section and sort + each section. It feels like we should just do this here once and + for all. *) + List.sort entries ~compare:compare_install_entries) + in + let libraries = + List.filter_map entries ~f:(function + | Some (package, Some name, entries) -> + Some (Install_layout.Library.make ~package ~name, entries) + | None | Some (_, None, _) -> None) + (* [stanza_to_entries] resolves each library through the scope DB first, + which reports duplicate public names as a user error. This strict map + construction relies on that check having succeeded. *) + |> Install_layout.Library.Map.of_list_exn + in + { packages; libraries } ;; - let stanzas_to_entries = + let all = let memo = Memo.create ~input:(module Super_context.As_memo_key) @@ -744,16 +770,32 @@ end = struct in Memo.exec memo ;; + + let stanzas_to_entries sctx = + let+ { packages; _ } = all sctx in + packages + ;; + + let library_entries sctx = + let+ { libraries; _ } = all sctx in + libraries + ;; end module Meta_and_dune_package : sig val meta_and_dune_package_rules : Super_context.t -> Dune_project.t -> unit Memo.t + + val support_metadata_entries + : Super_context.t + -> package:Package.t + -> lib_entries:Scope.DB.Lib_entry.t list + -> install_entries:Install.Entry.Sourced.Unexpanded.t list + -> Install_layout.generated_entry list Memo.t end = struct - let sections ctx_name files pkg = - let pkg_name = Package.name pkg in + let sections ctx_name files pkg_name sites = let sections = (* the one from sites *) - Package.sites pkg |> Site.Map.values |> Section.Set.of_list + sites |> Site.Map.values |> Section.Set.of_list in let sections = (* the one from install stanza *) @@ -763,7 +805,7 @@ end = struct Install.Paths.get_local_location ctx_name section pkg_name) ;; - let make_dune_package sctx lib_entries (pkg : Package.t) = + let make_dune_package sctx lib_entries install_entries sites (pkg : Package.t) = Action_builder.of_memo @@ let pkg_name = Package.name pkg in @@ -781,7 +823,12 @@ end = struct Path.Build.append_local pkg_root subdir in let* entries = - let* { Scope.DB.Lib_entry.Set.deprecated_library_names; libraries } = lib_entries in + let* lib_entries = lib_entries in + let libraries, deprecated_library_names = + List.partition_map lib_entries ~f:(function + | Scope.DB.Lib_entry.Library lib -> Left lib + | Deprecated_library_name deprecated -> Right deprecated) + in let deprecated = List.filter_map deprecated_library_names ~f:(function | { old_name = _, Deprecated _; _ } -> None @@ -872,8 +919,8 @@ end = struct Lib_name.Map.add_exn acc name x) in let+ files = - let+ map = Stanzas_to_entries.stanzas_to_entries sctx in - Package.Name.Map.Multi.find map pkg_name + let+ install_entries = install_entries in + install_entries |> List.map ~f:(fun (e : Install.Entry.Sourced.Unexpanded.t) -> let kind = match e.entry.kind with @@ -884,14 +931,14 @@ end = struct |> Section.Map.of_list_multi |> Section.Map.to_list in - let sections = sections (Context.name ctx) files pkg in + let sections = sections (Context.name ctx) files pkg_name sites in Dune_package.Or_meta.Dune_package { Dune_package.version = Package.version pkg ; name = pkg_name ; entries ; dir = Path.build pkg_root ; sections - ; sites = Package.sites pkg + ; sites ; files } ;; @@ -901,6 +948,14 @@ end = struct let dune_version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in let action = let dune_package_file = Package_paths.dune_package_file ctx pkg in + let entries = + let+ entries = lib_entries in + Scope.DB.Lib_entry.Set.to_list entries + in + let install_entries = + let+ map = Stanzas_to_entries.stanzas_to_entries sctx in + Package.Name.Map.Multi.find map (Package.name pkg) + in Action_builder.write_file_dyn dune_package_file (let open Action_builder.O in @@ -908,7 +963,8 @@ end = struct |> Path.build |> Action_builder.if_file_exists ~then_:(Action_builder.return Dune_package.Or_meta.Use_meta) - ~else_:(make_dune_package sctx lib_entries pkg) + ~else_: + (make_dune_package sctx entries install_entries (Package.sites pkg) pkg) >>| Format.asprintf "%a" (Dune_package.Or_meta.pp ~dune_version ~encoding:Relative)) @@ -958,7 +1014,7 @@ end = struct (Dune_package.Entry.Deprecated_library_name { loc; old_public_name; new_public_name })) in - let sections = sections ctx.name [] pkg in + let sections = sections ctx.name [] (Package.name pkg) (Package.sites pkg) in { Dune_package.version = Package.version pkg ; name ; entries @@ -981,6 +1037,115 @@ end = struct Super_context.add_rule sctx ~dir:ctx.build_dir action ;; + let meta_entries_for_main_package entries = + List.filter entries ~f:(function + | Scope.DB.Lib_entry.Deprecated_library_name { old_name = public, Deprecated _; _ } + -> Option.is_some (Public_lib.sub_dir public) + | Library _ | Deprecated_library_name { old_name = _, Not_deprecated; _ } -> true) + ;; + + let support_metadata_entries sctx ~(package : Package.t) ~lib_entries ~install_entries = + let ctx = Super_context.context sctx |> Context.build_context in + let package_name = Package.name package in + let meta_template_file = Path.build (Package_paths.meta_template ctx package) in + let meta_lib_entries = meta_entries_for_main_package lib_entries in + let meta_contents = + let open Action_builder.O in + let+ meta = Gen_meta.gen ~package ~add_directory_entry:true meta_lib_entries in + Format.asprintf "%a" Pp.to_fmt (Pp.vbox (Meta.pp meta.entries)) + in + let dune_version = Dune_lang.Syntax.greatest_supported_version_exn Stanza.syntax in + let dune_package_contents = + Action_builder.if_file_exists + meta_template_file + ~then_:(Action_builder.return Dune_package.Or_meta.Use_meta) + ~else_: + (make_dune_package + sctx + (Memo.return lib_entries) + (Memo.return install_entries) + (* Sites are package-level contents. Advertising them without + materializing their directories would create dangling paths. *) + Site.Map.empty + package) + |> Action_builder.map + ~f: + (Format.asprintf + "%a" + (Dune_package.Or_meta.pp ~dune_version ~encoding:Relative)) + in + let entry ~package contents dst = + { Install_layout.package + ; section = Lib + ; dst = Install.Entry.Dst.of_string dst + ; contents + } + in + let deprecated_entries = + List.filter_map lib_entries ~f:(function + | Scope.DB.Lib_entry.Deprecated_library_name + ({ old_name = + _, Deprecated_library_name.Old_name.Deprecated { deprecated_package } + ; _ + } as redirect) -> Some (deprecated_package, redirect) + | Library _ | Deprecated_library_name { old_name = _, Not_deprecated; _ } -> None) + |> Package.Name.Map.of_list_multi + |> Package.Name.Map.to_list + |> List.concat_map ~f:(fun (deprecated_package, redirects) -> + let meta_contents = + let open Action_builder.O in + let+ meta = + List.map redirects ~f:(fun redirect -> + Scope.DB.Lib_entry.Deprecated_library_name redirect) + |> Gen_meta.gen ~package ~add_directory_entry:false + in + Format.asprintf "%a" Pp.to_fmt (Pp.vbox (Meta.pp meta.entries)) + in + let dune_package_contents = + let entries = + List.map + redirects + ~f:(fun { Library_redirect.old_name; new_public_name; loc; _ } -> + let old_public_name = Public_lib.name (fst old_name) in + ( old_public_name + , Dune_package.Entry.Deprecated_library_name + { loc; old_public_name; new_public_name = snd new_public_name } )) + |> Lib_name.Map.of_list_exn + in + let dune_package = + { Dune_package.version = Package.version package + ; name = deprecated_package + ; entries + ; dir = + Path.build + (Install.Context.lib_dir ~context:ctx.name ~package:deprecated_package) + ; sections = Section.Map.empty + ; sites = Site.Map.empty + ; files = [] + } + in + Dune_package.Or_meta.Dune_package dune_package + |> Format.asprintf + "%a" + (Dune_package.Or_meta.pp ~dune_version ~encoding:Relative) + |> Action_builder.return + in + [ entry + ~package:deprecated_package + meta_contents + (Dune_findlib.Package.meta_fn |> Filename.to_string) + ; entry ~package:deprecated_package dune_package_contents Dune_package.fn + ]) + in + Memo.return + (entry + ~package:package_name + meta_contents + (Dune_findlib.Package.meta_fn |> Filename.to_string) + :: entry ~package:package_name dune_package_contents Dune_package.fn + :: deprecated_entries) + ;; + let gen_odoc_config sctx (pkg : Package.t) = let ctx = Super_context.context sctx |> Context.build_context in match Package_paths.odoc_config_file ctx pkg with @@ -1204,11 +1369,229 @@ let install_entries sctx package = Package.Name.Map.Multi.find packages package ;; +let library_closure lib = + let open Memo.O in + Memo.parallel_map [ Compilation_mode.Ocaml; Melange ] ~f:(fun for_ -> + let* compile_closure = + Lib.closure [ lib ] ~linking:false ~for_ |> Resolve.Memo.read_memo + and* link_closure = + Lib.partial_link_closure [ lib ] ~for_ |> Resolve.Memo.read_memo + in + Memo.return (List.rev_append compile_closure link_closure)) + >>| List.concat + >>| Lib.Set.of_list + >>| Lib.Set.to_list +;; + +let workspace_redirects context = + let open Memo.O in + let* workspace_packages = Dune_load.packages () in + Package.Name.Map.keys workspace_packages + |> Memo.parallel_map ~f:(fun package -> + let+ { Scope.DB.Lib_entry.Set.deprecated_library_names; _ } = + Scope.DB.lib_entries_of_package context package + in + List.map + deprecated_library_names + ~f:(fun { Library_redirect.old_name; new_public_name; _ } -> + Public_lib.name (fst old_name), (package, snd new_public_name))) + >>| List.concat + >>| Lib_name.Map.of_list_reduce ~f:(fun redirect _ -> redirect) +;; + +let library_support_closure context packages = + let open Memo.O in + let* public_libs = Scope.DB.public_libs context + and* redirects_by_name = workspace_redirects context in + let collect_redirects name = + let rec loop name seen redirects = + if Lib_name.Set.mem seen name + then redirects + else ( + let seen = Lib_name.Set.add seen name in + match Lib_name.Map.find redirects_by_name name with + | None -> redirects + | Some (package, target) -> + let redirects = + if Package.Name.Set.mem packages package + then redirects + else + Install_layout.Redirect.Set.add + redirects + (Install_layout.Redirect.make ~package ~name) + in + loop target seen redirects) + in + loop name Lib_name.Set.empty Install_layout.Redirect.Set.empty + in + let* roots, redirects = + Package.Name.Set.to_list packages + |> Memo.parallel_map ~f:(fun package -> + let* { Scope.DB.Lib_entry.Set.libraries; deprecated_library_names } = + Scope.DB.lib_entries_of_package context package + in + let+ redirect_targets = + Memo.parallel_map deprecated_library_names ~f:(fun { new_public_name; _ } -> + let+ target = + Lib.DB.resolve public_libs new_public_name |> Resolve.Memo.read_memo + in + target, collect_redirects (snd new_public_name)) + in + ( List.rev_append + (List.rev_map libraries ~f:Lib.Local.to_lib) + (List.map redirect_targets ~f:fst) + , List.fold_left + redirect_targets + ~init:Install_layout.Redirect.Set.empty + ~f:(fun redirects (_, selected) -> + Install_layout.Redirect.Set.union redirects selected) )) + >>| List.split + >>| fun (roots, redirects) -> + ( List.concat roots + , List.fold_left + redirects + ~init:Install_layout.Redirect.Set.empty + ~f:Install_layout.Redirect.Set.union ) + in + let extra_dependencies libraries = + Memo.parallel_map libraries ~f:(fun lib -> + if Lib.is_local lib + then + Memo.parallel_map [ Compilation_mode.Ocaml; Melange ] ~f:(fun for_ -> + Lib.ppx_runtime_deps lib ~for_ |> Resolve.Memo.read_memo) + >>| List.concat + else Memo.return []) + >>| List.concat + in + let rec loop todo expanded inspected libraries = + match todo with + | [] -> Memo.return libraries + | lib :: todo -> + if Lib.Set.mem expanded lib + then loop todo expanded inspected libraries + else + let* closure = library_closure lib in + let expanded = Lib.Set.add expanded lib in + let uninspected = + List.filter closure ~f:(fun lib -> not (Lib.Set.mem inspected lib)) + in + let inspected = List.fold_left uninspected ~init:inspected ~f:Lib.Set.add in + let libraries = List.fold_left closure ~init:libraries ~f:Lib.Set.add in + let* extra_dependencies = extra_dependencies uninspected in + loop (List.rev_append extra_dependencies todo) expanded inspected libraries + in + let+ closure = loop roots Lib.Set.empty Lib.Set.empty Lib.Set.empty in + let libraries = + Lib.Set.fold closure ~init:Install_layout.Library.Set.empty ~f:(fun lib libraries -> + match Lib.is_local lib, Lib_info.package (Lib.info lib) with + | true, Some package when not (Package.Name.Set.mem packages package) -> + Install_layout.Library.Set.add + libraries + (Install_layout.Library.make ~package ~name:(Lib.name lib)) + | _ -> libraries) + in + { Install_layout.libraries; redirects } +;; + +let library_install_entries sctx libraries redirects = + let* entries_by_library = Stanzas_to_entries.library_entries sctx in + let selected_libraries = + Install_layout.Library.Set.to_list libraries + |> List.map ~f:(fun library -> + match Install_layout.Library.Map.find entries_by_library library with + | Some entries -> + ( Install_layout.Library.package library + , (Install_layout.Library.name library, entries) ) + | None -> + Code_error.raise + "No install entries found for a local library in an install layout" + [ "library", Install_layout.Library.to_dyn library ]) + |> Package.Name.Map.of_list_multi + in + let selected_redirects = + Install_layout.Redirect.Set.to_list redirects + |> List.map ~f:(fun redirect -> + Install_layout.Redirect.package redirect, Install_layout.Redirect.name redirect) + |> Package.Name.Map.of_list_multi + in + let selected_packages = + List.rev_append + (Package.Name.Map.keys selected_libraries) + (Package.Name.Map.keys selected_redirects) + |> Package.Name.Set.of_list + in + let* packages = Dune_load.packages () in + let context = Super_context.context sctx |> Context.name in + let+ entries = + Package.Name.Set.to_list selected_packages + |> Memo.parallel_map ~f:(fun package_name -> + let package = + match Package.Name.Map.find packages package_name with + | Some package -> package + | None -> + Code_error.raise + "No package found for local support metadata in an install layout" + [ "package", Package.Name.to_dyn package_name ] + in + let selected = + Package.Name.Map.find selected_libraries package_name |> Option.value ~default:[] + in + let selected_names = + Lib_name.Set.of_list_map selected ~f:(fun (library, _) -> library) + in + let selected_redirect_names = + Package.Name.Map.find selected_redirects package_name + |> Option.value ~default:[] + |> Lib_name.Set.of_list + in + let install_entries = + List.concat_map selected ~f:(fun (_, entries) -> entries) + |> List.sort ~compare:compare_install_entries + in + let* all_lib_entries = + let+ entries = Scope.DB.lib_entries_of_package context package_name in + Scope.DB.Lib_entry.Set.to_list entries + in + let lib_entries = + List.filter all_lib_entries ~f:(function + | Scope.DB.Lib_entry.Library lib -> + Lib_name.Set.mem selected_names (Lib.name (Lib.Local.to_lib lib)) + | Deprecated_library_name { old_name; new_public_name = _, new_public_name; _ } + -> + Lib_name.Set.mem selected_redirect_names (Public_lib.name (fst old_name)) + || Lib_name.Set.mem selected_names new_public_name) + in + let* generated_entries = + Meta_and_dune_package.support_metadata_entries + sctx + ~package + ~lib_entries + ~install_entries + in + let install_entries = + List.map install_entries ~f:(fun entry -> package_name, entry) + in + Memo.return (install_entries, generated_entries)) + in + { Install_layout.install_entries = List.concat_map entries ~f:fst + ; generated_entries = List.concat_map entries ~f:snd + } +;; + let () = - Install_layout.set_entry_resolver (fun context_name package -> - let open Memo.O in - let* sctx = Super_context.find_exn context_name in - install_entries sctx package) + Install_layout.set_resolvers + { Install_layout.package_entries = + (fun context_name package -> + let open Memo.O in + let* sctx = Super_context.find_exn context_name in + install_entries sctx package) + ; library_support = library_support_closure + ; library_entries = + (fun context_name libraries redirects -> + let open Memo.O in + let* sctx = Super_context.find_exn context_name in + library_install_entries sctx libraries redirects) + } ;; let packages = diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index e7e01a84a72..fc0a5948926 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1198,6 +1198,13 @@ module Resolve_names : sig -> for_:Compilation_mode.t -> lib list Resolve.Memo.t + val partial_linking_closure_with_overlap_checks + : db option + -> lib list + -> forbidden_libraries:Loc.t Map.t + -> for_:Compilation_mode.t + -> lib list Resolve.Memo.t + val make_instantiate : db Lazy.t -> (Lib_name.t -> Path.t Lib_info.t -> hidden:string option -> Status.t Memo.t) @@ -2167,6 +2174,28 @@ end = struct Closure.result state `Compile ~for_ and linking_closure_with_overlap_checks db ts ~forbidden_libraries ~for_ = + linking_closure_with_overlap_checks_and_result + db + ts + ~forbidden_libraries + ~for_ + ~result:`Link + + and partial_linking_closure_with_overlap_checks db ts ~forbidden_libraries ~for_ = + linking_closure_with_overlap_checks_and_result + db + ts + ~forbidden_libraries + ~for_ + ~result:`Partial_link + + and linking_closure_with_overlap_checks_and_result + db + ts + ~forbidden_libraries + ~for_ + ~result + = let open Resolve.Memo.O in let closure, visit = step1_closure db ts ~forbidden_libraries ~for_ in let rec impls_via_defaults (state : Closure.state) = @@ -2186,7 +2215,7 @@ end = struct in let* state = visit in let* state = impls_via_defaults state in - Closure.result state `Link ~for_ + Closure.result state result ~for_ and check_forbidden ts ~forbidden_libraries ~for_ = let open Resolve.Memo.O in @@ -2204,6 +2233,13 @@ let closure l ~linking = else Resolve_names.compile_closure_with_overlap_checks None l ~forbidden_libraries ;; +let partial_link_closure l = + Resolve_names.partial_linking_closure_with_overlap_checks + None + l + ~forbidden_libraries:Map.empty +;; + let descriptive_closure (l : lib list) ~with_pps ~for_ : lib list Memo.t = (* [add_work todo l] adds the libraries in [l] to the list [todo], that contains the libraries to handle next *) diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 05c09eccbb4..0354edc4b8d 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -224,6 +224,10 @@ end val closure : t list -> linking:bool -> for_:Compilation_mode.t -> t list Resolve.Memo.t +(** Compute a link closure while permitting virtual libraries without an + implementation. Available default implementations are still selected. *) +val partial_link_closure : t list -> for_:Compilation_mode.t -> t list Resolve.Memo.t + (** [descriptive_closure ~with_pps libs] computes the smallest set of libraries that contains the libraries in the list [libs], and that is transitively closed. If [with_pps = true], then the dependencies towards ppx-rewriters diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 5aaa95dff9a..b9bcd7b48ce 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -494,6 +494,11 @@ module DB = struct f (Deprecated_library_name dep) acc) ;; + let to_list { libraries; deprecated_library_names } = + List.map libraries ~f:(fun library -> Library library) + @ List.map deprecated_library_names ~f:(fun name -> Deprecated_library_name name) + ;; + let partition_map t ~f = let l, r = fold t ~init:([], []) ~f:(fun x (l, r) -> diff --git a/src/dune_rules/scope.mli b/src/dune_rules/scope.mli index b245a787f96..bd326fa537f 100644 --- a/src/dune_rules/scope.mli +++ b/src/dune_rules/scope.mli @@ -35,6 +35,7 @@ module DB : sig ; deprecated_library_names : Deprecated_library_name.t list } + val to_list : t -> entry list val partition_map : t -> f:(entry -> ('a, 'b) Either.t) -> 'a list * 'b list end end diff --git a/src/install/entry.ml b/src/install/entry.ml index c8489adb896..2f61dd41c5f 100644 --- a/src/install/entry.ml +++ b/src/install/entry.ml @@ -5,6 +5,7 @@ open Import module Dst : sig type t + val of_string : string -> t val to_string : t -> string val local : t -> Path.Local.t val append_local : t -> Path.Local.t -> t @@ -25,6 +26,7 @@ module Dst : sig end = struct type t = string + let of_string t = t let to_string t = t let local t = Path.Local.of_string t let append_local t l = Filename.concat t (Path.Local.to_string l) diff --git a/src/install/entry.mli b/src/install/entry.mli index 4b094a27271..65e10b098c5 100644 --- a/src/install/entry.mli +++ b/src/install/entry.mli @@ -5,6 +5,7 @@ open Import module Dst : sig type t + val of_string : string -> t val to_string : t -> string val local : t -> Path.Local.t val prepend_local : Path.Local.t -> t -> t diff --git a/test/blackbox-tests/test-cases/package-materialization/deprecated-package-redirect.t b/test/blackbox-tests/test-cases/package-materialization/deprecated-package-redirect.t new file mode 100644 index 00000000000..d1dd42e8160 --- /dev/null +++ b/test/blackbox-tests/test-cases/package-materialization/deprecated-package-redirect.t @@ -0,0 +1,70 @@ +A selected redirect can belong to a deprecated package name. Its owning package +must then contribute the separate META and dune-package files generated under +that deprecated name. + + $ make_dune_project 3.24 + $ cat >>dune-project <<'EOF' + > (package (name redirect-root)) + > (package + > (name redirect-owner) + > (deprecated_package_names old-support)) + > (package (name redirect-target)) + > EOF + + $ mkdir root owner target consumer + $ cat >root/dune <<'EOF' + > (deprecated_library_name + > (old_public_name redirect-root.old) + > (new_public_name old-support.lib)) + > EOF + + $ cat >owner/dune <<'EOF' + > (deprecated_library_name + > (old_public_name old-support.lib) + > (new_public_name redirect-target)) + > EOF + + $ cat >target/dune <<'EOF' + > (library + > (name redirect_target) + > (public_name redirect-target)) + > EOF + $ echo 'let value = 42' >target/redirect_target.ml + + $ cat >consumer/dune-project <<'EOF' + > (lang dune 3.24) + > EOF + $ cat >consumer/dune <<'EOF' + > (executable + > (name main) + > (libraries redirect-root.old)) + > EOF + $ echo 'let () = print_int Redirect_target.value' >consumer/main.ml + + $ cat >dune <<'EOF' + > (rule + > (target result) + > (deps (package redirect-root)) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query -recursive redirect-root.old)))) + > (rule + > (target dune-package-result) + > (deps + > (package redirect-root) + > (source_tree consumer)) + > (action + > (with-stdout-to %{target} + > (chdir consumer (run %{bin:dune} exec ./main.exe))))) + > EOF + +The scoped layout emits metadata for the intermediate deprecated package, so +findlib can follow the complete chain. + + $ dune build result + +The generated dune-package metadata lets a nested Dune consumer follow the same +redirect chain. + + $ dune build dune-package-result && cat _build/default/dune-package-result + 42 diff --git a/test/blackbox-tests/test-cases/package-materialization/dune b/test/blackbox-tests/test-cases/package-materialization/dune index a4dde991d06..aff094aabd6 100644 --- a/test/blackbox-tests/test-cases/package-materialization/dune +++ b/test/blackbox-tests/test-cases/package-materialization/dune @@ -1,7 +1,15 @@ (cram (applies_to + deprecated-package-redirect + independent-roots installed-package no-transitive-through-targets ocamlfind + redirect-chain + transitive-closure virtual-without-default) (deps %{bin:ocamlfind})) + +(cram + (applies_to melange-closure) + (deps %{bin:melc})) diff --git a/test/blackbox-tests/test-cases/package-materialization/independent-roots.t b/test/blackbox-tests/test-cases/package-materialization/independent-roots.t new file mode 100644 index 00000000000..f724940d9bb --- /dev/null +++ b/test/blackbox-tests/test-cases/package-materialization/independent-roots.t @@ -0,0 +1,86 @@ +Each library installed by an explicitly requested package is an independent +closure root. Combining the roots before resolving virtual implementations can +suppress a default implementation needed by one root. + + $ make_dune_project 3.24 + $ cat >>dune-project <<'EOF' + > (package (name roots)) + > (package (name virtual-support)) + > (package (name alternative-support)) + > EOF + + $ mkdir roots-a roots-b virtual-lib default-impl alternative-impl + $ cat >virtual-lib/dune <<'EOF' + > (library + > (name virtual_support) + > (public_name virtual-support) + > (wrapped false) + > (virtual_modules virtual_support) + > (default_implementation virtual-support.default)) + > EOF + $ echo 'val value : int' >virtual-lib/virtual_support.mli + + $ cat >default-impl/dune <<'EOF' + > (library + > (name default_impl) + > (public_name virtual-support.default) + > (implements virtual-support)) + > EOF + $ echo 'let value = 1' >default-impl/virtual_support.ml + + $ cat >alternative-impl/dune <<'EOF' + > (library + > (name alternative_impl) + > (public_name alternative-support) + > (implements virtual-support)) + > EOF + $ echo 'let value = 2' >alternative-impl/virtual_support.ml + +The first root selects the alternative implementation while the second root +uses the virtual library on its own and therefore needs the default. + + $ cat >roots-b/dune <<'EOF' + > (library + > (name roots_b) + > (public_name roots.b) + > (libraries virtual-support)) + > EOF + $ echo 'let value = Virtual_support.value' >roots-b/roots_b.ml + + $ cat >roots-a/dune <<'EOF' + > (library + > (name roots_a) + > (public_name roots.a) + > (libraries roots.b alternative-support)) + > EOF + $ echo 'let value = Roots_b.value' >roots-a/roots_a.ml + + $ cat >dune <<'EOF' + > (rule + > (target result) + > (deps (package roots)) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query -predicates byte -format "%d/%A" + > virtual-support.default)))) + > (rule + > (target alternative-result) + > (deps (package roots)) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query -predicates byte -format "%d/%A" + > alternative-support)))) + > EOF + +Each root is closed independently, so the layout includes both the alternative +implementation selected by `roots.a` and the default needed by `roots.b`. + + $ dune build result + $ cat _build/default/result | censor + $PWD/_build/install/default/.packages/$DIGEST/lib/virtual-support/default/default_impl.cma + $ test -f "$(cat _build/default/result)" + + $ dune build alternative-result + $ cat _build/default/alternative-result | censor + $PWD/_build/install/default/.packages/$DIGEST/lib/alternative-support/alternative_impl.cma + $ test -f "$(cat _build/default/alternative-result)" diff --git a/test/blackbox-tests/test-cases/package-materialization/installed-package.t b/test/blackbox-tests/test-cases/package-materialization/installed-package.t index 575329501e0..20aecd86316 100644 --- a/test/blackbox-tests/test-cases/package-materialization/installed-package.t +++ b/test/blackbox-tests/test-cases/package-materialization/installed-package.t @@ -2,42 +2,112 @@ Test that (deps (package ...)) works with externally installed packages. Installed packages (found via findlib) go through the Installed codepath, not the layout. The layout only applies to Local (workspace) packages. -Install package "a" into a prefix: +Install packages "a" and "b" into a prefix. Library `a` depends on library +`b`, so its installed metadata records `b` as a requirement. $ mkdir a consumer prefix $ cat >a/dune-project < (lang dune 3.24) > (package (name a)) + > (package (name b)) > EOF $ cat >a/dune < (library (public_name a)) + > (library + > (public_name a) + > (libraries b)) > EOF $ cat >a/a.ml < let msg = "hello from lib a" + > let value = B.value + 1 + > EOF + + $ mkdir a/b + + $ cat >a/b/dune < (library (public_name b)) + > EOF + + $ cat >a/b/b.ml < let value = 1 > EOF $ dune build --root a @install $ dune install --root a --prefix $PWD/prefix 2>/dev/null $ test -f prefix/lib/a/META + $ test -f prefix/lib/b/META Now create a consumer project that depends on the installed package. -The consumer uses (deps (package a)) and ocamlfind to verify the -package is findable: +The consumer uses `(deps (package a))` and external OCaml tooling to verify +that both `a` and its library dependency are findable: $ cat >consumer/dune-project < (lang dune 3.24) > EOF + $ cat >consumer/main.ml < let () = print_int A.value + > EOF + $ cat >consumer/dune <<'EOF' > (rule - > (deps (package a)) - > (action (with-stdout-to out - > (run ocamlfind query a)))) + > (target main.exe) + > (deps + > main.ml + > (package a)) + > (action + > (run ocamlfind ocamlc -package a -linkpkg -o %{target} main.ml))) + > EOF + + $ OCAMLPATH=$PWD/prefix/lib dune build --root consumer main.exe + $ consumer/_build/default/main.exe + 2 + +When `--only-packages` masks a workspace library in the closure, library +resolution falls back to its installed copy. The installed library remains on +the inherited `OCAMLPATH`; it is not rematerialized as workspace support. + + $ mkdir masked masked/a-src masked/b-src + + $ cat >masked/dune-project < (lang dune 3.24) + > (package (name a)) + > (package (name b)) + > EOF + + $ cat >masked/a-src/dune < (library + > (public_name a) + > (libraries b)) + > EOF + + $ cat >masked/a-src/a.ml < let value = B.value + 10 + > EOF + + $ cat >masked/b-src/dune < (library (public_name b)) + > EOF + + $ cat >masked/b-src/b.ml < let value = 100 + > EOF + + $ cat >masked/main.ml < let () = print_int A.value + > EOF + + $ cat >masked/dune <<'EOF' + > (rule + > (target main.exe) + > (deps + > main.ml + > (package a)) + > (action + > (run %{bin:ocamlfind} ocamlc -package a -linkpkg -o %{target} main.ml))) > EOF - $ OCAMLPATH=$PWD/prefix/lib/:$OCAMLPATH dune build --root consumer out - $ cat consumer/_build/default/out - $TESTCASE_ROOT/prefix/lib/a + $ OCAMLPATH=$PWD/prefix/lib dune build --root masked --only-packages a main.exe + $ masked/_build/default/main.exe + 11 diff --git a/test/blackbox-tests/test-cases/package-materialization/melange-closure.t b/test/blackbox-tests/test-cases/package-materialization/melange-closure.t new file mode 100644 index 00000000000..9f22d333ad6 --- /dev/null +++ b/test/blackbox-tests/test-cases/package-materialization/melange-closure.t @@ -0,0 +1,56 @@ +A scoped package layout retains a library's Melange-only requirements in its +`dune-package` file, so it must materialize the corresponding Melange closure. + + $ make_dune_project 3.24 + $ cat >>dune-project <<'EOF' + > (using melange 0.1) + > (package (name melange-root)) + > (package (name melange-support)) + > EOF + + $ mkdir root support consumer + $ cat >support/dune <<'EOF' + > (library + > (name melange_support) + > (public_name melange-support) + > (modes melange)) + > EOF + $ echo 'let value = 42' >support/melange_support.ml + + $ cat >root/dune <<'EOF' + > (library + > (name melange_root) + > (public_name melange-root) + > (modes melange) + > (melange.libraries melange-support)) + > EOF + $ echo 'let value = Melange_support.value' >root/melange_root.ml + + $ cat >consumer/dune-project <<'EOF' + > (lang dune 3.24) + > (using melange 0.1) + > EOF + $ cat >consumer/dune <<'EOF' + > (melange.emit + > (target out) + > (emit_stdlib false) + > (modules main) + > (libraries melange-root)) + > EOF + $ echo 'let () = Js.log Melange_root.value' >consumer/main.ml + + $ cat >dune <<'EOF' + > (rule + > (target result) + > (deps + > (package melange-root) + > (source_tree consumer)) + > (action + > (with-stdout-to %{target} + > (chdir consumer (run %{bin:dune} build @melange))))) + > EOF + +The scoped layout follows the serialized `melange_requires` edge, so the nested +Melange build can resolve and compile the support library. + + $ dune build result diff --git a/test/blackbox-tests/test-cases/package-materialization/ocamlfind.t b/test/blackbox-tests/test-cases/package-materialization/ocamlfind.t index ed608c8c496..93e54896b1b 100644 --- a/test/blackbox-tests/test-cases/package-materialization/ocamlfind.t +++ b/test/blackbox-tests/test-cases/package-materialization/ocamlfind.t @@ -39,9 +39,9 @@ the query against the layout's OCAMLPATH. $ dune build out -Immediate-deps-only: myutil is mylib's declared opam dependency but is -NOT in the layout for (deps (package mylib)). ocamlfind fails to find -it. +Library closure: myutil is both mylib's declared opam dependency and a library +dependency, so it is included in the layout for (deps (package mylib)) and +ocamlfind can locate it. $ cat >dune <<'EOF' > (rule @@ -52,14 +52,6 @@ it. > EOF $ dune build out2 - File "dune", lines 1-5, characters 0-96: - 1 | (rule - 2 | (deps (package mylib)) - 3 | (action - 4 | (with-stdout-to out2 - 5 | (run ocamlfind query myutil)))) - ocamlfind: Package `myutil' not found - [1] Declaring both packages explicitly makes both visible. diff --git a/test/blackbox-tests/test-cases/package-materialization/redirect-chain.t b/test/blackbox-tests/test-cases/package-materialization/redirect-chain.t new file mode 100644 index 00000000000..9fa70fc3286 --- /dev/null +++ b/test/blackbox-tests/test-cases/package-materialization/redirect-chain.t @@ -0,0 +1,76 @@ +A scoped package dependency materializes metadata for every intermediate name +in a deprecated-library redirect chain. + + $ make_dune_project 3.24 + $ cat >>dune-project < (package (name redirect-root)) + > (package (name redirect-middle)) + > (package (name redirect-target)) + > EOF + + $ mkdir root middle target middle-unrelated target-unrelated + $ cat >root/dune <<'EOF' + > (deprecated_library_name + > (old_public_name redirect-root.old) + > (new_public_name redirect-middle.old)) + > EOF + + $ cat >middle/dune <<'EOF' + > (deprecated_library_name + > (old_public_name redirect-middle.old) + > (new_public_name redirect-target)) + > EOF + + $ cat >target/dune <<'EOF' + > (library + > (name redirect_target) + > (public_name redirect-target)) + > EOF + $ echo 'let value = 42' >target/redirect_target.ml + + $ cat >middle-unrelated/dune <<'EOF' + > (library + > (name middle_unrelated) + > (public_name redirect-middle.unrelated)) + > EOF + $ echo 'let value = ()' >middle-unrelated/unrelated.ml + + $ cat >target-unrelated/dune <<'EOF' + > (library + > (name target_unrelated) + > (public_name redirect-target.unrelated)) + > EOF + $ echo 'let value = ()' >target-unrelated/unrelated.ml + + $ cat >dune <<'EOF' + > (rule + > (target recursive) + > (deps (package redirect-root)) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query -recursive redirect-root.old)))) + > (rule + > (target no-middle-unrelated) + > (deps (package redirect-root)) + > (action + > (progn + > (bash "! %{bin:ocamlfind} query redirect-middle.unrelated >/dev/null 2>&1") + > (write-file %{target} "")))) + > (rule + > (target no-target-unrelated) + > (deps (package redirect-root)) + > (action + > (progn + > (bash "! %{bin:ocamlfind} query redirect-target.unrelated >/dev/null 2>&1") + > (write-file %{target} "")))) + > EOF + + $ dune build recursive + $ sort _build/default/recursive | censor + $PWD/_build/install/default/.packages/$DIGEST/lib/redirect-middle/old + $PWD/_build/install/default/.packages/$DIGEST/lib/redirect-root/old + $PWD/_build/install/default/.packages/$DIGEST/lib/redirect-target + +Unrelated siblings remain absent from the scoped layout. + + $ dune build no-middle-unrelated no-target-unrelated diff --git a/test/blackbox-tests/test-cases/package-materialization/strict-package-deps.t b/test/blackbox-tests/test-cases/package-materialization/strict-package-deps.t index 4c0d2f80a7a..6814cfd8bac 100644 --- a/test/blackbox-tests/test-cases/package-materialization/strict-package-deps.t +++ b/test/blackbox-tests/test-cases/package-materialization/strict-package-deps.t @@ -1,6 +1,6 @@ Test that (strict_package_deps) does not affect the install layout. The -layout always uses immediate deps only. strict_package_deps controls -validation in install_rules, not layout closure. +layout follows library dependencies, not package dependencies. +strict_package_deps controls validation in install_rules, not layout closure. $ cat >dune-project < (lang dune 3.24) @@ -13,7 +13,9 @@ validation in install_rules, not layout closure. $ mkdir foo-src bar-src baz-src $ cat >foo-src/dune < (library (public_name foo)) + > (library + > (public_name foo) + > (libraries bar)) > EOF $ cat >foo-src/foo.ml < EOF $ cat >bar-src/dune < (library (public_name bar)) + > (library + > (public_name bar) + > (libraries baz)) > EOF $ cat >bar-src/bar.ml <dune-project < (lang dune 3.24) - > (package (name foo) (depends bar)) - > (package (name bar) (depends baz)) +The library closure is necessary because tools consuming an installed OCaml +library expect its transitive library dependencies to be findable. Following +package dependencies would be broader: those dependencies can contain +unrelated executables, data, or libraries, and are not reliably available for +all kinds of packages. + + $ make_dune_project 3.24 + $ cat >>dune-project < (package (name foo) (depends package-only-dep)) + > (package (name bar)) > (package (name baz)) + > (package (name namespace)) + > (package (name package-only-dep)) + > (package (name ppx-runtime)) + > (package (name redirect-root)) + > (package (name redirect-target)) + > (package (name stubbed)) + > (package (name test-ppx)) + > (package (name virtual-root)) + > (package (name virtual-support)) > EOF - $ mkdir foo-src bar-src baz-src + $ mkdir foo-src bar-src bar-private-src bar-unrelated-src baz-src namespace-src + $ mkdir namespace-unrelated-src package-only-dep-src + $ mkdir redirect-root-src redirect-target-src virtual-root-src + $ mkdir virtual-support-src virtual-support-impl-src stubbed-src $ cat >foo-src/dune < (library (public_name foo)) + > (library + > (public_name foo) + > (libraries bar namespace.selected)) > EOF $ cat >foo-src/foo.ml < let x = 1 + > let x = Bar.y + 1 > EOF $ cat >bar-src/dune < (library (public_name bar)) + > (library + > (public_name bar) + > (libraries baz bar_private stubbed)) + > (deprecated_library_name + > (old_public_name bar.old) + > (new_public_name bar)) > EOF $ cat >bar-src/bar.ml < let y = 2 + > let y = Baz.z + Bar_private.offset + Stubbed.value () + > EOF + +The installed form of `bar` needs its package-private library too. It is part +of the library closure even though it cannot be named as a public library in +the workspace. + + $ cat >bar-private-src/dune < (library + > (name bar_private) + > (package bar)) + > EOF + + $ cat >bar-private-src/bar_private.ml < let offset = 1 + > EOF + +The package that owns `bar` also contains an unrelated library. Requiring +`bar` must not make this sibling library available. + + $ cat >bar-unrelated-src/dune < (library + > (name bar_unrelated) + > (public_name bar.unrelated)) + > EOF + + $ cat >bar-unrelated-src/bar_unrelated.ml < let unused = () > EOF $ cat >baz-src/dune < let z = 3 > EOF +Only `namespace.selected`, not a top-level `namespace` library, is in the +closure. Findlib subpackages inherit their directory but not arbitrary +top-level variables, so the filtered META drops `top_marker`. + + $ cat >namespace-src/dune < (library + > (name selected) + > (public_name namespace.selected)) + > EOF + + $ cat >namespace-src/selected.ml < let unused = () + > EOF + + $ cat >namespace-unrelated-src/dune < (library + > (name unrelated) + > (public_name namespace.unrelated)) + > EOF + + $ cat >namespace-unrelated-src/unrelated.ml < let unused = () + > EOF + + $ cat >META.namespace.template < top_marker = "drop" + > # DUNE_GEN + > EOF + + $ cat >package-only-dep-src/dune < (library + > (name package_only_dep) + > (public_name package-only-dep)) + > EOF + + $ cat >package-only-dep-src/package_only_dep.ml < let unused = () + > EOF + +Library support includes native stubs and the stublibs entries needed to load +them from bytecode. + + $ cat >stubbed-src/dune < (library + > (public_name stubbed) + > (foreign_stubs + > (language c) + > (names stubbed_stubs))) + > EOF + + $ cat >stubbed-src/stubbed.ml < external value : unit -> int = "stubbed_value" + > EOF + + $ cat >stubbed-src/stubbed_stubs.c < #include + > CAMLprim value stubbed_value(value unit) + > { + > (void) unit; + > return Val_int(4); + > } + > EOF + +A deprecated name owned by an explicitly declared package may redirect to a +library in another package. The redirect target is a root of the library +closure even when the declared package has no libraries of its own. + + $ cat >redirect-root-src/dune < (deprecated_library_name + > (old_public_name redirect-root.old) + > (new_public_name redirect-target)) + > EOF + + $ cat >redirect-target-src/dune < (library + > (name redirect_target) + > (public_name redirect-target)) + > EOF + + $ cat >redirect-target-src/redirect_target.ml < let value = 42 + > EOF + +A virtual library's default implementation must belong to the same package as +the virtual library. It is nevertheless a separate library, and is part of the +link-time library closure selected by a consumer. + + $ cat >virtual-root-src/dune < (library + > (name virtual_root) + > (public_name virtual-root) + > (libraries virtual-support)) + > EOF + + $ cat >virtual-root-src/virtual_root.ml < let value = Virtual_support.value + > EOF + + $ cat >virtual-support-src/dune < (library + > (name virtual_support) + > (public_name virtual-support) + > (wrapped false) + > (virtual_modules virtual_support) + > (default_implementation virtual-support.default)) + > EOF + + $ cat >virtual-support-src/virtual_support.mli < val value : int + > EOF + + $ cat >virtual-support-impl-src/dune < (library + > (name virtual_support_default) + > (public_name virtual-support.default) + > (implements virtual-support)) + > EOF + + $ cat >virtual-support-impl-src/virtual_support.ml < let value = 42 + > EOF + +A PPX rewriter's runtime libraries are part of the library support closure +even though they are not ordinary `requires`. + + $ make_hello_ppx_runtime_fixture + + $ cat >hello/dune < (library + > (name hello) + > (public_name ppx-runtime)) + > EOF + + $ cat >hello_ppx/dune < (library + > (name hello_ppx) + > (public_name test-ppx) + > (kind ppx_rewriter) + > (ppx_runtime_libraries ppx-runtime) + > (ppx.driver (main Hello_ppx.main))) + > EOF + + $ cat >main.ml < let () = print_int Foo.x + > EOF + $ cat >dune <<'EOF' > (rule + > (target main.exe) + > (deps + > main.ml + > (package foo)) + > (action + > (run + > %{bin:ocamlfind} + > ocamlc + > -custom + > -package + > foo + > -linkpkg + > -o + > %{target} + > main.ml))) + > (rule + > (targets main.bc stubs-result) + > (deps + > main.ml + > (package foo)) + > (action + > (progn + > (run %{bin:ocamlfind} ocamlc -package foo -linkpkg -o main.bc main.ml) + > (with-stdout-to stubs-result (run %{bin:ocamlrun} main.bc))))) + > (rule + > (target redirect) > (deps (package foo)) - > (action (with-stdout-to out (echo "ok")))) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query bar.old)))) + > (rule + > (target namespace-marker) + > (deps (package foo)) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query -format "%(top_marker)" namespace)))) + > (rule + > (target ppx-runtime-marker) + > (deps (package test-ppx)) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query ppx-runtime)))) + > (rule + > (target root-redirect) + > (deps (package redirect-root)) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query -recursive redirect-root.old)))) > EOF - $ dune build out +The package dependency supplies enough of the library closure for external +OCaml tooling to compile and link against `foo`. + + $ dune build main.exe && _build/default/main.exe + 9 + $ dune build stubs-result && cat _build/default/stubs-result + 9 + $ dune build redirect + $ dune build namespace-marker && test -z "$(cat _build/default/namespace-marker)" + $ dune build ppx-runtime-marker + $ dune build root-redirect -Only foo appears, neither bar nor baz, even though foo declares -(depends bar) and bar declares (depends baz): +The filtered dune-package files are consumed by a nested Dune invocation. In +particular, Dune must be able to select and link the virtual library's default +implementation from the support package. - $ dune rules --format=json _build/default/out | jq_dune '.[] | ruleDepFilePaths' | censor | grep dune-package | sort + $ mkdir consumer + $ cat >consumer/dune-project < (lang dune 3.24) + > EOF + + $ cat >consumer/dune < (executable + > (name main) + > (libraries foo virtual-root)) + > EOF + + $ cat >consumer/main.ml < let () = print_int (Foo.x + Virtual_root.value) + > EOF + + $ cat >>dune <<'EOF' + > (rule + > (target dune-package-result) + > (deps + > (package foo) + > (package virtual-root) + > (source_tree consumer)) + > (action + > (with-stdout-to %{target} + > (chdir consumer (run %{bin:dune} exec ./main.exe))))) + > EOF + + $ dune build dune-package-result && cat _build/default/dune-package-result + 51 + +The layout contains `foo` and the artifacts in its library closure. It does not +contain `package-only-dep`, because that edge exists only in package metadata. + + $ dune rules --format=json _build/default/main.exe | + > jq_dune '.[] | ruleDepFilePaths' | + > censor | + > grep dune-package | + > sort + "_build/install/default/.packages/$DIGEST/lib/bar/dune-package" + "_build/install/default/.packages/$DIGEST/lib/baz/dune-package" "_build/install/default/.packages/$DIGEST/lib/foo/dune-package" + "_build/install/default/.packages/$DIGEST/lib/namespace/dune-package" + "_build/install/default/.packages/$DIGEST/lib/stubbed/dune-package" + +The required libraries' compiled interfaces are tracked by the action. + + $ dune rules --format=json _build/default/main.exe | + > jq_dune '.[] | ruleDepFilePaths' | + > censor | + > grep -E 'lib/(bar/bar|bar/__private__/bar_private/.public_cmi/bar_private|baz/baz)\.cmi' | + > sort + "_build/install/default/.packages/$DIGEST/lib/bar/__private__/bar_private/.public_cmi/bar_private.cmi" + "_build/install/default/.packages/$DIGEST/lib/bar/bar.cmi" + "_build/install/default/.packages/$DIGEST/lib/baz/baz.cmi" + +No artifact belonging to the unrelated sibling is a dependency of the action. + + $ dune rules --format=json _build/default/main.exe | + > jq_dune '.[] | ruleDepFilePaths' | + > grep bar_unrelated + [1] + +The unrelated library from package `bar` is not discoverable. + + $ cat >>dune <<'EOF' + > (rule + > (target unrelated) + > (deps (package foo)) + > (action + > (with-stdout-to %{target} + > (run %{bin:ocamlfind} query bar.unrelated)))) + > EOF + + $ dune build unrelated + File "dune", lines 59-64, characters 0-133: + 59 | (rule + 60 | (target unrelated) + 61 | (deps (package foo)) + 62 | (action + 63 | (with-stdout-to %{target} + 64 | (run %{bin:ocamlfind} query bar.unrelated)))) + ocamlfind: Package `bar.unrelated' not found + [1] diff --git a/test/blackbox-tests/test-cases/package-materialization/virtual-without-default.t b/test/blackbox-tests/test-cases/package-materialization/virtual-without-default.t index ac2d6227431..f3aefa2312b 100644 --- a/test/blackbox-tests/test-cases/package-materialization/virtual-without-default.t +++ b/test/blackbox-tests/test-cases/package-materialization/virtual-without-default.t @@ -35,12 +35,3 @@ materialized. > EOF $ dune build result - File "dune", lines 1-6, characters 0-137: - 1 | (rule - 2 | (target result) - 3 | (deps (package virtual-user)) - 4 | (action - 5 | (with-stdout-to %{target} - 6 | (run %{bin:ocamlfind} query virtual-api)))) - ocamlfind: Package `virtual-api' not found - [1]