From d9a2765ffd94530c2e6984d41e70dfdc93b71d29 Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Tue, 11 Feb 2025 15:41:38 +1100 Subject: [PATCH] Experimental portable lockdirs Adds a feature flag for enabling portable lockdirs. This is a proof of concept implementation of portable lockdirs where the entire solver runs for each of a set of platforms (combinations of architecture, OS, and in some cases the OS distribution) which most people are expected to use. This can easily be extended in the future to add more platforms or to allow projects to specify more platforms. To make lockdirs portable, the build/install commands and dependencies of each package are transformed into match statements, where the appropriate value for each platform is enumerated. At solve-time, the solver runs once for each platform, populating these fields. At build-time, the command/dependencies appropriate for the current platform are used. When the feature flag is not enabled dune's behaviour is unchanged. Signed-off-by: Stephen Sherratt --- bin/lock_dev_tool.ml | 1 + bin/pkg/lock.ml | 99 ++++- bin/pkg/lock.mli | 1 + boot/configure.ml | 10 +- boot/libs.ml | 2 +- src/dune_lang/package_variable_name.ml | 4 + src/dune_lang/package_variable_name.mli | 4 + src/dune_pkg/file_entry.ml | 21 + src/dune_pkg/file_entry.mli | 3 + src/dune_pkg/lock_dir.ml | 360 ++++++++++++++++-- src/dune_pkg/lock_dir.mli | 40 +- src/dune_pkg/opam_solver.ml | 105 ++++- src/dune_pkg/opam_solver.mli | 2 + src/dune_pkg/package_universe.ml | 5 +- src/dune_pkg/solver_env.ml | 56 ++- src/dune_pkg/solver_env.mli | 15 + src/dune_pkg/variable_value.ml | 1 + src/dune_pkg/variable_value.mli | 1 + src/dune_rules/compile_time.ml | 4 + src/dune_rules/compile_time.mli | 2 + src/dune_rules/lock_dir.ml | 21 + src/dune_rules/lock_dir.mli | 1 + src/dune_rules/pkg_rules.ml | 30 +- src/dune_rules/setup.defaults.ml | 1 + src/dune_rules/setup.mli | 1 + .../test-cases/pkg/portable-lockdirs.t | 163 ++++++++ .../dune_pkg/dune_pkg_unit_tests.ml | 97 +++-- .../dune_rpc_e2e/dune_rpc_diagnostics.ml | 120 +++--- 28 files changed, 992 insertions(+), 178 deletions(-) create mode 100644 test/blackbox-tests/test-cases/pkg/portable-lockdirs.t diff --git a/bin/lock_dev_tool.ml b/bin/lock_dev_tool.ml index 9da37c7a409..2a9f56bbad2 100644 --- a/bin/lock_dev_tool.ml +++ b/bin/lock_dev_tool.ml @@ -82,6 +82,7 @@ let solve ~dev_tool ~local_packages = ~version_preference:None ~lock_dirs:[ lock_dir ] ~print_perf_stats:false + ~portable_lock_dir:false ;; let compiler_package_name = Package_name.of_string "ocaml" diff --git a/bin/pkg/lock.ml b/bin/pkg/lock.ml index a56e12f8370..0a49fe98a32 100644 --- a/bin/pkg/lock.ml +++ b/bin/pkg/lock.ml @@ -1,3 +1,4 @@ +open Dune_config open Import open Pkg_common module Package_version = Dune_pkg.Package_version @@ -66,11 +67,75 @@ let resolve_project_pins project_pins = Pin_stanza.resolve project_pins ~scan_project ;; +let solve_multiple_envs + base_solver_env + version_preference + repos + ~pins + ~local_packages + ~constraints + = + let open Fiber.O in + let solve_for_env env = + Dune_pkg.Opam_solver.solve_lock_dir + env + version_preference + repos + ~pins + ~local_packages + ~constraints + in + let portable_solver_env = + (* TODO: make sure nothing system-specific sneaks into the environment here *) + Dune_pkg.Solver_env.unset_multi + base_solver_env + Dune_lang.Package_variable_name.platform_specific + in + let+ results = + Fiber.parallel_map Dune_pkg.Solver_env.popular_platform_envs ~f:(fun platform_env -> + let solver_env = Dune_pkg.Solver_env.extend portable_solver_env platform_env in + solve_for_env solver_env) + in + let results, errors = + List.partition_map results ~f:(function + | Ok result -> Left result + | Error (`Diagnostic_message message) -> Right message) + in + match results with + | [] -> Error errors + | x :: xs -> + Ok (List.fold_left xs ~init:x ~f:Dune_pkg.Opam_solver.Solver_result.merge, errors) +;; + +let solve_single_env + solver_env + version_preference + repos + ~pins + ~local_packages + ~constraints + = + let open Fiber.O in + let+ result = + Dune_pkg.Opam_solver.solve_lock_dir + solver_env + version_preference + repos + ~pins + ~local_packages + ~constraints + in + match result with + | Ok result -> Ok (result, []) + | Error (`Diagnostic_message message) -> Error [ message ] +;; + let solve_lock_dir workspace ~local_packages ~project_pins ~print_perf_stats + ~portable_lock_dir version_preference solver_env_from_current_system lock_dir_path @@ -109,7 +174,8 @@ let solve_lock_dir let* pins = resolve_project_pins project_pins in let time_solve_start = Unix.gettimeofday () in progress_state := Some Progress_indicator.Per_lockdir.State.Solving; - Dune_pkg.Opam_solver.solve_lock_dir + let solve = if portable_lock_dir then solve_multiple_envs else solve_single_env in + solve solver_env (Pkg_common.Version_preference.choose ~from_arg:version_preference @@ -121,8 +187,11 @@ let solve_lock_dir (Package_name.Map.map local_packages ~f:Dune_pkg.Local_package.for_solver) ~constraints:(constraints_of_workspace workspace ~lock_dir_path) >>= function - | Error (`Diagnostic_message message) -> Fiber.return (Error (lock_dir_path, message)) - | Ok { lock_dir; files; pinned_packages; num_expanded_packages } -> + | Error messages -> Fiber.return (Error (lock_dir_path, messages)) + | Ok ({ lock_dir; files; pinned_packages; num_expanded_packages }, _errors) -> + (* TODO: Users might want to know if no solution was found on certain + platforms. Give the option to print the solver errors, even if a + solution was found on some platforms. *) let time_end = Unix.gettimeofday () in let maybe_perf_stats = if print_perf_stats @@ -149,7 +218,13 @@ let solve_lock_dir in progress_state := None; let+ lock_dir = Lock_dir.compute_missing_checksums ~pinned_packages lock_dir in - Ok (Lock_dir.Write_disk.prepare ~lock_dir_path ~files lock_dir, summary_message) + Ok + ( Lock_dir.Write_disk.prepare + ~portable:portable_lock_dir + ~lock_dir_path + ~files + lock_dir + , summary_message ) ;; let solve @@ -160,6 +235,7 @@ let solve ~version_preference ~lock_dirs ~print_perf_stats + ~portable_lock_dir = let open Fiber.O in (* a list of thunks that will perform all the file IO side @@ -182,6 +258,7 @@ let solve ~local_packages ~project_pins ~print_perf_stats + ~portable_lock_dir version_preference solver_env_from_current_system lockdir_path @@ -196,9 +273,9 @@ let solve | Error errors -> User_error.raise ([ Pp.text "Unable to solve dependencies for the following lock directories:" ] - @ List.concat_map errors ~f:(fun (path, message) -> + @ List.concat_map errors ~f:(fun (path, messages) -> [ Pp.textf "Lock directory %s:" (Path.Source.to_string_maybe_quoted path) - ; Pp.hovbox message + ; Pp.hovbox (Pp.concat ~sep:Pp.newline messages) ])) | Ok write_disks_with_summaries -> let write_disk_list, summary_messages = List.split write_disks_with_summaries in @@ -214,7 +291,7 @@ let project_pins = Pin_stanza.DB.combine_exn acc (Dune_project.pins project)) ;; -let lock ~version_preference ~lock_dirs_arg ~print_perf_stats = +let lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir = let open Fiber.O in let* solver_env_from_current_system = Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial) @@ -240,6 +317,7 @@ let lock ~version_preference ~lock_dirs_arg ~print_perf_stats = ~version_preference ~lock_dirs ~print_perf_stats + ~portable_lock_dir ;; let term = @@ -250,7 +328,12 @@ let term = let builder = Common.Builder.forbid_builds builder in let common, config = Common.init builder in Scheduler.go ~common ~config (fun () -> - lock ~version_preference ~lock_dirs_arg ~print_perf_stats) + let portable_lock_dir = + match Config.get Dune_rules.Compile_time.portable_lock_dir with + | `Enabled -> true + | `Disabled -> false + in + lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir) ;; let info = diff --git a/bin/pkg/lock.mli b/bin/pkg/lock.mli index d9f99d43dc2..e6b307791a0 100644 --- a/bin/pkg/lock.mli +++ b/bin/pkg/lock.mli @@ -8,6 +8,7 @@ val solve -> version_preference:Dune_pkg.Version_preference.t option -> lock_dirs:Path.Source.t list -> print_perf_stats:bool + -> portable_lock_dir:bool -> unit Fiber.t (** Command to create lock directory *) diff --git a/boot/configure.ml b/boot/configure.ml index 42e25d29564..b9f676bde14 100644 --- a/boot/configure.ml +++ b/boot/configure.ml @@ -18,7 +18,11 @@ let out = ;; let default_toggles : (string * [ `Disabled | `Enabled ]) list = - [ "toolchains", `Enabled; "pkg_build_progress", `Disabled; "lock_dev_tool", `Disabled ] + [ "toolchains", `Enabled + ; "pkg_build_progress", `Disabled + ; "lock_dev_tool", `Disabled + ; "portable_lock_dir", `Disabled + ] ;; let toggles = ref default_toggles @@ -101,6 +105,10 @@ let () = , " Enable ocamlformat dev-tool, allows 'dune fmt' to build ocamlformat and use \ it, independently from the project depenedencies .\n\ \ This flag is experimental and shouldn't be relied on by packagers." ) + ; ( "--portable-lock-dir" + , toggle "portable_lock_dir" + , "Generate portable lock dirs. If this feature is disabled then lock dirs will be \ + specialized to the machine where they are generated." ) ] in let anon s = bad "Don't know what to do with %s" s in diff --git a/boot/libs.ml b/boot/libs.ml index ef1c797eb54..a1600b501fd 100644 --- a/boot/libs.ml +++ b/boot/libs.ml @@ -1,4 +1,4 @@ -let external_libraries = [ "unix"; "threads" ] +let external_libraries = [ "threads.posix" ] let local_libraries = [ ("otherlibs/ordering", Some "Ordering", false, None) diff --git a/src/dune_lang/package_variable_name.ml b/src/dune_lang/package_variable_name.ml index 9c3e06d4953..bc1570e93f6 100644 --- a/src/dune_lang/package_variable_name.ml +++ b/src/dune_lang/package_variable_name.ml @@ -53,6 +53,10 @@ let post = of_string "post" let one_of t xs = List.mem xs ~equal t let dev = of_string "dev" +let platform_specific = + Set.of_list [ arch; os; os_version; os_distribution; os_family; sys_ocaml_version ] +;; + module Project = struct let encode name = Dune_sexp.Encoder.string (":" ^ to_string name) diff --git a/src/dune_lang/package_variable_name.mli b/src/dune_lang/package_variable_name.mli index 02dd9d7e1a7..d0dd1e770a7 100644 --- a/src/dune_lang/package_variable_name.mli +++ b/src/dune_lang/package_variable_name.mli @@ -32,6 +32,10 @@ val build : t val dev : t val one_of : t -> t list -> bool +(** The set of variable names whose values are expected to differ depending on + the current platform. *) +val platform_specific : Set.t + module Project : sig val encode : t Dune_sexp.Encoder.t val decode : t Dune_sexp.Decoder.t diff --git a/src/dune_pkg/file_entry.ml b/src/dune_pkg/file_entry.ml index 857775524d8..77c9ca6b2da 100644 --- a/src/dune_pkg/file_entry.ml +++ b/src/dune_pkg/file_entry.ml @@ -4,7 +4,28 @@ type source = | Path of Path.t | Content of string +let source_equal a b = + match a, b with + | Path a, Path b -> Path.equal a b + | Content a, Content b -> String.equal a b + | Path _, Content _ | Content _, Path _ -> false +;; + +let source_to_dyn = function + | Path path -> Dyn.variant "Path" [ Path.to_dyn path ] + | Content content -> Dyn.variant "Content" [ Dyn.string content ] +;; + type t = { original : source ; local_file : Path.Local.t } + +let equal { original; local_file } t = + source_equal original t.original && Path.Local.equal local_file t.local_file +;; + +let to_dyn { original; local_file } = + Dyn.record + [ "original", source_to_dyn original; "local_file", Path.Local.to_dyn local_file ] +;; diff --git a/src/dune_pkg/file_entry.mli b/src/dune_pkg/file_entry.mli index 857775524d8..d92aa2f817d 100644 --- a/src/dune_pkg/file_entry.mli +++ b/src/dune_pkg/file_entry.mli @@ -8,3 +8,6 @@ type t = { original : source ; local_file : Path.Local.t } + +val equal : t -> t -> bool +val to_dyn : t -> Dyn.t diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index d3b71741e93..133d6251cdd 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -1,5 +1,113 @@ open Import +module Conditional = struct + type 'a t = + { condition : Solver_env.t + ; value : 'a + } + + let make condition value = + let condition = Solver_env.retain condition Package_variable_name.platform_specific in + { condition; value } + ;; + + let equal value_equal { condition; value } t = + Solver_env.equal condition t.condition && value_equal value t.value + ;; + + let to_dyn value_to_dyn { condition; value } = + Dyn.record [ "condition", Solver_env.to_dyn condition; "value", value_to_dyn value ] + ;; + + let decode value_decode = + let open Decoder in + enter + (let+ condition = enter Solver_env.decode + and+ value = value_decode in + { condition; value }) + ;; + + let encode value_encode { condition; value } = + Dune_lang.List [ Solver_env.encode condition; value_encode value ] + ;; + + let map t ~f = { t with value = f t.value } + let condition { condition; _ } = condition + let get { value; _ } = value + + let matches t ~query = + Solver_env.fold t.condition ~init:true ~f:(fun variable stored_value acc -> + acc + && + match Solver_env.get query variable with + | None -> + (* The stored env has a field missing from the query. Don't match in this case. *) + false + | Some query_value -> Variable_value.equal query_value stored_value) + ;; +end + +module Conditional_choice = struct + type 'a t = 'a Conditional.t list + + let empty = [] + let singleton condition value = [ Conditional.make condition value ] + let singleton_all_platforms value = singleton Solver_env.empty value + let equal value_equal = List.equal (Conditional.equal value_equal) + let map ~f = List.map ~f:(Conditional.map ~f) + let to_dyn value_to_dyn = Dyn.list (Conditional.to_dyn value_to_dyn) + + let find t query = + List.find_map t ~f:(fun conditional -> + if Conditional.matches conditional ~query + then Some (Conditional.get conditional) + else None) + ;; + + let condition_exists t query = + List.exists t ~f:(fun conditional -> Conditional.matches conditional ~query) + ;; + + let encode_field field_name value_encode t = + Encoder.field_l field_name (Conditional.encode value_encode) t + ;; + + (* Concatenates a pair of sets of choices, raising a code error if the pair + has a condition in common. *) + let merge a b = + let merged = a @ b in + let () = + List.map merged ~f:(fun { Conditional.condition; _ } -> condition, ()) + |> Solver_env.Map.of_list_fold ~init:0 ~f:(fun count _ -> count + 1) + |> Solver_env.Map.iteri ~f:(fun solver_env count -> + if count > 1 + then + Code_error.raise + "Both sets of conditional choices had a condition in common." + [ "condition", Solver_env.to_dyn solver_env ]) + in + merged + ;; + + (* To support encoding in the non-portable format, this function extracts the + sole value from a conditional choice, raising a code error if there are + multiple choices. *) + let get_value_ensuring_at_most_one_choice t = + if List.length t > 1 + then + Code_error.raise + "Expected at most one conditional choice" + [ "conditions", List.map t ~f:Conditional.condition |> Dyn.list Solver_env.to_dyn + ]; + List.hd_opt t |> Option.map ~f:Conditional.get + ;; + + let decode_backwards_compatible decode_value = + let open Decoder in + decode_value >>| singleton_all_platforms <|> repeat (Conditional.decode decode_value) + ;; +end + module Pkg_info = struct type t = { name : Package_name.t @@ -75,10 +183,11 @@ module Build_command = struct module Fields = struct let dune = "dune" + let action = "action" let build = "build" end - let encode t = + let encode_non_portable t = let open Encoder in match t with | None -> field_o Fields.build Encoder.unit None @@ -86,35 +195,99 @@ module Build_command = struct | Some (Action a) -> field Fields.build Action.encode a ;; - let decode = + let encode_portable t = + let open Encoder in + Dune_lang.List + (record_fields + [ (match t with + | Dune -> field_b Fields.dune true + | Action a -> field Fields.action Action.encode a) + ]) + ;; + + let decode_portable = let open Decoder in + enter + @@ fields + @@ fields_mutually_exclusive + [ ( Fields.action + , let+ pkg = Action.decode_pkg in + Action pkg ) + ; ( Fields.dune + , let+ () = return () in + Dune ) + ] + ;; + + let decode_fields_backwards_compatible = + let open Decoder in + let parse_action = + (let+ action = Action.decode_pkg in + Conditional_choice.singleton_all_platforms (Action action)) + <|> repeat (Conditional.decode decode_portable) + in fields_mutually_exclusive - ~default:None - [ ( Fields.build - , let+ pkg = Action.decode_pkg in - Some (Action pkg) ) + ~default:Conditional_choice.empty + [ Fields.build, parse_action ; ( Fields.dune , let+ () = return () in - Some Dune ) + Conditional_choice.singleton_all_platforms Dune ) ] ;; end +module Depend = struct + type t = + { loc : Loc.t + ; name : Package_name.t + } + + let equal { loc; name } t = Loc.equal loc t.loc && Package_name.equal name t.name + let remove_locs { name; loc = _ } = { name; loc = Loc.none } + + let to_dyn { loc; name } = + Dyn.record [ "loc", Loc.to_dyn_hum loc; "name", Package_name.to_dyn name ] + ;; + + let decode = + let open Decoder in + let+ loc, name = located Package_name.decode in + { loc; name } + ;; + + let encode { name; loc = _ } = Package_name.encode name +end + +module Depends = struct + type t = Depend.t list + + let equal = List.equal Depend.equal + let remove_locs = List.map ~f:Depend.remove_locs + let to_dyn = Dyn.list Depend.to_dyn + + let decode = + let open Decoder in + enter @@ repeat Depend.decode + ;; + + let encode t = Dune_lang.List (List.map t ~f:Depend.encode) +end + module Pkg = struct type t = - { build_command : Build_command.t option - ; install_command : Action.t option - ; depends : (Loc.t * Package_name.t) list + { build_command : Build_command.t Conditional_choice.t + ; install_command : Action.t Conditional_choice.t + ; depends : Depends.t Conditional_choice.t ; depexts : string list ; info : Pkg_info.t ; exported_env : String_with_vars.t Action.Env_update.t list } let equal { build_command; install_command; depends; depexts; info; exported_env } t = - Option.equal Build_command.equal build_command t.build_command + Conditional_choice.equal Build_command.equal build_command t.build_command (* CR-rgrinberg: why do we ignore locations? *) - && Option.equal Action.equal_no_locs install_command t.install_command - && List.equal (Tuple.T2.equal Loc.equal Package_name.equal) depends t.depends + && Conditional_choice.equal Action.equal_no_locs install_command t.install_command + && Conditional_choice.equal Depends.equal depends t.depends && List.equal String.equal depexts t.depexts && Pkg_info.equal info t.info && List.equal @@ -128,18 +301,18 @@ module Pkg = struct { info = Pkg_info.remove_locs info ; exported_env = List.map exported_env ~f:(Action.Env_update.map ~f:String_with_vars.remove_locs) - ; depends = List.map depends ~f:(fun (_, pkg) -> Loc.none, pkg) + ; depends = Conditional_choice.map depends ~f:Depends.remove_locs ; depexts - ; build_command = Option.map build_command ~f:Build_command.remove_locs - ; install_command = Option.map install_command ~f:Action.remove_locs + ; build_command = Conditional_choice.map build_command ~f:Build_command.remove_locs + ; install_command = Conditional_choice.map install_command ~f:Action.remove_locs } ;; let to_dyn { build_command; install_command; depends; depexts; info; exported_env } = Dyn.record - [ "build_command", Dyn.option Build_command.to_dyn build_command - ; "install_command", Dyn.option Action.to_dyn install_command - ; "depends", Dyn.list (Dyn.pair Loc.to_dyn_hum Package_name.to_dyn) depends + [ "build_command", Conditional_choice.to_dyn Build_command.to_dyn build_command + ; "install_command", Conditional_choice.to_dyn Action.to_dyn install_command + ; "depends", Conditional_choice.to_dyn Depends.to_dyn depends ; "depexts", Dyn.list String.to_dyn depexts ; "info", Pkg_info.to_dyn info ; ( "exported_env" @@ -160,6 +333,7 @@ module Pkg = struct module Fields = struct let version = "version" + let build = "build" let install = "install" let depends = "depends" let depexts = "depexts" @@ -171,13 +345,25 @@ module Pkg = struct let decode = let open Decoder in + let parse_install_command_backwards_compatible = + Conditional_choice.decode_backwards_compatible Action.decode_pkg + in + let parse_depends_backwards_compatible = + repeat Depend.decode + >>| Conditional_choice.singleton_all_platforms + <|> repeat (Conditional.decode Depends.decode) + in enter @@ fields @@ let+ version = field Fields.version Package_version.decode - and+ install_command = field_o Fields.install Action.decode_pkg - and+ build_command = Build_command.decode + and+ install_command = + field ~default:[] Fields.install parse_install_command_backwards_compatible + and+ build_command = Build_command.decode_fields_backwards_compatible and+ depends = - field ~default:[] Fields.depends (repeat (located Package_name.decode)) + field + ~default:(Conditional_choice.singleton_all_platforms []) + Fields.depends + parse_depends_backwards_compatible and+ depexts = field ~default:[] Fields.depexts (repeat string) and+ source = field_o Fields.source Source.decode and+ dev = field_b Fields.dev @@ -214,6 +400,7 @@ module Pkg = struct ;; let encode + ~portable { build_command ; install_command ; depends @@ -223,11 +410,34 @@ module Pkg = struct } = let open Encoder in + let install_command, build_command, depends = + if portable + then + ( Conditional_choice.encode_field Fields.install Action.encode install_command + , Conditional_choice.encode_field + Fields.build + Build_command.encode_portable + build_command + , Conditional_choice.encode_field Fields.depends Depends.encode depends ) + else + ( field_o + Fields.install + Action.encode + (Conditional_choice.get_value_ensuring_at_most_one_choice install_command) + , Build_command.encode_non_portable + (Conditional_choice.get_value_ensuring_at_most_one_choice build_command) + , field_l + Fields.depends + Package_name.encode + (Conditional_choice.get_value_ensuring_at_most_one_choice depends + |> Option.value ~default:[] + |> List.map ~f:(fun { Depend.name; _ } -> name)) ) + in record_fields [ field Fields.version Package_version.encode version - ; field_o Fields.install Action.encode install_command - ; Build_command.encode build_command - ; field_l Fields.depends Package_name.encode (List.map depends ~f:snd) + ; install_command + ; build_command + ; depends ; field_l Fields.depexts string depexts ; field_o Fields.source Source.encode source ; field_b Fields.dev dev @@ -239,6 +449,26 @@ module Pkg = struct let files_dir package_name ~lock_dir = Path.Source.relative lock_dir (Package_name.to_string package_name ^ ".files") ;; + + (* Combine the platform-specific parts of a pair of [t]s, raising a code + error if the packages differ in any way apart from their platform-specific + fields. *) + let merge_conditionals a b = + let build_command = Conditional_choice.merge a.build_command b.build_command in + let install_command = Conditional_choice.merge a.install_command b.install_command in + let depends = Conditional_choice.merge a.depends b.depends in + let ret = { a with build_command; install_command; depends } in + if not (equal ret { b with build_command; install_command; depends }) + then + Code_error.raise + "Packages differ in a non-platform-specific field" + [ "package_1", to_dyn a; "package_2", to_dyn b ]; + ret + ;; + + let is_available_under_condition t condition = + Conditional_choice.condition_exists t.depends condition + ;; end module Repositories = struct @@ -362,14 +592,15 @@ let validate_packages packages = let missing_dependencies = Package_name.Map.values packages |> List.concat_map ~f:(fun (dependant_package : Pkg.t) -> - List.filter_map dependant_package.depends ~f:(fun (loc, dependency) -> - (* CR-someday rgrinberg: do we need the dune check? aren't - we supposed to filter these upfront? *) - if - Package_name.Map.mem packages dependency - || Package_name.equal dependency Dune_dep.name - then None - else Some { dependant_package; dependency; loc })) + List.concat_map dependant_package.depends ~f:(fun conditional_depends -> + List.filter_map conditional_depends.value ~f:(fun depend -> + (* CR-someday rgrinberg: do we need the dune check? aren't + we supposed to filter these upfront? *) + if + Package_name.Map.mem packages depend.name + || Package_name.equal depend.name Dune_dep.name + then None + else Some { dependant_package; dependency = depend.name; loc = depend.loc }))) in if List.is_empty missing_dependencies then Ok () @@ -433,6 +664,7 @@ module Metadata = Dune_sexp.Versioned_file.Make (Unit) let () = Metadata.Lang.register Dune_lang.Pkg.syntax () let encode_metadata + ~portable { version ; dependency_hash ; ocaml @@ -465,7 +697,9 @@ let encode_metadata | Some ocaml -> [ list sexp [ string "ocaml"; Package_name.encode (snd ocaml) ] ]) @ [ list sexp (string "repositories" :: Repositories.encode repos) ] @ - if Solver_stats.Expanded_variable_bindings.is_empty expanded_solver_variable_bindings + if + portable + || Solver_stats.Expanded_variable_bindings.is_empty expanded_solver_variable_bindings then [] else [ list @@ -503,11 +737,11 @@ module Package_filename = struct ;; end -let file_contents_by_path t = - (metadata_filename, encode_metadata t) +let file_contents_by_path ~portable t = + (metadata_filename, encode_metadata ~portable t) :: (Package_name.Map.to_list t.packages |> List.map ~f:(fun (name, pkg) -> - Package_filename.of_package_name name, Pkg.encode pkg)) + Package_filename.of_package_name name, Pkg.encode ~portable pkg)) ;; module Write_disk = struct @@ -598,6 +832,7 @@ module Write_disk = struct type t = unit -> unit let prepare + ~portable ~lock_dir_path:lock_dir_path_src ~(files : File_entry.t Package_name.Map.Multi.t) lock_dir @@ -617,7 +852,7 @@ module Write_disk = struct in let build lock_dir_path = let lock_dir_path = Result.ok_exn lock_dir_path in - file_contents_by_path lock_dir + file_contents_by_path ~portable lock_dir |> List.iter ~f:(fun (path_within_lock_dir, contents) -> let path = Path.relative lock_dir_path path_within_lock_dir in Option.iter (Path.parent path) ~f:Path.mkdir_p; @@ -844,7 +1079,7 @@ module Load_immediate = Make_load (struct let read_disk = Load_immediate.load let read_disk_exn = Load_immediate.load_exn -let transitive_dependency_closure t start = +let transitive_dependency_closure t condition start = let missing_packages = let all_packages_in_lock_dir = Package_name.Set.of_keys t.packages in Package_name.Set.diff start all_packages_in_lock_dir @@ -864,7 +1099,19 @@ let transitive_dependency_closure t start = that its map of dependencies is closed under "depends on". *) Package_name.Set.( diff - (of_list_map (Package_name.Map.find_exn t.packages node).depends ~f:snd) + (of_list_map + (let pkg = Package_name.Map.find_exn t.packages node in + match Conditional_choice.find pkg.depends condition with + | Some depends -> depends + | None -> + User_error.raise + [ Pp.textf + "Lockfile does not contain dependencies for %s under the \ + condition" + (Package_name.to_string pkg.info.name) + ; Solver_env.pp condition + ]) + ~f:(fun depend -> depend.name)) seen) in push_set unseen_deps; @@ -885,3 +1132,36 @@ let compute_missing_checksums t ~pinned_packages = in { t with packages } ;; + +let merge_conditionals a b = + let packages = + Package_name.Map.merge a.packages b.packages ~f:(fun _ a b -> + match a, b with + | Some a, Some b -> + (* The package exists in both lockdirs. *) + Some (Pkg.merge_conditionals a b) + | Some x, None | None, Some x -> + (* The package only exists in one of the lockdirs. *) + Some x + | None, None -> + (* unreachable *) + None) + in + let normalize t = + { t with + packages = Package_name.Map.empty + ; expanded_solver_variable_bindings = Solver_stats.Expanded_variable_bindings.empty + } + in + if not (equal (normalize a) (normalize b)) + then + Code_error.raise + "Platform-specific lockdirs differ in a non-platform-specific way" + [ "lockdir_1", to_dyn a; "lockdir_2", to_dyn b ]; + { a with packages } +;; + +let packages_under_condition { packages; _ } condition = + Package_name.Map.filter packages ~f:(fun package -> + Pkg.is_available_under_condition package condition) +;; diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index d42db52fc82..cf2095c6103 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -19,13 +19,37 @@ module Build_command : sig type t = | Action of Action.t | Dune (** pinned dune packages do not need to define a command *) + + val to_dyn : t -> Dyn.t +end + +module Depend : sig + type t = + { loc : Loc.t + ; name : Package_name.t + } + + val to_dyn : t -> Dyn.t +end + +module Conditional_choice : sig + (** A sequence of values, each conditional on an environment. *) + type 'a t + + val empty : 'a t + val singleton : Solver_env.t -> 'a -> 'a t + val singleton_all_platforms : 'a -> 'a t + + (** Returns the first value whose associated environment is a subset of the + specified environment. *) + val find : 'a t -> Solver_env.t -> 'a option end module Pkg : sig type t = - { build_command : Build_command.t option - ; install_command : Action.t option - ; depends : (Loc.t * Package_name.t) list + { build_command : Build_command.t Conditional_choice.t + ; install_command : Action.t Conditional_choice.t + ; depends : Depend.t list Conditional_choice.t ; depexts : string list ; info : Pkg_info.t ; exported_env : String_with_vars.t Action.Env_update.t list @@ -92,7 +116,8 @@ module Write_disk : sig type t val prepare - : lock_dir_path:Path.Source.t + : portable:bool + -> lock_dir_path:Path.Source.t -> files:File_entry.t Package_name.Map.Multi.t -> lock_dir -> t @@ -122,9 +147,16 @@ end not present in the lockdir. *) val transitive_dependency_closure : t + -> Solver_env.t -> Package_name.Set.t -> (Package_name.Set.t, [ `Missing_packages of Package_name.Set.t ]) result (** Attempt to download and compute checksums for packages that have source archive urls but no checksum. *) val compute_missing_checksums : t -> pinned_packages:Package_name.Set.t -> t Fiber.t + +(** Combine the platform-specific parts of a pair of lockdirs, throwing a code + error if the lockdirs differ in a non-platform-specific way. *) +val merge_conditionals : t -> t -> t + +val packages_under_condition : t -> Solver_env.t -> Pkg.t Package_name.Map.t diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml index 9d5e3393361..b9b842b8265 100644 --- a/src/dune_pkg/opam_solver.ml +++ b/src/dune_pkg/opam_solver.ml @@ -782,13 +782,13 @@ module Solver = struct candidates) in let+ () = - Fiber.parallel_iter !impls ~f:(fun { var = impl_var; impl } -> + Fiber.sequential_iter !impls ~f:(fun { var = impl_var; impl } -> Conflict_classes.process conflict_classes impl_var impl; match expand_deps with | `No_expand -> Fiber.return () | `Expand_and_collect_conflicts deferred -> Input.Impl.requires role impl - |> Fiber.parallel_iter ~f:(fun (dep : Input.dependency) -> + |> Fiber.sequential_iter ~f:(fun (dep : Input.dependency) -> match dep.importance with | Ensure -> process_dep expand_deps impl_var dep | Prevent -> @@ -850,7 +850,7 @@ module Solver = struct restricting dependencies are irrelevant to solving the dependency problem. *) List.rev !conflicts - |> Fiber.parallel_iter ~f:(fun (impl_var, dep) -> + |> Fiber.sequential_iter ~f:(fun (impl_var, dep) -> process_dep `No_expand impl_var dep) (* All impl_candidates have now been added, so snapshot the cache. *) in @@ -1289,7 +1289,7 @@ module Solver = struct impl in Input.Role.Map.to_list impls - |> Fiber.parallel_map ~f:(fun (k, v) -> + |> Fiber.sequential_map ~f:(fun (k, v) -> let+ v = get_selected k v in k, v) |> Fiber.map ~f:Input.Role.Map.of_list_exn @@ -1422,8 +1422,33 @@ let opam_variable_to_slang ~loc packages variable = Blang.Expr (convert_with_package_name package_name)))) ;; +(* Handles the special case for packages whose names contain '+' characters + where a special form of string interpolation is used. From the opam manual: + Warning: if the package name contains a + character (e.g. conf-g++), their + variables may only be accessed using opam 2.2 via string interpolation, + with the following syntax: + + "%{?conf-g++:your-variable:}%" +*) +let desugar_special_string_interpolation_syntax + ((packages, variable, string_converter) as fident) + = + match string_converter with + | Some (package_and_variable, "") + when List.is_empty packages && OpamVariable.to_string variable |> String.is_empty -> + (match String.lsplit2 package_and_variable ~on:':' with + | Some (package, variable) -> + ( [ Some (OpamPackage.Name.of_string package) ] + , OpamVariable.of_string variable + , None ) + | None -> fident) + | _ -> fident +;; + let opam_fident_to_slang ~loc fident = - let packages, variable, string_converter = OpamFilter.desugar_fident fident in + let packages, variable, string_converter = + OpamFilter.desugar_fident fident |> desugar_special_string_interpolation_syntax + in let slang = opam_variable_to_slang ~loc packages variable in match string_converter with | None -> slang @@ -1726,7 +1751,8 @@ let opam_package_to_lock_file_pkg |> List.filter ~f:(fun package_name -> not (List.mem depends package_name ~equal:Package_name.equal)) in - depends @ depopts |> List.map ~f:(fun package_name -> Loc.none, package_name) + depends @ depopts + |> List.map ~f:(fun name -> { Lock_dir.Depend.loc = Loc.none; name }) in let build_env action = let env_update = @@ -1779,6 +1805,10 @@ let opam_package_to_lock_file_pkg |> Option.map ~f:build_env |> Option.map ~f:(fun action -> Lock_dir.Build_command.Action action)) in + let build_command = + Option.map build_command ~f:(Lock_dir.Conditional_choice.singleton solver_env) + |> Option.value ~default:Lock_dir.Conditional_choice.empty + in let depexts = OpamFile.OPAM.depexts opam_file |> List.concat_map ~f:(fun (sys_pkgs, filter) -> @@ -1791,12 +1821,15 @@ let opam_package_to_lock_file_pkg OpamFile.OPAM.install opam_file |> opam_commands_to_actions get_solver_var loc opam_package |> make_action - |> Option.map ~f:build_env + |> Option.map ~f:(fun action -> + Lock_dir.Conditional_choice.singleton solver_env (build_env action)) + |> Option.value ~default:Lock_dir.Conditional_choice.empty in let exported_env = OpamFile.OPAM.env opam_file |> List.map ~f:opam_env_update_to_env_update in let kind = if opam_file_is_compiler opam_file then `Compiler else `Non_compiler in + let depends = Lock_dir.Conditional_choice.singleton solver_env depends in ( kind , { Lock_dir.Pkg.build_command; install_command; depends; depexts; info; exported_env } ) @@ -1842,6 +1875,30 @@ module Solver_result = struct ; pinned_packages : Package_name.Set.t ; num_expanded_packages : int } + + let merge a b = + let lock_dir = Lock_dir.merge_conditionals a.lock_dir b.lock_dir in + let files = + Package_name.Map.merge a.files b.files ~f:(fun _ a b -> + match a, b with + | Some a, Some b -> + (* The package is present in both solutions. Make sure its associated + files are the same in both instances. *) + if not (List.equal File_entry.equal a b) + then + Code_error.raise + "Package files differ between merged solver results" + [ "files_1", Dyn.list File_entry.to_dyn a + ; "files_2", Dyn.list File_entry.to_dyn b + ]; + Some a + | Some x, None | None, Some x -> Some x + | None, None -> None) + in + let pinned_packages = Package_name.Set.union a.pinned_packages b.pinned_packages in + let num_expanded_packages = a.num_expanded_packages + b.num_expanded_packages in + { lock_dir; files; pinned_packages; num_expanded_packages } + ;; end let reject_unreachable_packages = @@ -1885,7 +1942,11 @@ let reject_unreachable_packages = Code_error.raise "package is both local and returned by solver" [ "name", Package_name.to_dyn name ] - | Some (pkg : Lock_dir.Pkg.t), None -> Some (List.map pkg.depends ~f:snd) + | Some (pkg : Lock_dir.Pkg.t), None -> + Some + (Lock_dir.Conditional_choice.find pkg.depends solver_env + |> Option.value ~default:[] + |> List.map ~f:(fun (depend : Lock_dir.Depend.t) -> depend.name)) | None, Some (pkg : Local_package.For_solver.t) -> let deps = match @@ -2036,18 +2097,22 @@ let solve_lock_dir Package_name.Map.iter pkgs_by_name ~f:(fun { Lock_dir.Pkg.depends; info = { name; _ }; _ } -> - List.iter depends ~f:(fun (loc, dep_name) -> - if Package_name.Map.mem local_packages dep_name - then - User_error.raise - ~loc - [ Pp.textf - "Dune does not support packages outside the workspace depending on \ - packages in the workspace. The package %S is not in the workspace \ - but it depends on the package %S which is in the workspace." - (Package_name.to_string name) - (Package_name.to_string dep_name) - ])); + Option.iter + (Lock_dir.Conditional_choice.find depends solver_env) + ~f: + (List.iter ~f:(fun (depend : Lock_dir.Depend.t) -> + if Package_name.Map.mem local_packages depend.name + then + User_error.raise + ~loc:depend.loc + [ Pp.textf + "Dune does not support packages outside the workspace \ + depending on packages in the workspace. The package %S is \ + not in the workspace but it depends on the package %S which \ + is in the workspace." + (Package_name.to_string name) + (Package_name.to_string depend.name) + ]))); let pkgs_by_name = let reachable = reject_unreachable_packages diff --git a/src/dune_pkg/opam_solver.mli b/src/dune_pkg/opam_solver.mli index 21a0ac2954d..2c701d6be0b 100644 --- a/src/dune_pkg/opam_solver.mli +++ b/src/dune_pkg/opam_solver.mli @@ -7,6 +7,8 @@ module Solver_result : sig ; pinned_packages : Package_name.Set.t ; num_expanded_packages : int } + + val merge : t -> t -> t end val solve_lock_dir diff --git a/src/dune_pkg/package_universe.ml b/src/dune_pkg/package_universe.ml index 0984553a1f1..d2225da7291 100644 --- a/src/dune_pkg/package_universe.ml +++ b/src/dune_pkg/package_universe.ml @@ -86,6 +86,7 @@ let all_non_local_dependencies_of_local_packages t = let check_for_unnecessary_packges_in_lock_dir lock_dir + solver_env all_non_local_dependencies_of_local_packages = let unneeded_packages_in_lock_dir = @@ -93,6 +94,7 @@ let check_for_unnecessary_packges_in_lock_dir match Lock_dir.transitive_dependency_closure lock_dir + solver_env all_non_local_dependencies_of_local_packages with | Ok x -> x @@ -220,7 +222,7 @@ let validate t = t.local_packages ~saved_dependency_hash:t.lock_dir.dependency_hash; all_non_local_dependencies_of_local_packages t - |> check_for_unnecessary_packges_in_lock_dir t.lock_dir + |> check_for_unnecessary_packges_in_lock_dir t.lock_dir t.solver_env ;; let create local_packages lock_dir = @@ -273,6 +275,7 @@ let transitive_dependency_closure_without_test t start = match Lock_dir.transitive_dependency_closure t.lock_dir + t.solver_env Package_name.Set.( union non_local_immediate_dependencies_of_local_transitive_dependency_closure diff --git a/src/dune_pkg/solver_env.ml b/src/dune_pkg/solver_env.ml index ff06e563b3d..9df3f6738d8 100644 --- a/src/dune_pkg/solver_env.ml +++ b/src/dune_pkg/solver_env.ml @@ -1,11 +1,19 @@ open Import -type t = Variable_value.t Package_variable_name.Map.t +module T = struct + type t = Variable_value.t Package_variable_name.Map.t + + let to_dyn = Package_variable_name.Map.to_dyn Variable_value.to_dyn + let equal = Package_variable_name.Map.equal ~equal:Variable_value.equal + let compare = Package_variable_name.Map.compare ~compare:Variable_value.compare +end + +include T +include Comparable.Make (T) let empty = Package_variable_name.Map.empty -let equal = Package_variable_name.Map.equal ~equal:Variable_value.equal -let to_dyn = Package_variable_name.Map.to_dyn Variable_value.to_dyn let is_empty = Package_variable_name.Map.is_empty +let fold = Package_variable_name.Map.foldi let validate t ~loc = if Package_variable_name.Map.mem t Package_variable_name.with_test @@ -20,6 +28,12 @@ let validate t ~loc = ] ;; +let encode t = + let open Encoder in + Package_variable_name.Map.to_list t + |> list (pair Package_variable_name.encode Variable_value.encode) +;; + let decode = let open Decoder in let+ loc, bindings = @@ -77,6 +91,13 @@ let unset_multi t variable_names = unset t variable_name) ;; +let retain t variable_names = + fold t ~init:t ~f:(fun variable_name _value acc -> + if Package_variable_name.Set.mem variable_names variable_name + then acc + else unset acc variable_name) +;; + let to_env t variable = match OpamVariable.Full.scope variable with | Self | Package _ -> None @@ -86,3 +107,32 @@ let to_env t variable = in get t variable_name |> Option.map ~f:Variable_value.to_opam_variable_contents ;; + +let popular_platform_envs = + let make ~os ~arch ~os_distribution = + let env = empty in + let env = set env Package_variable_name.os (Variable_value.string os) in + let env = set env Package_variable_name.arch (Variable_value.string arch) in + let env = + match os_distribution with + | Some os_distribution -> + set + env + Package_variable_name.os_distribution + (Variable_value.string os_distribution) + | None -> env + in + env + in + List.concat_map + (* Include distros with special cases in popular packages (such as the ocaml compiler). *) + [ "linux", [ "alpine" ]; "macos", []; "win32", [ "cygwin" ] ] + ~f:(fun (os, distros) -> + List.concat_map [ "x86_64"; "arm64" ] ~f:(fun arch -> + let distros = + (* Put the [None] case at the end of the list so that cases with + distros are tried first. *) + List.map distros ~f:Option.some @ [ None ] + in + List.map distros ~f:(fun os_distribution -> make ~os ~arch ~os_distribution))) +;; diff --git a/src/dune_pkg/solver_env.mli b/src/dune_pkg/solver_env.mli index d5c7bcc62bb..13443c6e93a 100644 --- a/src/dune_pkg/solver_env.mli +++ b/src/dune_pkg/solver_env.mli @@ -6,6 +6,14 @@ val empty : t val equal : t -> t -> bool val to_dyn : t -> Dyn.t val is_empty : t -> bool + +val fold + : t + -> init:'a + -> f:(Package_variable_name.t -> Variable_value.t -> 'a -> 'a) + -> 'a + +val encode : t Encoder.t val decode : t Decoder.t val set : t -> Package_variable_name.t -> Variable_value.t -> t val get : t -> Package_variable_name.t -> Variable_value.t option @@ -22,4 +30,11 @@ val with_defaults : t val pp : t -> 'a Pp.t val unset_multi : t -> Package_variable_name.Set.t -> t + +(* [retain t vars] removes all variables from [t] except for those in [vars]. *) +val retain : t -> Package_variable_name.Set.t -> t val to_env : t -> OpamFilter.env +val popular_platform_envs : t list + +module Map : Map.S with type key = t +module Set : Set.S with type elt = t and type 'a map = 'a Map.t diff --git a/src/dune_pkg/variable_value.ml b/src/dune_pkg/variable_value.ml index 0f66ae0e310..47f5f7552d2 100644 --- a/src/dune_pkg/variable_value.ml +++ b/src/dune_pkg/variable_value.ml @@ -17,6 +17,7 @@ let true_ = "true" let false_ = "false" let string = Fun.id let equal = String.equal +let compare = String.compare let to_dyn = Dyn.string let to_string = Fun.id let decode = Decoder.string diff --git a/src/dune_pkg/variable_value.mli b/src/dune_pkg/variable_value.mli index 2e6fd3d183c..56246bdce19 100644 --- a/src/dune_pkg/variable_value.mli +++ b/src/dune_pkg/variable_value.mli @@ -9,6 +9,7 @@ val false_ : t val string : string -> t val equal : t -> t -> bool +val compare : t -> t -> ordering val to_dyn : t -> Dyn.t val decode : t Decoder.t val encode : t Encoder.t diff --git a/src/dune_rules/compile_time.ml b/src/dune_rules/compile_time.ml index 700cb1b44b6..5f4c1a83d70 100644 --- a/src/dune_rules/compile_time.ml +++ b/src/dune_rules/compile_time.ml @@ -7,3 +7,7 @@ let pkg_build_progress = ;; let lock_dev_tools = Config.make_toggle ~name:"lock_dev_tool" ~default:Setup.lock_dev_tool + +let portable_lock_dir = + Config.make_toggle ~name:"portable_lock_dir" ~default:Setup.portable_lock_dir +;; diff --git a/src/dune_rules/compile_time.mli b/src/dune_rules/compile_time.mli index 0d8a405dfc6..02c8d8ecaf1 100644 --- a/src/dune_rules/compile_time.mli +++ b/src/dune_rules/compile_time.mli @@ -20,3 +20,5 @@ val pkg_build_progress : Config.Toggle.t Config.t (** Enable or disable using package management to install dev tools. *) val lock_dev_tools : Config.Toggle.t Config.t + +val portable_lock_dir : Config.Toggle.t Config.t diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index 8fbba4bae35..513f07a2242 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -66,6 +66,27 @@ module Sys_vars = struct (Dune_sexp.Template.Pform.describe source) ]) ;; + + let solver_env () = + let open Memo.O in + let module V = Package_variable_name in + let { os; os_version; os_distribution; os_family; arch; sys_ocaml_version = _ } = + poll + in + let+ var_value_pairs = + [ V.os, os + ; V.os_version, os_version + ; V.os_distribution, os_distribution + ; V.os_family, os_family + ; V.arch, arch + ] + |> Memo.List.filter_map ~f:(fun (var, value) -> + let+ value = Memo.Lazy.force value in + Option.map value ~f:(fun value -> var, Variable_value.string value)) + in + List.fold_left var_value_pairs ~init:Solver_env.empty ~f:(fun acc (var, value) -> + Solver_env.set acc var value) + ;; end module Load = Make_load (struct diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli index 8d69758f5ae..285dd5d2b44 100644 --- a/src/dune_rules/lock_dir.mli +++ b/src/dune_rules/lock_dir.mli @@ -21,6 +21,7 @@ module Sys_vars : sig } val poll : t + val solver_env : unit -> Dune_pkg.Solver_env.t Memo.t end val source_kind diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index 471687e9e0f..5bf48a0694a 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -1062,8 +1062,12 @@ module DB = struct let get package_universe = let dune = Package.Name.Set.singleton (Package.Name.of_string "dune") in - let+ all = Package_universe.lock_dir package_universe in - { all = all.packages; system_provided = dune } + let+ all = Package_universe.lock_dir package_universe + and+ solver_env = Lock_dir.Sys_vars.solver_env () in + let all_available_packages = + Dune_pkg.Lock_dir.packages_under_condition all solver_env + in + { all = all_available_packages; system_provided = dune } ;; end @@ -1108,9 +1112,21 @@ end = struct ; depexts } as pkg) -> assert (Package.Name.equal name info.name); + let* solver_env = Lock_dir.Sys_vars.solver_env () in + let depends = + match Dune_pkg.Lock_dir.Conditional_choice.find depends solver_env with + | Some depends -> depends + | None -> + User_error.raise + [ Pp.textf + "Lockfile does not contain dependencies for %s under the condition" + (Dune_pkg.Package_name.to_string pkg.info.name) + ; Dune_pkg.Solver_env.pp solver_env + ] + in let* depends = - Memo.parallel_map depends ~f:(fun name -> - resolve db name package_universe + Memo.parallel_map depends ~f:(fun depend -> + resolve db (depend.loc, depend.name) package_universe >>| function | `Inside_lock_dir pkg -> Some pkg | `System_provided -> None) @@ -1125,6 +1141,12 @@ end = struct in let id = Pkg.Id.gen () in let write_paths = Paths.make package_universe name ~relative:Path.Build.relative in + let install_command = + Dune_pkg.Lock_dir.Conditional_choice.find install_command solver_env + in + let build_command = + Dune_pkg.Lock_dir.Conditional_choice.find build_command solver_env + in let* paths, build_command, install_command = let paths = Paths.map_path write_paths ~f:Path.build in match Pkg_toolchain.is_compiler_and_toolchains_enabled info.name with diff --git a/src/dune_rules/setup.defaults.ml b/src/dune_rules/setup.defaults.ml index 4515addf7bc..3fdcc2d1a51 100644 --- a/src/dune_rules/setup.defaults.ml +++ b/src/dune_rules/setup.defaults.ml @@ -15,3 +15,4 @@ let prefix : string option = None let toolchains = `Enabled let pkg_build_progress = `Disabled let lock_dev_tool = `Disabled +let portable_lock_dir = `Disabled diff --git a/src/dune_rules/setup.mli b/src/dune_rules/setup.mli index 4666b18ec25..76128d3876e 100644 --- a/src/dune_rules/setup.mli +++ b/src/dune_rules/setup.mli @@ -13,4 +13,5 @@ val roots : string option Install.Roots.t val toolchains : Dune_config.Config.Toggle.t val pkg_build_progress : Dune_config.Config.Toggle.t val lock_dev_tool : Dune_config.Config.Toggle.t +val portable_lock_dir : Dune_config.Config.Toggle.t val prefix : string option diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t new file mode 100644 index 00000000000..6d7f5a91401 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t @@ -0,0 +1,163 @@ +Demonstration of portable lockdirs. + + $ . ./helpers.sh + $ mkrepo + $ add_mock_repo_if_needed + +A package that writes some info about machine where it's built to the share directory. + $ mkpkg foo < build: [ + > ["mkdir" "-p" share "%{lib}%/%{name}%"] + > ["touch" "%{lib}%/%{name}%/META"] # needed for dune to recognize this as a library + > ["sh" "-c" "echo Darwin > %{share}%/kernel"] { os = "macos" } + > ["sh" "-c" "echo Linux > %{share}%/kernel"] { os = "linux" } + > ["sh" "-c" "echo x86_64 > %{share}%/machine"] { arch = "x86_64" } + > ["sh" "-c" "echo arm64 > %{share}%/machine"] { arch = "arm64" } + > ] + > EOF + + $ cat > dune-project < (lang dune 3.17) + > (package + > (name x) + > (depends foo)) + > EOF + $ cat > x.ml < let () = print_endline "Hello, World!" + > EOF + $ cat > dune < (executable + > (public_name x) + > (libraries foo)) + > EOF + + $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock + Solution for dune.lock: + - foo.0.0.1 + + $ cat dune.lock/foo.pkg + (version 0.0.1) + + (build + (((arch x86_64) + (os linux) + (os-distribution alpine)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch x86_64) + (os linux)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch arm64) + (os linux) + (os-distribution alpine)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo arm64 > %{share}/machine"))))) + (((arch arm64) + (os linux)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo arm64 > %{share}/machine"))))) + (((arch x86_64) + (os macos)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Darwin > %{share}/kernel") + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch arm64) + (os macos)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Darwin > %{share}/kernel") + (run sh -c "echo arm64 > %{share}/machine"))))) + (((arch x86_64) + (os win32) + (os-distribution cygwin)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch x86_64) + (os win32)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch arm64) + (os win32) + (os-distribution cygwin)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo arm64 > %{share}/machine"))))) + (((arch arm64) + (os win32)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo arm64 > %{share}/machine")))))) + + (depends + (((arch x86_64) + (os linux) + (os-distribution alpine)) + ()) + (((arch x86_64) + (os linux)) + ()) + (((arch arm64) + (os linux) + (os-distribution alpine)) + ()) + (((arch arm64) + (os linux)) + ()) + (((arch x86_64) + (os macos)) + ()) + (((arch arm64) + (os macos)) + ()) + (((arch x86_64) + (os win32) + (os-distribution cygwin)) + ()) + (((arch x86_64) + (os win32)) + ()) + (((arch arm64) + (os win32) + (os-distribution cygwin)) + ()) + (((arch arm64) + (os win32)) + ())) + + $ dune build + + $ [ $(cat _build/_private/default/.pkg/foo/target/share/kernel) = $(uname -s) ] + + $ [ $(cat _build/_private/default/.pkg/foo/target/share/machine) = $(uname -m) ] 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 ff0bf08ad43..d3b17d27183 100644 --- a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml +++ b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml @@ -1,6 +1,7 @@ open Stdune module Checksum = Dune_pkg.Checksum module Lock_dir = Dune_pkg.Lock_dir +module Depend = Dune_pkg.Lock_dir.Depend module Opam_repo = Dune_pkg.Opam_repo module Expanded_variable_bindings = Dune_pkg.Solver_stats.Expanded_variable_bindings module Package_variable_name = Dune_lang.Package_variable_name @@ -66,7 +67,8 @@ end let lock_dir_encode_decode_round_trip_test ?commit ~lock_dir_path ~lock_dir () = let lock_dir_path = Path.Source.of_string lock_dir_path in Lock_dir.Write_disk.( - prepare ~lock_dir_path ~files:Package_name.Map.empty lock_dir |> commit); + prepare ~portable:false ~lock_dir_path ~files:Package_name.Map.empty lock_dir + |> commit); let lock_dir_round_tripped = try Lock_dir.read_disk_exn lock_dir_path with | User_error.E _ as exn -> @@ -123,13 +125,14 @@ let%expect_test "encode/decode round trip test for lockdir with no deps" = ; repos = { complete = true; used = None } ; expanded_solver_variable_bindings = { variable_values = []; unset_variables = [] } - } |}] + } + |}] ;; let empty_package name ~version = - { Lock_dir.Pkg.build_command = None - ; install_command = None - ; depends = [] + { Lock_dir.Pkg.build_command = Lock_dir.Conditional_choice.empty + ; install_command = Lock_dir.Conditional_choice.empty + ; depends = Lock_dir.Conditional_choice.singleton_all_platforms [] ; depexts = [] ; info = { Lock_dir.Pkg_info.name; version; dev = false; source = None; extra_sources = [] } @@ -167,9 +170,9 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = ; packages = map { "bar" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "bar" @@ -181,9 +184,9 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = ; exported_env = [] } ; "foo" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "foo" @@ -208,6 +211,9 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = let%expect_test "encode/decode round trip test for lockdir with complex deps" = let module Action = Dune_lang.Action in let module String_with_vars = Dune_lang.String_with_vars in + let make_conditional value = + Lock_dir.Conditional_choice.singleton Dune_pkg.Solver_env.empty value + in let lock_dir = let pkg_a = let name = Package_name.of_string "a" in @@ -218,11 +224,11 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = , let pkg = empty_package name ~version:(Package_version.of_string "0.1.0") in { pkg with build_command = - Some - (Action + make_conditional + (Lock_dir.Build_command.Action Action.(Progn [ Echo [ String_with_vars.make_text Loc.none "hello" ] ])) ; install_command = - Some + make_conditional (Action.System (* String_with_vars.t doesn't round trip so we have to set [quoted] if the string would be quoted *) @@ -252,8 +258,8 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ( name , let pkg = empty_package name ~version:(Package_version.of_string "dev") in { pkg with - install_command = None - ; depends = [ Loc.none, fst pkg_a ] + install_command = Lock_dir.Conditional_choice.empty + ; depends = make_conditional [ { Depend.loc = Loc.none; name = fst pkg_a } ] ; info = { pkg.info with dev = true @@ -275,7 +281,11 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ( name , let pkg = empty_package name ~version:(Package_version.of_string "0.2") in { pkg with - depends = [ Loc.none, fst pkg_a; Loc.none, fst pkg_b ] + depends = + make_conditional + [ { Depend.loc = Loc.none; name = fst pkg_a } + ; { Depend.loc = Loc.none; name = fst pkg_b } + ] ; info = { pkg.info with dev = false @@ -307,9 +317,15 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; packages = map { "a" : - { build_command = Some (Action [ "progn"; [ "echo"; "hello" ] ]) - ; install_command = Some [ "system"; "echo 'world'" ] - ; depends = [] + { build_command = + [ { condition = map {} + ; value = Action [ "progn"; [ "echo"; "hello" ] ] + } + ] + ; install_command = + [ { condition = map {}; value = [ "system"; "echo 'world'" ] } + ] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "a" @@ -324,9 +340,14 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; exported_env = [ { op = "="; var = "foo"; value = "bar" } ] } ; "b" : - { build_command = None - ; install_command = None - ; depends = [ ("complex_lock_dir/b.pkg:3", "a") ] + { build_command = [] + ; install_command = [] + ; depends = + [ { condition = map {} + ; value = + [ { loc = "complex_lock_dir/b.pkg:3"; name = "a" } ] + } + ] ; depexts = [] ; info = { name = "b" @@ -344,11 +365,15 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; exported_env = [] } ; "c" : - { build_command = None - ; install_command = None + { build_command = [] + ; install_command = [] ; depends = - [ ("complex_lock_dir/c.pkg:3", "a") - ; ("complex_lock_dir/c.pkg:3", "b") + [ { condition = map {} + ; value = + [ { loc = "complex_lock_dir/c.pkg:3"; name = "a" } + ; { loc = "complex_lock_dir/c.pkg:3"; name = "b" } + ] + } ] ; depexts = [] ; info = @@ -418,9 +443,9 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; packages = map { "a" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "a" @@ -432,9 +457,9 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; exported_env = [] } ; "b" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "b" @@ -446,9 +471,9 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; exported_env = [] } ; "c" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "c" diff --git a/test/expect-tests/dune_rpc_e2e/dune_rpc_diagnostics.ml b/test/expect-tests/dune_rpc_e2e/dune_rpc_diagnostics.ml index 0f5421d0882..2376dc31ca8 100644 --- a/test/expect-tests/dune_rpc_e2e/dune_rpc_diagnostics.ml +++ b/test/expect-tests/dune_rpc_e2e/dune_rpc_diagnostics.ml @@ -136,85 +136,85 @@ let%expect_test "related error" = "foo.cma"; [%expect {| - Building foo.cma - Build foo.cma failed - [ "Add" - ; [ [ "directory"; "$CWD" ] - ; [ "id"; "0" ] - ; [ "loc" - ; [ [ "start" - ; [ [ "pos_bol"; "0" ] - ; [ "pos_cnum"; "0" ] - ; [ "pos_fname"; "$CWD/foo.ml" ] - ; [ "pos_lnum"; "1" ] + Building foo.cma + Build foo.cma failed + [ "Add" + ; [ [ "directory"; "$CWD" ] + ; [ "id"; "0" ] + ; [ "loc" + ; [ [ "start" + ; [ [ "pos_bol"; "0" ] + ; [ "pos_cnum"; "0" ] + ; [ "pos_fname"; "$CWD/foo.ml" ] + ; [ "pos_lnum"; "1" ] + ] ] - ] - ; [ "stop" - ; [ [ "pos_bol"; "0" ] - ; [ "pos_cnum"; "0" ] - ; [ "pos_fname"; "$CWD/foo.ml" ] - ; [ "pos_lnum"; "1" ] + ; [ "stop" + ; [ [ "pos_bol"; "0" ] + ; [ "pos_cnum"; "0" ] + ; [ "pos_fname"; "$CWD/foo.ml" ] + ; [ "pos_lnum"; "1" ] + ] ] ] ] - ] - ; [ "message" - ; [ "Verbatim" - ; "The implementation foo.ml\n\ - does not match the interface .foo.objs/byte/foo.cmi: \n\ - Values do not match: val x : bool is not included in val x : int\n\ - The type bool is not compatible with the type int\n\ - " + ; [ "message" + ; [ "Verbatim" + ; "The implementation foo.ml does not match the interface foo.ml: \n\ + Values do not match: val x : bool is not included in val x : int\n\ + The type bool is not compatible with the type int\n\ + " + ] ] - ] - ; [ "promotion"; [] ] - ; [ "related" - ; [ [ [ "loc" - ; [ [ "start" - ; [ [ "pos_bol"; "0" ] - ; [ "pos_cnum"; "0" ] - ; [ "pos_fname"; "$CWD/foo.mli" ] - ; [ "pos_lnum"; "1" ] + ; [ "promotion"; [] ] + ; [ "related" + ; [ [ [ "loc" + ; [ [ "start" + ; [ [ "pos_bol"; "0" ] + ; [ "pos_cnum"; "0" ] + ; [ "pos_fname"; "$CWD/foo.mli" ] + ; [ "pos_lnum"; "1" ] + ] ] - ] - ; [ "stop" - ; [ [ "pos_bol"; "0" ] - ; [ "pos_cnum"; "11" ] - ; [ "pos_fname"; "$CWD/foo.mli" ] - ; [ "pos_lnum"; "1" ] + ; [ "stop" + ; [ [ "pos_bol"; "0" ] + ; [ "pos_cnum"; "11" ] + ; [ "pos_fname"; "$CWD/foo.mli" ] + ; [ "pos_lnum"; "1" ] + ] ] ] ] + ; [ "message"; [ "Verbatim"; "Expected declaration\n\ + " ] ] ] - ; [ "message"; [ "Verbatim"; "Expected declaration\n\ - " ] ] - ] - ; [ [ "loc" - ; [ [ "start" - ; [ [ "pos_bol"; "0" ] - ; [ "pos_cnum"; "4" ] - ; [ "pos_fname"; "$CWD/foo.ml" ] - ; [ "pos_lnum"; "1" ] + ; [ [ "loc" + ; [ [ "start" + ; [ [ "pos_bol"; "0" ] + ; [ "pos_cnum"; "4" ] + ; [ "pos_fname"; "$CWD/foo.ml" ] + ; [ "pos_lnum"; "1" ] + ] ] - ] - ; [ "stop" - ; [ [ "pos_bol"; "0" ] - ; [ "pos_cnum"; "5" ] - ; [ "pos_fname"; "$CWD/foo.ml" ] - ; [ "pos_lnum"; "1" ] + ; [ "stop" + ; [ [ "pos_bol"; "0" ] + ; [ "pos_cnum"; "5" ] + ; [ "pos_fname"; "$CWD/foo.ml" ] + ; [ "pos_lnum"; "1" ] + ] ] ] ] + ; [ "message"; [ "Verbatim"; "Actual declaration\n\ + " ] ] ] - ; [ "message"; [ "Verbatim"; "Actual declaration\n\ - " ] ] ] ] + ; [ "severity"; "error" ] + ; [ "targets"; [] ] ] - ; [ "severity"; "error" ] - ; [ "targets"; [] ] ] - ] |}]; + |}]; diagnostic_with_build [ "dune", "(library (name foo)) (executable (name foo))"; "foo.ml", "" ] "@check";