diff --git a/bin/pkg/group.ml b/bin/pkg/group.ml index 54ae3538ea3..9687ba36d94 100644 --- a/bin/pkg/group.ml +++ b/bin/pkg/group.ml @@ -13,6 +13,7 @@ let subcommands = ; Outdated.command ; Validate_lock_dir.command ; Pkg_enabled.command + ; Print_slug.command ] ;; diff --git a/bin/pkg/print_slug.ml b/bin/pkg/print_slug.ml new file mode 100644 index 00000000000..3a7881f7af5 --- /dev/null +++ b/bin/pkg/print_slug.ml @@ -0,0 +1,40 @@ +open Import + +let term = + let+ builder = Common.Builder.term + and+ package_name = + Arg.( + required + & pos 0 (some string) None + & info [] ~doc:"The name of the package" ~docv:"PACKAGE") + in + let builder = Common.Builder.forbid_builds builder in + let common, config = Common.init builder in + let package_name = Package_name.of_string package_name in + let context_name = Context_name.default in + Scheduler.go_with_rpc_server ~common ~config (fun () -> + let open Fiber.O in + let* lock_dir_path_opt = + Memo.run (Dune_rules.Lock_dir.get_path_source context_name) + in + match lock_dir_path_opt with + | None -> User_error.raise [ Pp.textf "No lockdir found" ] + | Some lock_dir_path -> + let lock_dir = Dune_pkg.Lock_dir.read_disk_exn (Path.source lock_dir_path) in + let+ platform = Pkg_common.poll_solver_env_from_current_system () in + let packages_by_name = + Dune_pkg.Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform + in + (match Package_name.Map.find packages_by_name package_name with + | None -> + User_error.raise + [ Pp.textf "No such package: %s" (Package_name.to_string package_name) ] + | Some _package -> failwith "todo")) +;; + +let info = + let doc = "Print the slug of a package in the project's lockdir." in + Cmd.info "print-slug" ~doc +;; + +let command = Cmd.v info term diff --git a/bin/pkg/print_slug.mli b/bin/pkg/print_slug.mli new file mode 100644 index 00000000000..9d1c700d890 --- /dev/null +++ b/bin/pkg/print_slug.mli @@ -0,0 +1,4 @@ +open Import + +(** Command to print the slug of a given package within the current project. *) +val command : unit Cmd.t diff --git a/src/dune_digest/digest.ml b/src/dune_digest/digest.ml index 353085a0b9b..f0eae42a1ac 100644 --- a/src/dune_digest/digest.ml +++ b/src/dune_digest/digest.ml @@ -91,14 +91,15 @@ module Feed = struct feed_c hasher c ;; - let digest t x = Hasher.with_singleton (fun hasher -> t hasher x) + let digest hasher digest = contramap string ~f:to_string hasher digest + let compute_digest t x = Hasher.with_singleton (fun hasher -> t hasher x) end -let string s = Feed.digest Feed.string s +let string s = Feed.compute_digest Feed.string s let to_string_raw s = Blake3_mini.Digest.to_binary s let generic a = - Metrics.Timer.record "generic_digest" ~f:(fun () -> Feed.digest Feed.generic a) + Metrics.Timer.record "generic_digest" ~f:(fun () -> Feed.compute_digest Feed.generic a) ;; let path_with_executable_bit = diff --git a/src/dune_digest/digest.mli b/src/dune_digest/digest.mli index e9e8b900eea..6ea97035702 100644 --- a/src/dune_digest/digest.mli +++ b/src/dune_digest/digest.mli @@ -27,8 +27,11 @@ module Feed : sig val tuple2 : 'a t -> 'b t -> ('a * 'b) t val tuple3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t + (** Feed a digest into a hasher. *) + val digest : digest t + (** Compute the digest of a value given a feed for the type of that value. *) - val digest : 'a t -> 'a -> digest + val compute_digest : 'a t -> 'a -> digest end include Comparable_intf.S with type key := t diff --git a/src/dune_lang/package_name.mli b/src/dune_lang/package_name.mli index fbfb0772091..238ed5792ac 100644 --- a/src/dune_lang/package_name.mli +++ b/src/dune_lang/package_name.mli @@ -31,3 +31,5 @@ val file : t -> dir:Path.Source.t -> Path.Source.t val decode_opam_compatible : t Decoder.t val opam_fn : t -> Filename.t val of_opam_file_basename : Filename.t -> t option + +module Table : Hashtbl.S with type key = t diff --git a/src/dune_lang/package_version.mli b/src/dune_lang/package_version.mli index 390a58660a6..4bf6ed4474a 100644 --- a/src/dune_lang/package_version.mli +++ b/src/dune_lang/package_version.mli @@ -7,6 +7,7 @@ val of_string_opt : string -> t option val of_string_user_error : Loc.t * string -> (t, User_message.t) result val to_string : t -> string val equal : t -> t -> bool +val compare : t -> t -> ordering val hash : t -> int val digest_feed : t Dune_digest.Feed.t val to_dyn : t -> Dyn.t diff --git a/src/dune_pkg/dune_pkg.ml b/src/dune_pkg/dune_pkg.ml index 23b4777a7b2..a0172c9ac05 100644 --- a/src/dune_pkg/dune_pkg.ml +++ b/src/dune_pkg/dune_pkg.ml @@ -26,3 +26,4 @@ module Package_name = Package_name module Ocamlformat = Ocamlformat module Dev_tool = Dev_tool module Outdated = Outdated +module Dune_dep = Dune_dep diff --git a/src/dune_pkg/package_name.mli b/src/dune_pkg/package_name.mli index 58dd187bbf0..d4c55def72e 100644 --- a/src/dune_pkg/package_name.mli +++ b/src/dune_pkg/package_name.mli @@ -6,3 +6,5 @@ include module type of Dune_lang.Package_name with type t := t val of_opam_package_name : OpamTypes.name -> t val to_opam_package_name : t -> OpamTypes.name + +module Table : Hashtbl.S with type key = t diff --git a/src/dune_pkg/package_version.mli b/src/dune_pkg/package_version.mli index 342700e84f7..9ed614425d5 100644 --- a/src/dune_pkg/package_version.mli +++ b/src/dune_pkg/package_version.mli @@ -6,6 +6,7 @@ val of_string : string -> t val of_string_user_error : Loc.t * string -> (t, User_message.t) result val to_string : t -> string val equal : t -> t -> bool +val compare : t -> t -> ordering val hash : t -> int val digest_feed : t Dune_digest.Feed.t val to_dyn : t -> Dyn.t diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index b876aee63d9..540af83bd87 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -169,7 +169,7 @@ let lock_dir_of_source p = Path.Build.append_local path_prefix local |> Path.build ;; -let get_path ctx_name = +let get_paths ctx_name = let* workspace = Workspace.workspace () in let ctx = List.find_map workspace.contexts ~f:(fun ctx -> @@ -191,10 +191,18 @@ let get_path ctx_name = | Some (source_path, lock_dir_path) -> let* in_source_tree = Source_tree.find_dir source_path in (match in_source_tree with - | Some _ -> Memo.return (Some lock_dir_path) + | Some _ -> Memo.return (Some (`In_source source_path, `In_build lock_dir_path)) | None -> Memo.return None) ;; +let get_path_source ctx_name = + get_paths ctx_name >>| Option.map ~f:(fun (`In_source path, _) -> path) +;; + +let get_path ctx_name = + get_paths ctx_name >>| Option.map ~f:(fun (_, `In_build path) -> path) +;; + let get_workspace_lock_dir ctx = let* workspace = Workspace.workspace () in let+ path = get_path ctx in @@ -236,6 +244,16 @@ let of_dev_tool dev_tool = Load.load_exn (Path.source source_path) ;; +let of_dev_tool_if_lockdir_exists dev_tool = + let source_path = dev_tool_source_lock_dir dev_tool in + let* exists = Fs_memo.dir_exists (Path.Outside_build_dir.In_source_dir source_path) in + if exists + then + let+ t = Load.load_exn (Path.source source_path) in + Some t + else Memo.return None +;; + let lock_dir_active ctx = let open Memo.O in if !Clflags.ignore_lock_dir diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli index 2e04e1fb293..2d31b3b1741 100644 --- a/src/dune_rules/lock_dir.mli +++ b/src/dune_rules/lock_dir.mli @@ -7,7 +7,15 @@ val get_with_path : Context_name.t -> (Path.t * t, User_message.t) result Memo.t val get : Context_name.t -> (t, User_message.t) result Memo.t val get_exn : Context_name.t -> t Memo.t val of_dev_tool : Dune_pkg.Dev_tool.t -> t Memo.t + +(** Returns [None] if the lockdir for the specified dev tool does not exist. *) +val of_dev_tool_if_lockdir_exists : Dune_pkg.Dev_tool.t -> t option Memo.t + val lock_dir_active : Context_name.t -> bool Memo.t + +(** Returns the path to the lockdir within the source tree (if any). *) +val get_path_source : Context_name.t -> Path.Source.t option Memo.t + val get_path : Context_name.t -> Path.t option Memo.t (** The default filesystem location where the lock dir is going to get created *) diff --git a/src/dune_rules/pkg_dev_tool.ml b/src/dune_rules/pkg_dev_tool.ml index c2a590bc2a1..395b67fa47f 100644 --- a/src/dune_rules/pkg_dev_tool.ml +++ b/src/dune_rules/pkg_dev_tool.ml @@ -19,14 +19,8 @@ let universe_install_path t = (Package.Name.to_string @@ package_name t) ;; -let package_install_path t = - Path.Build.relative (universe_install_path t) (Package.Name.to_string @@ package_name t) -;; - let exe_path t = Path.Build.L.relative - (package_install_path t) + (universe_install_path t) ("target" :: exe_path_components_within_package t) ;; - -let lib_path t = Path.Build.L.relative (package_install_path t) [ "target"; "lib" ] diff --git a/src/dune_rules/pkg_dev_tool.mli b/src/dune_rules/pkg_dev_tool.mli index f1f254dadff..ee09de5b217 100644 --- a/src/dune_rules/pkg_dev_tool.mli +++ b/src/dune_rules/pkg_dev_tool.mli @@ -8,12 +8,5 @@ val install_path_base_dir_name : string containing the given dev tool *) val universe_install_path : t -> Path.Build.t -(** The path to the directory inside the _build directory containing - the installation of the package containing the given dev tool *) -val package_install_path : t -> Path.Build.t - (** The path to the executable for running the given dev tool *) val exe_path : t -> Path.Build.t - -(** The path to the lib directory associated with the given dev tool *) -val lib_path : t -> Path.Build.t diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index a3d99f6d85c..9db2cfdf928 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -11,6 +11,7 @@ include struct module Display = Dune_engine.Display module Pkg_info = Lock_dir.Pkg_info module Depexts = Lock_dir.Depexts + module Digest_feed = Dune_digest.Feed end module Variable = struct @@ -48,47 +49,41 @@ module Variable = struct end module Package_universe = struct - (* A type of group of packages that are co-installed. Different - package universes are unaware of each other. For example the - dependencies of the project and the dependencies of one of the dev - tools don't need to be mutually co-installable as they are in - different universes. *) + (* A type of group of packages that are co-installed. Multiple different + versions of a package may be co-installed into the same universe. + + Note that a dev tool universe just contains the package for the dev tool + itself and not its dependencies, which are installed into the + [Dependencies _] universe for the default context so they may be + shared with the project's dependencies. *) type t = - | Project_dependencies of Context_name.t + | Dependencies of Context_name.t | Dev_tool of Dune_pkg.Dev_tool.t let equal a b = match a, b with - | Project_dependencies a, Project_dependencies b -> Context_name.equal a b + | Dependencies a, Dependencies b -> Context_name.equal a b | Dev_tool a, Dev_tool b -> Dune_pkg.Dev_tool.equal a b | _ -> false ;; let hash t = match t with - | Project_dependencies context_name -> + | Dependencies context_name -> Tuple.T2.hash Int.hash Context_name.hash (0, context_name) | Dev_tool dev_tool -> Tuple.T2.hash Int.hash Dune_pkg.Dev_tool.hash (1, dev_tool) ;; - let to_dyn = Dyn.opaque - let context_name = function - | Project_dependencies context_name -> context_name + | Dependencies context_name -> context_name | Dev_tool _ -> (* Dev tools can only be built in the default context. *) Context_name.default ;; - let lock_dir t = - match t with - | Project_dependencies ctx -> Lock_dir.get_exn ctx - | Dev_tool dev_tool -> Lock_dir.of_dev_tool dev_tool - ;; - let lock_dir_path t = match t with - | Project_dependencies ctx -> Lock_dir.get_path ctx + | Dependencies ctx -> Lock_dir.get_path ctx | Dev_tool dev_tool -> (* CR-Leonidas-from-XIV: It probably isn't always [Some] *) dev_tool @@ -97,6 +92,104 @@ module Package_universe = struct |> Option.some |> Memo.return ;; + + let to_dyn = function + | Dependencies ctx -> Dyn.variant "Dependencies" [ Context_name.to_dyn ctx ] + | Dev_tool dev_tool -> Dyn.variant "Dev_tool" [ Dune_pkg.Dev_tool.to_dyn dev_tool ] + ;; +end + +module Pkg_digest = struct + module T = struct + type t = + { name : Package.Name.t + ; version : Package_version.t + ; lockfile_and_dependency_digest : Dune_digest.t + (* A hash of the package's lockfile as well as of the digests of all + the package's dependencies. *) + } + + let equal { name; version; lockfile_and_dependency_digest } t = + Package.Name.equal name t.name + && Package_version.equal version t.version + && Dune_digest.equal lockfile_and_dependency_digest t.lockfile_and_dependency_digest + ;; + + let compare { name; version; lockfile_and_dependency_digest } t = + let open Ordering.O in + let= () = Package.Name.compare name t.name in + let= () = Package_version.compare version t.version in + Dune_digest.compare lockfile_and_dependency_digest t.lockfile_and_dependency_digest + ;; + + let to_dyn { name; version; lockfile_and_dependency_digest } = + Dyn.record + [ "name", Package.Name.to_dyn name + ; "version", Package_version.to_dyn version + ; ( "lockfile_and_dependency_digest" + , Dune_digest.to_dyn lockfile_and_dependency_digest ) + ] + ;; + + let hash { name; version; lockfile_and_dependency_digest } = + Tuple.T3.hash + Package.Name.hash + Package_version.hash + Dune_digest.hash + (name, version, lockfile_and_dependency_digest) + ;; + end + + include T + include Comparable.Make (T) + + let to_string { name; version; lockfile_and_dependency_digest } = + sprintf + "%s.%s-%s" + (Package.Name.to_string name) + (Package_version.to_string version) + (Dune_digest.to_string lockfile_and_dependency_digest) + ;; + + let of_string s = + let parse_error msg = + User_error.raise [ Pp.textf "Failed to parse %S as a package pkg digest." s; msg ] + in + match String.lsplit2 s ~on:'.' with + | Some (name, rest) -> + (match String.rsplit2 rest ~on:'-' with + | Some (version, lockfile_and_dependency_digest) -> + (match Dune_digest.from_hex lockfile_and_dependency_digest with + | Some lockfile_and_dependency_digest -> + let name = Package.Name.of_string name in + let version = Package_version.of_string version in + { name; version; lockfile_and_dependency_digest } + | None -> + parse_error + (Pp.textf "Failed to parse %S as digest" lockfile_and_dependency_digest)) + | None -> parse_error (Pp.text "Missing '-' between version and lockfile digest.")) + | None -> parse_error (Pp.text "Missing '.' between name and version.") + ;; + + let digest_feed = + Digest_feed.tuple3 + Package.Name.digest_feed + Package_version.digest_feed + Digest_feed.digest + |> Digest_feed.contramap ~f:(fun { name; version; lockfile_and_dependency_digest } -> + name, version, lockfile_and_dependency_digest) + ;; + + let create lockfile_pkg depends_pkg_digests = + let lockfile_and_dependency_digest = + Digest_feed.compute_digest + (Digest_feed.tuple2 Lock_dir.Pkg.digest_feed (Digest_feed.list digest_feed)) + (Dune_pkg.Lock_dir.Pkg.remove_locs lockfile_pkg, depends_pkg_digests) + in + let name = lockfile_pkg.info.name in + let version = lockfile_pkg.info.version in + { name; version; lockfile_and_dependency_digest } + ;; end module Paths = struct @@ -151,20 +244,20 @@ module Paths = struct Path.Build.append_local t.extra_sources extra_source ;; - let make package_universe name = - let universe_root = - match (package_universe : Package_universe.t) with + let make pkg_digest universe = + let root = + match (universe : Package_universe.t) with + | Dependencies ctx -> + Path.Build.relative + (Path.Build.relative + (Path.Build.relative + Private_context.t.build_dir + (Context_name.to_string ctx)) + ".pkg") + (Pkg_digest.to_string pkg_digest) | Dev_tool dev_tool -> Pkg_dev_tool.universe_install_path dev_tool - | Project_dependencies _ -> - let build_dir = - Path.Build.relative - Private_context.t.build_dir - (Context_name.to_string (Package_universe.context_name package_universe)) - in - Path.Build.relative build_dir ".pkg" in - let root = Path.Build.relative universe_root (Package.Name.to_string name) in - of_root name ~root + of_root pkg_digest.name ~root ;; let make_install_cookie target_dir ~relative = relative target_dir "cookie" @@ -357,6 +450,7 @@ module Pkg = struct ; paths : Path.t Paths.t ; write_paths : Path.Build.t Paths.t ; files_dir : Path.Build.t option + ; pkg_digest : Pkg_digest.t ; mutable exported_env : string Env_update.t list } @@ -499,7 +593,7 @@ end module Pkg_installed = struct type t = { cookie : Install_cookie.t Action_builder.t } - let of_paths (paths : _ Paths.t) = + let of_paths (paths : Path.t Paths.t) = let cookie = let open Action_builder.O in let path = Paths.install_cookie paths in @@ -1102,16 +1196,160 @@ module Action_expander = struct end module DB = struct + module Pkg_table = struct + module Pkg = Lock_dir.Pkg + + type dep = + { dep_pkg : Pkg.t + ; dep_loc : Loc.t + ; dep_pkg_digest : Pkg_digest.t + } + + type entry = + { pkg : Pkg.t + ; deps : dep list + ; pkg_digest : Pkg_digest.t + } + + let entries_of_lock_dir (lock_dir : Dune_pkg.Lock_dir.t) ~platform = + let pkgs_by_name = + Dune_pkg.Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform + in + let cache = + (* Cache so that the digest of each package is only computed once *) + Package.Name.Table.create 10 + in + let rec compute_entry (pkg : Pkg.t) ~seen_set ~seen_list = + if Package.Name.Set.mem seen_set pkg.info.name + then + User_error.raise + [ Pp.textf "Dependency cycle between packages:" + ; Pp.chain seen_list ~f:(fun (pkg : Pkg.t) -> + Pp.textf + "%s.%s" + (Package.Name.to_string pkg.info.name) + (Package_version.to_string pkg.info.version)) + ]; + match Package.Name.Table.find cache pkg.info.name with + | Some entry -> entry + | None -> + let seen_set = Package.Name.Set.add seen_set pkg.info.name in + let seen_list = pkg :: seen_list in + let deps = + Dune_pkg.Lock_dir.Conditional_choice.choose_for_platform pkg.depends ~platform + |> Option.value ~default:[] + |> List.filter_map + ~f:(fun { Dune_pkg.Lock_dir.Dependency.name; loc = dep_loc } -> + if Package.Name.equal name Dune_pkg.Dune_dep.name + then None + else ( + let dep_pkg = Package.Name.Map.find_exn pkgs_by_name name in + let dep_entry = compute_entry dep_pkg ~seen_set ~seen_list in + Some { dep_pkg; dep_loc; dep_pkg_digest = dep_entry.pkg_digest })) + in + let pkg_digest = + Pkg_digest.create + pkg + (List.map deps ~f:(fun { dep_pkg_digest; _ } -> dep_pkg_digest)) + in + let entry = { pkg; deps; pkg_digest } in + Package.Name.Table.add_exn cache pkg.info.name entry; + entry + in + Package.Name.Map.values pkgs_by_name + |> List.map ~f:(compute_entry ~seen_set:Package.Name.Set.empty ~seen_list:[]) + ;; + + (* Associate each package's digest with the package and its dependencies. *) + type t = entry Pkg_digest.Map.t + + let equal a b = + Pkg_digest.Map.equal a b ~equal:(fun (entry : entry) { pkg; deps; pkg_digest } -> + Pkg.equal entry.pkg pkg + && List.equal + (fun (dep : dep) { dep_pkg; dep_loc; dep_pkg_digest } -> + Pkg.equal dep.dep_pkg dep_pkg + && Loc.equal dep.dep_loc dep_loc + && Pkg_digest.equal dep.dep_pkg_digest dep_pkg_digest) + entry.deps + deps + && Pkg_digest.equal entry.pkg_digest pkg_digest) + ;; + + let of_lock_dir lock_dir ~platform = + entries_of_lock_dir lock_dir ~platform + |> Pkg_digest.Map.of_list_map_exn ~f:(fun entry -> entry.pkg_digest, entry) + ;; + + (* Helper which is called when both tables have an entry with the same + digest. This happens when two lockdirs have a package in common and the + transitive dependency closure of the package is identical in both + lockdirs. Here we assert that the packages and their immediate + dependencies are identical as a sanity check. *) + let union_check + pkg_digest + ({ pkg = pkg_a; deps = deps_a; pkg_digest = _ } as entry) + { pkg = pkg_b; deps = deps_b; pkg_digest = _ } + = + if not (Pkg.equal (Pkg.remove_locs pkg_a) (Pkg.remove_locs pkg_b)) + then + Code_error.raise + "Two packages with the same pkg digest differ in their fields" + [ "pkg_digest", Pkg_digest.to_dyn pkg_digest + ; "pkg_a", Pkg.to_dyn pkg_a + ; "pkg_b", Pkg.to_dyn pkg_b + ]; + List.combine deps_a deps_b + |> List.iter ~f:(fun (dep_a, dep_b) -> + if not (Pkg.equal (Pkg.remove_locs dep_a.dep_pkg) (Pkg.remove_locs dep_b.dep_pkg)) + then + Code_error.raise + "Two packages with the same pkg digest differ in their dependencies" + [ "pkg_digest", Pkg_digest.to_dyn pkg_digest + ; "pkg_a", Pkg.to_dyn pkg_a + ; "pkg_b", Pkg.to_dyn pkg_b + ; "dep_of_a", Pkg.to_dyn dep_a.dep_pkg + ; "dep_of_b", Pkg.to_dyn dep_b.dep_pkg + ]); + Some entry + ;; + + let union = Pkg_digest.Map.union ~f:union_check + let union_all = Pkg_digest.Map.union_all ~f:union_check + + let of_dev_tool_deps_if_lock_dir_exists dev_tool ~platform = + let+ lock_dir_opt = Lock_dir.of_dev_tool_if_lockdir_exists dev_tool in + Option.map lock_dir_opt ~f:(of_lock_dir ~platform) + ;; + + let all_existing_dev_tools = + Memo.Lazy.create + ~name:"pkg-digest-table-all-existing-dev-tools" + ~human_readable_description:(fun () -> + Pp.text + "A map associating pkg digests with package metadata with entries for all \ + dev tools with lockdirs in the current project.") + (fun () -> + let* platform = Lock_dir.Sys_vars.solver_env () in + let+ xs = + Memo.List.map + Pkg_dev_tool.all + ~f:(of_dev_tool_deps_if_lock_dir_exists ~platform) + in + List.filter_opt xs |> union_all) + ;; + end + type t = - { all : Lock_dir.Pkg.t Package.Name.Map.t + { pkg_digest_table : Pkg_table.t ; system_provided : Package.Name.Set.t } let equal t t2 = phys_equal t t2 || - let { all; system_provided } = t2 in - Package.Name.Map.equal ~equal:Lock_dir.Pkg.equal t.all all + let { pkg_digest_table; system_provided } = t2 in + Pkg_table.equal t.pkg_digest_table pkg_digest_table && Package.Name.Set.equal t.system_provided system_provided ;; @@ -1121,49 +1359,82 @@ module DB = struct below slowed down the dune call in the test repo described in #12248 from 1s to 2s. *) - let get = - let memo = - Memo.create - "DB.get" - ~input:(module Package_universe) - (fun package_universe -> - let dune = Package.Name.Set.singleton (Package.Name.of_string "dune") in - let+ lock_dir = Package_universe.lock_dir package_universe - and+ solver_env = Lock_dir.Sys_vars.solver_env () in - let all = - Dune_pkg.Lock_dir.packages_on_platform lock_dir ~platform:solver_env - in - { all; system_provided = dune }) + let pkg_digest_of_name lock_dir platform pkg_name = + let entry = + Pkg_table.entries_of_lock_dir lock_dir ~platform + |> List.find_exn ~f:(fun { Pkg_table.pkg; _ } -> + Package.Name.equal pkg.info.name pkg_name) in - fun packages_universe -> Memo.exec memo packages_universe + entry.pkg_digest + ;; + + let of_ctx ctx ~allow_sharing = + let* lock_dir = Lock_dir.get_exn ctx + and* platform = Lock_dir.Sys_vars.solver_env () in + let pkg_digest_table = Pkg_table.of_lock_dir lock_dir ~platform in + let+ pkg_digest_table = + if allow_sharing && Context_name.is_default ctx + then + (* Dev tools are built in the default context, so allow their + dependencies to be shared with the project's if it too is being + built in the default context. *) + let+ dev_tools_pkg_digest_table = + Memo.Lazy.force Pkg_table.all_existing_dev_tools + in + Pkg_table.union pkg_digest_table dev_tools_pkg_digest_table + else Memo.return pkg_digest_table + in + let system_provided = Package.Name.Set.singleton Dune_pkg.Dune_dep.name in + { pkg_digest_table; system_provided } + ;; + + (* Returns the db for the given context and the digest of the given package + within that context. *) + let of_project_pkg ctx pkg_name = + let* lock_dir = Lock_dir.get_exn ctx + and* platform = Lock_dir.Sys_vars.solver_env () in + let+ t = of_ctx ctx ~allow_sharing:true in + t, pkg_digest_of_name lock_dir platform pkg_name + ;; + + (* Returns the db for all dev tools combined with the default context, and + the digest for the dev tool's package. *) + let of_dev_tool dev_tool = + let* lock_dir = Lock_dir.of_dev_tool dev_tool + and* platform = Lock_dir.Sys_vars.solver_env () in + let+ pkg_digest_table_all_dev_tools = Memo.Lazy.force Pkg_table.all_existing_dev_tools + and+ { pkg_digest_table = pkg_digest_table_default_ctx; system_provided } = + of_ctx Context_name.default ~allow_sharing:true + in + let pkg_digest_table = + Pkg_table.union pkg_digest_table_default_ctx pkg_digest_table_all_dev_tools + in + ( { pkg_digest_table; system_provided } + , pkg_digest_of_name lock_dir platform (Pkg_dev_tool.package_name dev_tool) ) ;; end module rec Resolve : sig - val resolve - : DB.t - -> Loc.t * Package.Name.t - -> Package_universe.t - -> [ `Inside_lock_dir of Pkg.t | `System_provided ] Memo.t + val resolve : DB.t -> Loc.t -> Pkg_digest.t -> Package_universe.t -> Pkg.t Memo.t end = struct open Resolve module Input = struct type t = { db : DB.t - ; package : Package.Name.t + ; pkg_digest : Pkg_digest.t ; universe : Package_universe.t } - let equal { db; package; universe } t = - Package.Name.equal package t.package + let equal { db; pkg_digest; universe } t = + Pkg_digest.equal pkg_digest t.pkg_digest && Package_universe.equal universe t.universe && DB.equal db t.db ;; - let hash { db; package; universe } = + let hash { db; pkg_digest; universe } = let _ = db in - Tuple.T2.hash Package.Name.hash Package_universe.hash (package, universe) + Tuple.T2.hash Pkg_digest.hash Package_universe.hash (pkg_digest, universe) ;; let to_dyn = Dyn.opaque @@ -1184,31 +1455,41 @@ end = struct | Action a -> Build_command.Action (relocate a) ;; - let resolve_impl { Input.db; package = name; universe = package_universe } = - match Package.Name.Map.find db.all name with + let resolve_impl { Input.db; pkg_digest; universe = package_universe } = + match Pkg_digest.Map.find db.pkg_digest_table pkg_digest with | None -> Memo.return None | Some - ({ Lock_dir.Pkg.build_command - ; install_command - ; depends - ; info - ; exported_env - ; depexts - ; enabled_on_platforms = _ - } as pkg) -> - assert (Package.Name.equal name info.name); + { pkg = + { Lock_dir.Pkg.build_command + ; install_command + ; depends = _ + ; info + ; exported_env + ; depexts + ; enabled_on_platforms = _ + } as pkg + ; deps + ; pkg_digest = _ + } -> + assert (Package.Name.equal pkg_digest.name info.name); let* platform = Lock_dir.Sys_vars.solver_env () in let choose_for_current_platform field = Dune_pkg.Lock_dir.Conditional_choice.choose_for_platform field ~platform in - let depends = choose_for_current_platform depends |> Option.value ~default:[] in let* depends = - Memo.parallel_map depends ~f:(fun dependency -> - resolve db (dependency.loc, dependency.name) package_universe - >>| function - | `Inside_lock_dir pkg -> Some pkg - | `System_provided -> None) - >>| List.filter_opt + Memo.parallel_map + deps + ~f:(fun { DB.Pkg_table.dep_pkg = _; dep_loc; dep_pkg_digest } -> + let package_universe = + match package_universe with + | Dev_tool _ -> + (* The dependencies of dev tools are installed into the default + context so they may be shared with the project's + dependencies. *) + Package_universe.Dependencies Context_name.default + | _ -> package_universe + in + resolve db dep_loc dep_pkg_digest package_universe) and+ files_dir = let* lock_dir = Package_universe.lock_dir_path package_universe >>| Option.value_exn @@ -1263,7 +1544,9 @@ end = struct b) in let id = Pkg.Id.gen () in - let write_paths = Paths.make package_universe name ~relative:Path.Build.relative in + let write_paths = + Paths.make pkg_digest package_universe ~relative:Path.Build.relative + in let install_command = choose_for_current_platform install_command in let install_command = Option.map install_command ~f:relocate in let build_command = choose_for_current_platform build_command in @@ -1304,6 +1587,7 @@ end = struct ; write_paths ; info ; files_dir + ; pkg_digest ; exported_env = [] } in @@ -1323,20 +1607,21 @@ end = struct "pkg-resolve" ~input:(module Input) ~human_readable_description:(fun t -> - Pp.textf "- package %s" (Package.Name.to_string t.package)) + Pp.textf "- package %s" (Package.Name.to_string t.pkg_digest.name)) resolve_impl in - fun (db : DB.t) (loc, name) package_universe -> - if Package.Name.Set.mem db.system_provided name - then Memo.return `System_provided - else - Memo.exec memo { db; package = name; universe = package_universe } - >>| function - | Some s -> `Inside_lock_dir s - | None -> - User_error.raise - ~loc - [ Pp.textf "Unknown package %S" (Package.Name.to_string name) ] + fun (db : DB.t) loc pkg_digest package_universe -> + Memo.exec memo { db; pkg_digest; universe = package_universe } + >>| function + | Some s -> s + | None -> + User_error.raise + ~loc + [ Pp.textf + "Unknown package %S (looked in %s)" + (Package.Name.to_string pkg_digest.name) + (Package_universe.to_dyn package_universe |> Dyn.to_string) + ] ;; end @@ -1985,17 +2270,15 @@ let setup_pkg_install_alias = (* Fetching the package target implies that we will also fetch the extra sources. *) let open Action_builder.O in - let project_deps : Package_universe.t = Project_dependencies ctx_name in - let* packages = + let* pkg_digests = Action_builder.of_memo (let open Memo.O in - let+ lock_dir = Package_universe.lock_dir project_deps - and+ platform = Lock_dir.Sys_vars.solver_env () in - Dune_pkg.Lock_dir.Packages.pkgs_on_platform_by_name lock_dir.packages ~platform) + let+ db = DB.of_ctx ctx_name ~allow_sharing:true in + Pkg_digest.Map.values db.pkg_digest_table + |> List.map ~f:(fun { DB.Pkg_table.pkg_digest; _ } -> pkg_digest)) in - Dune_lang.Package_name.Map.keys packages - |> List.map ~f:(fun pkg -> - Paths.make ~relative:Path.Build.relative project_deps pkg + List.map pkg_digests ~f:(fun pkg_digest -> + Paths.make ~relative:Path.Build.relative pkg_digest (Dependencies ctx_name) |> Paths.target_dir |> Path.build) |> Action_builder.paths @@ -2023,22 +2306,9 @@ let setup_pkg_install_alias = |> Gen_rules.rules_here ;; -let setup_package_rules ~package_universe ~dir ~pkg_name : Gen_rules.result Memo.t = - let name = User_error.ok_exn (Package.Name.of_string_user_error (Loc.none, pkg_name)) in - let* db = DB.get package_universe in - let* pkg = - Resolve.resolve db (Loc.none, name) package_universe - >>| function - | `Inside_lock_dir pkg -> pkg - | `System_provided -> - User_error.raise - (* TODO loc *) - [ Pp.textf - "There are no rules for %S because it's set as provided by the system" - (Package.Name.to_string name) - ] - in - let paths = Paths.make package_universe name ~relative:Path.Build.relative in +let setup_package_rules db ~package_universe ~dir ~pkg_digest : Gen_rules.result Memo.t = + let* pkg = Resolve.resolve db Loc.none pkg_digest package_universe in + let paths = Paths.make pkg.pkg_digest package_universe ~relative:Path.Build.relative in let+ directory_targets = let map = let target_dir = paths.target_dir in @@ -2068,15 +2338,16 @@ let setup_rules ~components ~dir ctx = the value of [Pkg_dev_tool.install_path_base_dir_name]. *) assert (String.equal Pkg_dev_tool.install_path_base_dir_name ".dev-tool"); match Context_name.is_default ctx, components with - | true, [ ".dev-tool"; pkg_name; pkg_dep_name ] -> + | true, [ ".dev-tool"; dev_tool_package_name ] -> (* only generate rules if dev-tools should be enabled *) (match Config.get Compile_time.lock_dev_tools with | `Enabled -> - setup_package_rules - ~package_universe: - (Dev_tool (Package.Name.of_string pkg_name |> Dune_pkg.Dev_tool.of_package_name)) - ~dir - ~pkg_name:pkg_dep_name + let pkg_name = Package.Name.of_string dev_tool_package_name in + let dev_tool = Pkg_dev_tool.of_package_name pkg_name in + let* db, pkg_digest = + DB.of_dev_tool (Dune_pkg.Dev_tool.of_package_name pkg_name) + in + setup_package_rules db ~package_universe:(Dev_tool dev_tool) ~dir ~pkg_digest | `Disabled -> Memo.return @@ Gen_rules.make (Memo.return Rules.empty)) | true, [ ".dev-tool" ] -> Gen_rules.make @@ -2090,13 +2361,15 @@ let setup_rules ~components ~dir ctx = (Gen_rules.Build_only_sub_dirs.singleton ~dir Subdir_set.all) (Memo.return Rules.empty) |> Memo.return - | _, [ ".pkg"; pkg_name ] -> + | _, [ ".pkg"; pkg_digest_string ] -> (* Only generate pkg rules if there is a lock dir for that context *) let* lock_dir_active = Lock_dir.lock_dir_active ctx in (match lock_dir_active with | false -> Memo.return @@ Gen_rules.make (Memo.return Rules.empty) | true -> - setup_package_rules ~package_universe:(Project_dependencies ctx) ~dir ~pkg_name) + let pkg_digest = Pkg_digest.of_string pkg_digest_string in + let* db = DB.of_ctx ctx ~allow_sharing:true in + setup_package_rules db ~package_universe:(Dependencies ctx) ~dir ~pkg_digest) | _, ".pkg" :: _ :: _ -> Memo.return @@ Gen_rules.redirect_to_parent Gen_rules.Rules.empty | true, ".dev-tool" :: _ :: _ :: _ -> @@ -2110,11 +2383,9 @@ let setup_rules ~components ~dir ctx = | _ -> Memo.return @@ Gen_rules.rules_here Gen_rules.Rules.empty ;; -let db_project context = DB.get (Project_dependencies context) - -let resolve_pkg_project context pkg = - let* db = db_project context in - Resolve.resolve db pkg (Project_dependencies context) +let resolve_pkg_dep context (loc, package_name) = + let* db, pkg_digest = DB.of_project_pkg context package_name in + Resolve.resolve db loc pkg_digest (Dependencies context) ;; let ocaml_toolchain context = @@ -2123,13 +2394,11 @@ let ocaml_toolchain context = "Loading OCaml toolchain from Lock directory for context %S" (Context_name.to_string context)) @@ fun () -> - (let* lock_dir = Lock_dir.get_exn context in - match lock_dir.ocaml with - | None -> Memo.return `System_provided - | Some ocaml -> resolve_pkg_project context ocaml) - >>| function - | `System_provided -> None - | `Inside_lock_dir pkg -> + let* lock_dir = Lock_dir.get_exn context in + match lock_dir.ocaml with + | None -> Memo.return None + | Some ocaml -> + let+ pkg = resolve_pkg_dep context ocaml in let toolchain = let open Action_builder.O in let transitive_deps = pkg :: Pkg.deps_closure pkg in @@ -2155,19 +2424,18 @@ let ocaml_toolchain context = ;; let all_deps universe = - let* db = DB.get universe in - Dune_lang.Package_name.Map.values db.all - |> Memo.parallel_map ~f:(fun (package : Lock_dir.Pkg.t) -> - let package = package.info.name in - Resolve.resolve db (Loc.none, package) universe - >>| function - | `Inside_lock_dir pkg -> Some pkg - | `System_provided -> None) - >>| List.filter_opt + let* db = + (* Disallow sharing so that the only packages in the DB are the ones from + the universe's respective lock directory. *) + DB.of_ctx (Package_universe.context_name universe) ~allow_sharing:false + in + Pkg_digest.Map.values db.pkg_digest_table + |> Memo.parallel_map ~f:(fun { DB.Pkg_table.pkg_digest; _ } -> + Resolve.resolve db Loc.none pkg_digest universe) >>| Pkg.top_closure ;; -let all_project_deps context = all_deps (Project_dependencies context) +let all_project_deps context = all_deps (Dependencies context) let which context = let artifacts_and_deps = @@ -2197,7 +2465,7 @@ let ocamlpath universe = | String s -> Path.of_filename_relative_to_initial_cwd s) ;; -let project_ocamlpath context = ocamlpath (Project_dependencies context) +let project_ocamlpath context = ocamlpath (Dependencies context) let dev_tool_ocamlpath dev_tool = ocamlpath (Dev_tool dev_tool) let lock_dir_active = Lock_dir.lock_dir_active let lock_dir_path = Lock_dir.get_path @@ -2209,12 +2477,9 @@ let dev_tool_env tool = "lock directory environment for dev tools %S" (Package.Name.to_string package_name)) @@ fun () -> - let universe : Package_universe.t = Dev_tool tool in - let* db = DB.get universe in - Resolve.resolve db (Loc.none, package_name) universe - >>| function - | `System_provided -> assert false - | `Inside_lock_dir pkg -> Pkg.exported_env pkg + let* db, pkg_digest = DB.of_dev_tool tool in + let+ pkg = Resolve.resolve db Loc.none pkg_digest (Dev_tool tool) in + Pkg.exported_env pkg ;; let exported_env context = @@ -2232,14 +2497,11 @@ let find_package ctx pkg = >>= function | false -> Memo.return None | true -> - resolve_pkg_project ctx (Loc.none, pkg) - >>| (function - | `System_provided -> Action_builder.return () - | `Inside_lock_dir pkg -> - let open Action_builder.O in + let+ pkg = resolve_pkg_dep ctx (Loc.none, pkg) in + Some + (let open Action_builder.O in let+ _cookie = (Pkg_installed.of_paths pkg.paths).cookie in ()) - >>| Option.some ;; let all_filtered_depexts context = diff --git a/src/dune_rules/pkg_toolchain.ml b/src/dune_rules/pkg_toolchain.ml index 6ea8c7fbad1..b83ac13c771 100644 --- a/src/dune_rules/pkg_toolchain.ml +++ b/src/dune_rules/pkg_toolchain.ml @@ -28,7 +28,9 @@ let pkg_dir (pkg : Dune_pkg.Lock_dir.Pkg.t) = let dir_name = (* TODO should include resolved deps *) let pkg_digest = - Dune_digest.Feed.digest Lock_dir.Pkg.digest_feed (Lock_dir.Pkg.remove_locs pkg) + Dune_digest.Feed.compute_digest + Lock_dir.Pkg.digest_feed + (Lock_dir.Pkg.remove_locs pkg) in (* A hash of the fields of a package that affect its installed artifacts *) sprintf diff --git a/test/blackbox-tests/test-cases/describe/describe_location.t b/test/blackbox-tests/test-cases/describe/describe_location.t index 0627bdec0d8..a879be73d67 100644 --- a/test/blackbox-tests/test-cases/describe/describe_location.t +++ b/test/blackbox-tests/test-cases/describe/describe_location.t @@ -48,7 +48,7 @@ Test that executables from dependencies are located correctly: > EOF $ dune describe location bar - _build/_private/default/.pkg/bar/target/bin/bar + _build/_private/default/.pkg/bar.0.1-71f2fd5a20f2956e48a2965b20666f1e/target/bin/bar Test that executables from PATH are located correctly: $ mkdir bin diff --git a/test/blackbox-tests/test-cases/pkg/absolute-paths-in-sections.t b/test/blackbox-tests/test-cases/pkg/absolute-paths-in-sections.t index 3d9723e73d4..aa026d5b557 100644 --- a/test/blackbox-tests/test-cases/pkg/absolute-paths-in-sections.t +++ b/test/blackbox-tests/test-cases/pkg/absolute-paths-in-sections.t @@ -21,5 +21,5 @@ Test that section pforms are substituted with absolute paths. Note that currently dune incorrectly substitutes relative paths for pforms that appear in string interpolations. $ build_pkg test 2>&1 | strip_sandbox - --prefix $SANDBOX/_private/default/.pkg/test/target - $SANDBOX/_private/default/.pkg/test/target + --prefix $SANDBOX/_private/default/.pkg/test.0.0.1-35943fe1ea902a1ac62aea8f115d162d/target + $SANDBOX/_private/default/.pkg/test.0.0.1-35943fe1ea902a1ac62aea8f115d162d/target diff --git a/test/blackbox-tests/test-cases/pkg/broken-symlink-in-dependency.t b/test/blackbox-tests/test-cases/pkg/broken-symlink-in-dependency.t index e3f51305ea3..400fac1d7c7 100644 --- a/test/blackbox-tests/test-cases/pkg/broken-symlink-in-dependency.t +++ b/test/blackbox-tests/test-cases/pkg/broken-symlink-in-dependency.t @@ -66,9 +66,9 @@ Build the packages. $ build_pkg baz All files were copied except for the broken symlinks: - $ ls _build/_private/default/.pkg/foo/source + $ ls _build/_private/default/.pkg/foo.*/source a.txt - $ ls _build/_private/default/.pkg/bar/source + $ ls _build/_private/default/.pkg/bar.*/source a.txt - $ ls _build/_private/default/.pkg/baz/source + $ ls _build/_private/default/.pkg/baz.*/source a.txt diff --git a/test/blackbox-tests/test-cases/pkg/default-exported-env.t b/test/blackbox-tests/test-cases/pkg/default-exported-env.t index 79d95f339d4..a0e24c61453 100644 --- a/test/blackbox-tests/test-cases/pkg/default-exported-env.t +++ b/test/blackbox-tests/test-cases/pkg/default-exported-env.t @@ -23,8 +23,8 @@ Some environment variables are automatically exported by packages: $ ln -s $(which sh) .bin/sh $ dune=$(which dune) $ MANPATH="" OCAMLPATH="" CAML_LD_LIBRARY_PATH="" OCAMLTOP_INCLUDE_PATH="" PATH="$PWD/.bin" build_pkg usetest - MANPATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test/target/man - OCAMLPATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test/target/lib - CAML_LD_LIBRARY_PATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test/target/lib/stublibs - OCAMLTOP_INCLUDE_PATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test/target/lib/toplevel - PATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test/target/bin:$TESTCASE_ROOT/.bin + MANPATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test.0.0.1-58e701a6bb554b1906e02d898bc78509/target/man + OCAMLPATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test.0.0.1-58e701a6bb554b1906e02d898bc78509/target/lib + CAML_LD_LIBRARY_PATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test.0.0.1-58e701a6bb554b1906e02d898bc78509/target/lib/stublibs + OCAMLTOP_INCLUDE_PATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test.0.0.1-58e701a6bb554b1906e02d898bc78509/target/lib/toplevel + PATH=$TESTCASE_ROOT/_build/_private/default/.pkg/test.0.0.1-58e701a6bb554b1906e02d898bc78509/target/bin:$TESTCASE_ROOT/.bin diff --git a/test/blackbox-tests/test-cases/pkg/different-dune-in-path.t b/test/blackbox-tests/test-cases/pkg/different-dune-in-path.t index 3eb7cc914ee..b49e5713948 100644 --- a/test/blackbox-tests/test-cases/pkg/different-dune-in-path.t +++ b/test/blackbox-tests/test-cases/pkg/different-dune-in-path.t @@ -76,7 +76,7 @@ Make a fake dune exe: $ dune clean Try building in an environment where `dune` refers to the fake dune. $ DUNE=$(which dune) # otherwise we would start by running the wrong dune - $ PATH=$PWD/bin:$PATH $DUNE build $pkg_root/foo/target/ + $ PATH=$PWD/bin:$PATH $DUNE build $pkg_root/$($dune pkg print-slug foo)/target/ Fake dune! (args: build -p foo @install) - $ PATH=$PWD/bin:$PATH $DUNE build $pkg_root/bar/target/ + $ PATH=$PWD/bin:$PATH $DUNE build $pkg_root/$($dune pkg print-slug bar)/target/ Fake dune! (args: build -p bar @install) diff --git a/test/blackbox-tests/test-cases/pkg/extra-source-overlap-with-source.t b/test/blackbox-tests/test-cases/pkg/extra-source-overlap-with-source.t index 61f55535564..876017e66dd 100644 --- a/test/blackbox-tests/test-cases/pkg/extra-source-overlap-with-source.t +++ b/test/blackbox-tests/test-cases/pkg/extra-source-overlap-with-source.t @@ -30,5 +30,5 @@ file in the package's source. Make sure that the package's source directory ends up with the version of foo.txt from extra_sources: - $ cat _build/_private/default/.pkg/foo/source/foo.txt + $ cat _build/_private/default/.pkg/$($dune pkg print-slug foo)/source/foo.txt from extra source diff --git a/test/blackbox-tests/test-cases/pkg/fetch-local-source.t b/test/blackbox-tests/test-cases/pkg/fetch-local-source.t index 235644662b5..75dc61a9702 100644 --- a/test/blackbox-tests/test-cases/pkg/fetch-local-source.t +++ b/test/blackbox-tests/test-cases/pkg/fetch-local-source.t @@ -20,7 +20,7 @@ Build a package that uses the archive as its source: Solution for dune.lock: - foo.0.0.1 $ build_pkg foo - $ cat _build/_private/default/.pkg/foo/source/* + $ cat _build/_private/default/.pkg/$($dune pkg print-slug foo)/source/* hello world @@ -37,6 +37,6 @@ Build a package that uses the src directory as its source: Solution for dune.lock: - foo.0.0.1 $ build_pkg foo - $ cat _build/_private/default/.pkg/foo/source/* + $ cat _build/_private/default/.pkg/$($dune pkg print-slug foo)/source/* hello world diff --git a/test/blackbox-tests/test-cases/pkg/findlib-meta-optional-directory.t b/test/blackbox-tests/test-cases/pkg/findlib-meta-optional-directory.t index 0ba961690e6..d0b09d72ec9 100644 --- a/test/blackbox-tests/test-cases/pkg/findlib-meta-optional-directory.t +++ b/test/blackbox-tests/test-cases/pkg/findlib-meta-optional-directory.t @@ -63,8 +63,8 @@ Clearer error here as we really depend on non-existing 'no' 2 | (libraries mypkg.no) ^^^^^^^^ Error: Library "mypkg.no" in - _build/_private/default/.pkg/mypkg/target/lib/mypkg/no is hidden (unsatisfied - 'exists_if'). + _build/_private/default/.pkg/mypkg.0.0.1-1a3a06e8a2c64e486338d78cc0ffad07/target/lib/mypkg/no + is hidden (unsatisfied 'exists_if'). -> required by _build/default/.foo.eobjs/native/dune__exe__Foo.cmx -> required by _build/default/foo.exe [1] diff --git a/test/blackbox-tests/test-cases/pkg/helpers.sh b/test/blackbox-tests/test-cases/pkg/helpers.sh index 16ea99b831b..b083458350b 100644 --- a/test/blackbox-tests/test-cases/pkg/helpers.sh +++ b/test/blackbox-tests/test-cases/pkg/helpers.sh @@ -16,12 +16,30 @@ pkg_root="_build/_private/default/.pkg" default_lock_dir="dune.lock" source_lock_dir="${default_lock_dir}" +# Prints the directory containing the package target and source dirs within the +# _build directory. +get_build_pkg_dir() { + package_name=$1 + slug=$($dune pkg print-slug $package_name) + if [ "$?" == "0" ]; then + echo "$pkg_root/$slug" + else + return 1 + fi +} + build_pkg() { - $dune build $pkg_root/$1/target/ + prefix=$(get_build_pkg_dir $1) + if [ "$?" == "0" ]; then + $dune build "$prefix/target" + else + return 1 + fi } show_pkg() { - find $pkg_root/$1 | sort | sed "s#$pkg_root/$1##" + prefix="$(get_build_pkg_dir $1)" + find "$prefix" | sort | sed "s#$prefix##" } strip_sandbox() { @@ -29,11 +47,12 @@ strip_sandbox() { } show_pkg_targets() { - find $pkg_root/$1/target | sort | sed "s#$pkg_root/$1/target##" + prefix="$(get_build_pkg_dir $1)/target" + find "$prefix" | sort | sed "s#$prefix##" } show_pkg_cookie() { - $dune internal dump $pkg_root/$1/target/cookie + $dune internal dump "$(get_build_pkg_dir $1)/target/cookie" } mock_packages="mock-opam-repository/packages" diff --git a/test/blackbox-tests/test-cases/pkg/ignored-dune-lock.t b/test/blackbox-tests/test-cases/pkg/ignored-dune-lock.t index c51b5f80d25..fcd78d87b7d 100644 --- a/test/blackbox-tests/test-cases/pkg/ignored-dune-lock.t +++ b/test/blackbox-tests/test-cases/pkg/ignored-dune-lock.t @@ -45,5 +45,6 @@ dune.lock): Building fails as the patch cannot be found anymore $ build_pkg test - Error: Don't know how to build _build/_private/default/.pkg/test/target/ + Error: Don't know how to build + _build/_private/default/.pkg/test.0.0.1-c44168a3718171a85da0e0a58045daad/target [1] diff --git a/test/blackbox-tests/test-cases/pkg/install-action.t b/test/blackbox-tests/test-cases/pkg/install-action.t index 5d79578db37..302c29c5c81 100644 --- a/test/blackbox-tests/test-cases/pkg/install-action.t +++ b/test/blackbox-tests/test-cases/pkg/install-action.t @@ -33,7 +33,10 @@ Testing install actions $ show_pkg_cookie test { files = - [ (LIB_ROOT, [ In_build_dir "_private/default/.pkg/test/target/lib/xxx" ]) + [ (LIB_ROOT, + [ In_build_dir + "_private/default/.pkg/test.0.0.1-f6ed2ec1b5272dd0b899919ab4533208/target/lib/xxx" + ]) ] ; variables = [] } diff --git a/test/blackbox-tests/test-cases/pkg/install-missing-entry.t b/test/blackbox-tests/test-cases/pkg/install-missing-entry.t index 39ab6272f51..f5fc3f47243 100644 --- a/test/blackbox-tests/test-cases/pkg/install-missing-entry.t +++ b/test/blackbox-tests/test-cases/pkg/install-missing-entry.t @@ -16,11 +16,12 @@ This should give us a proper error that myfile wasn't generated $ lockfile "myfile" $ build_pkg test 2>&1 | sed 's#_build.*_private#$ROOT/_private#' Error: entry - $ROOT/_private/default/.pkg/test/source/myfile + $ROOT/_private/default/.pkg/test.0.0.1-962f24dc2cb394442fe86368a850a9d0/source/myfile in - $ROOT/_private/default/.pkg/test/source/test.install + $ROOT/_private/default/.pkg/test.0.0.1-962f24dc2cb394442fe86368a850a9d0/source/test.install does not exist - -> required by $ROOT/_private/default/.pkg/test/target + -> required by + $ROOT/_private/default/.pkg/test.0.0.1-962f24dc2cb394442fe86368a850a9d0/target This on the other hand shouldn't error because myfile is optional diff --git a/test/blackbox-tests/test-cases/pkg/installed-binary.t b/test/blackbox-tests/test-cases/pkg/installed-binary.t index bf61807d429..1f4ae7b8811 100644 --- a/test/blackbox-tests/test-cases/pkg/installed-binary.t +++ b/test/blackbox-tests/test-cases/pkg/installed-binary.t @@ -44,12 +44,21 @@ Test that installed binaries are visible in dependent packages $ show_pkg_cookie test { files = [ (LIB, - [ In_build_dir "_private/default/.pkg/test/target/lib/test/libxxx" ]) + [ In_build_dir + "_private/default/.pkg/test.0.0.1-8240dbfd7c93ea3e976f855df6946a09/target/lib/test/libxxx" + ]) ; (LIB_ROOT, - [ In_build_dir "_private/default/.pkg/test/target/lib/lib_rootxxx" ]) - ; (BIN, [ In_build_dir "_private/default/.pkg/test/target/bin/foo" ]) + [ In_build_dir + "_private/default/.pkg/test.0.0.1-8240dbfd7c93ea3e976f855df6946a09/target/lib/lib_rootxxx" + ]) + ; (BIN, + [ In_build_dir + "_private/default/.pkg/test.0.0.1-8240dbfd7c93ea3e976f855df6946a09/target/bin/foo" + ]) ; (SHARE_ROOT, - [ In_build_dir "_private/default/.pkg/test/target/share/lib_rootxxx" ]) + [ In_build_dir + "_private/default/.pkg/test.0.0.1-8240dbfd7c93ea3e976f855df6946a09/target/share/lib_rootxxx" + ]) ] ; variables = [] } diff --git a/test/blackbox-tests/test-cases/pkg/lock-directory-selection.t b/test/blackbox-tests/test-cases/pkg/lock-directory-selection.t index 6e4d6be0027..5216e0ee63f 100644 --- a/test/blackbox-tests/test-cases/pkg/lock-directory-selection.t +++ b/test/blackbox-tests/test-cases/pkg/lock-directory-selection.t @@ -76,36 +76,36 @@ Generate all lockdirs: Demonstrate that the correct lockdir is being chosen by building packages that are only dependent on on certain systems. -Build macos package on macos: +Build macos package on macos arm64: $ dune clean - $ DUNE_CONFIG__OS=macos DUNE_CONFIG__ARCH=arm64 dune build _build/_private/default/.pkg/macos-only/target/ + $ DUNE_CONFIG__OS=macos DUNE_CONFIG__ARCH=arm64 build_pkg macos-only macos-only -Build macos package on macos: +Build macos package on macos amd64: $ dune clean - $ DUNE_CONFIG__OS=macos DUNE_CONFIG__ARCH=amd64 dune build _build/_private/default/.pkg/macos-only/target/ + $ DUNE_CONFIG__OS=macos DUNE_CONFIG__ARCH=amd64 build_pkg macos-only macos-only Build linux package on macos (will fail): $ dune clean - $ DUNE_CONFIG__OS=macos DUNE_CONFIG__ARCH=amd64 dune build _build/_private/default/.pkg/linux-only/target/ - Error: Unknown package "linux-only" + $ DUNE_CONFIG__OS=macos DUNE_CONFIG__ARCH=amd64 build_pkg linux-only + Error: No such package: linux-only [1] Build macos package on linux (will fail): $ dune clean - $ DUNE_CONFIG__OS=linux DUNE_CONFIG__ARCH=amd64 dune build _build/_private/default/.pkg/macos-only/target/ - Error: Unknown package "macos-only" + $ DUNE_CONFIG__OS=linux DUNE_CONFIG__ARCH=amd64 build_pkg macos-only + Error: No such package: macos-only [1] Build linux package on linux: $ dune clean - $ DUNE_CONFIG__OS=linux DUNE_CONFIG__ARCH=amd64 dune build _build/_private/default/.pkg/linux-only/target/ + $ DUNE_CONFIG__OS=linux DUNE_CONFIG__ARCH=amd64 build_pkg linux-only linux-only Try setting the os to one which doesn't have a corresponding lockdir: $ dune clean - $ DUNE_CONFIG__OS=windows dune build _build/_private/default/.pkg/linux-only/target/ + $ DUNE_CONFIG__OS=windows build_pkg linux-only File "dune-workspace", lines 28-32, characters 3-172: 28 | ((and 29 | (= %{architecture} arm64) @@ -138,5 +138,5 @@ Test that cond statements can have a default value: Solution for dune.lock: - linux-only.0.0.1 $ dune clean - $ dune build _build/_private/default/.pkg/linux-only/target/ + $ build_pkg linux-only linux-only diff --git a/test/blackbox-tests/test-cases/pkg/package-cycle.t b/test/blackbox-tests/test-cases/pkg/package-cycle.t index 9e487de9ddd..ddbc2ad3ca8 100644 --- a/test/blackbox-tests/test-cases/pkg/package-cycle.t +++ b/test/blackbox-tests/test-cases/pkg/package-cycle.t @@ -17,9 +17,9 @@ Package resolution creating a cycle > EOF $ build_pkg a - Error: Dependency cycle between: - - package a - -> - package c - -> - package b - -> - package a + Error: Dependency cycle between packages: + a.0.0.1 + -> b.0.0.1 + -> c.0.0.1 + -> a.0.0.1 [1] diff --git a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml index 1225be681a5..1dbe71b2452 100644 --- a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml +++ b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml @@ -196,6 +196,7 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = } ; exported_env = [] ; enabled_on_platforms = [] + ; slug = Some } } ; "foo" : @@ -215,6 +216,7 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = } ; exported_env = [] ; enabled_on_platforms = [] + ; slug = Some } } } @@ -368,6 +370,7 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = } ; exported_env = [ { op = "="; var = "foo"; value = "bar" } ] ; enabled_on_platforms = [] + ; slug = Some } } ; "b" : @@ -399,6 +402,7 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = } ; exported_env = [] ; enabled_on_platforms = [] + ; slug = Some } } ; "c" : @@ -429,6 +433,7 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = } ; exported_env = [] ; enabled_on_platforms = [] + ; slug = Some } } } @@ -506,6 +511,7 @@ let%expect_test "encode/decode round trip test with locked repo revision" = } ; exported_env = [] ; enabled_on_platforms = [] + ; slug = Some } } ; "b" : @@ -525,6 +531,7 @@ let%expect_test "encode/decode round trip test with locked repo revision" = } ; exported_env = [] ; enabled_on_platforms = [] + ; slug = Some } } ; "c" : @@ -544,6 +551,7 @@ let%expect_test "encode/decode round trip test with locked repo revision" = } ; exported_env = [] ; enabled_on_platforms = [] + ; slug = Some } } }