diff --git a/bin/pkg/lock.ml b/bin/pkg/lock.ml index 5294cd06b4e..6cea36c56f6 100644 --- a/bin/pkg/lock.ml +++ b/bin/pkg/lock.ml @@ -54,114 +54,6 @@ module Progress_indicator = struct let add_overlay (t : t) = Console.Status_line.add_overlay (Live (fun () -> pp t)) end -module Platforms_by_message = struct - module Message = struct - type t = - | Solve_error of User_message.Style.t Pp.t - | Manifest_error of User_message.t - - let to_dyn = function - | Solve_error message -> - Dyn.variant "Solve_error" [ Pp.to_dyn User_message.Style.to_dyn message ] - | Manifest_error message -> - Dyn.variant "Manifest_error" [ User_message.to_dyn message ] - ;; - - let compare a b = - match a, b with - | Solve_error a, Solve_error b -> Pp.compare ~compare:User_message.Style.compare a b - | Solve_error _, _ -> Lt - | _, Solve_error _ -> Gt - | Manifest_error a, Manifest_error b -> User_message.compare a b - ;; - end - - module Message_map = Map.Make (Message) - - (* Map messages to the list of platforms for which those messages are - relevant. If a dependency problem has no solution on any platform, it's - likely that the error from the solver will be identical across all - platforms. We don't want to print the same error message once for each - platform, so this type collects messages and the platforms for which they - are relevant, deduplicating common messages. *) - type t = Solver_env.t list Message_map.t - - let singleton message platform : t = Message_map.singleton message [ platform ] - let to_list (t : t) : (Message.t * Solver_env.t list) list = Message_map.to_list t - let union_all ts : t = Message_map.union_all ts ~f:(fun _ a b -> Some (a @ b)) - - let all_solver_errors_raising_if_any_manifest_errors t = - let solver_errors, manifest_errors = - List.partition_map (to_list t) ~f:(fun (message, platforms) -> - match message with - | Solve_error message -> Left (message, platforms) - | Manifest_error message -> Right message) - in - match manifest_errors with - | [] -> solver_errors - | message :: _ -> raise (User_error.E message) - ;; -end - -let solve_multiple_platforms - base_solver_env - version_preference - repos - ~pins - ~local_packages - ~constraints - ~selected_depopts - ~solve_for_platforms - ~portable_lock_dir - = - 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 - ~selected_depopts - ~portable_lock_dir - in - let portable_solver_env = - Solver_env.unset_multi - base_solver_env - Dune_lang.Package_variable_name.platform_specific - in - let+ results = - Fiber.parallel_map solve_for_platforms ~f:(fun platform_env -> - let solver_env = Solver_env.extend portable_solver_env platform_env in - let+ solver_result = solve_for_env solver_env in - Result.map_error solver_result ~f:(fun message -> - let message : Platforms_by_message.Message.t = - match message with - | `Solve_error m -> Solve_error m - | `Manifest_error m -> Manifest_error m - in - Platforms_by_message.singleton message platform_env)) - in - let solver_results, errors = - List.partition_map results ~f:(function - | Ok result -> Left result - | Error e -> Right e) - in - match solver_results, errors with - | [], [] -> Code_error.raise "Solver did not run for any platforms." [] - | _, _ :: _ -> - (* Any errors means full failure - no partial solutions *) - `All_error - (Platforms_by_message.union_all errors - |> Platforms_by_message.all_solver_errors_raising_if_any_manifest_errors) - | x :: xs, [] -> - let merged_solver_result = - List.fold_left xs ~init:x ~f:Dune_pkg.Opam_solver.Solver_result.merge - in - `All_ok merged_solver_result -;; - let user_lock_dir_path path = match (path : Path.t) with | In_source_tree _ -> path @@ -174,7 +66,6 @@ let summary_message ~lock_dir_path ~(lock_dir : Lock_dir.t) ~maybe_perf_stats - ~maybe_unsolved_platforms_message = if portable_lock_dir then ( @@ -229,43 +120,42 @@ let summary_message ; pp_package_set packages ])) in - (Pp.tag - User_message.Style.Success - (Pp.textf - "Solution for %s" - (Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path))) - :: Pp.nop - :: Pp.text "Dependencies common to all supported platforms:" - :: pp_package_set common_packages - :: (maybe_uncommon_packages @ maybe_perf_stats)) - @ maybe_unsolved_platforms_message) + Pp.tag + User_message.Style.Success + (Pp.textf + "Solution for %s" + (Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path))) + :: Pp.nop + :: Pp.text "Dependencies common to all supported platforms:" + :: pp_package_set common_packages + :: (maybe_uncommon_packages @ maybe_perf_stats)) else - (Pp.tag - User_message.Style.Success - (Pp.textf - "Solution for %s:" - (Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path))) - :: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with - | [] -> Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)" - | packages -> pp_packages packages) - :: maybe_perf_stats) - @ maybe_unsolved_platforms_message + Pp.tag + User_message.Style.Success + (Pp.textf + "Solution for %s:" + (Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path))) + :: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with + | [] -> Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)" + | packages -> pp_packages packages) + :: maybe_perf_stats ;; -let pp_solve_errors_by_platforms platforms_by_message = - List.map platforms_by_message ~f:(fun (message, platforms) -> - Pp.concat - ~sep:Pp.cut - [ Pp.nop - ; Pp.box - @@ Pp.text - "The dependency solver failed to find a solution for the following \ - platforms:" - ; Pp.enumerate platforms ~f:Solver_env.pp_oneline - ; Pp.box @@ Pp.text "...with this error:" - ; message - ] - |> Pp.vbox) +(* A failed joint solve does not prove that every requested platform fails on + its own: the solver reports the first conflict it finds for the requested + platform set. *) +let pp_solve_error (message, platforms) = + Pp.concat + ~sep:Pp.cut + [ Pp.nop + ; Pp.box + @@ Pp.text + "The dependency solver failed to find a solution for the requested platforms:" + ; Pp.enumerate platforms ~f:Solver_env.pp_oneline + ; Pp.box @@ Pp.text "...with this error:" + ; message + ] + |> Pp.vbox ;; let solve_lock_dir @@ -309,7 +199,7 @@ let solve_lock_dir List.map solve_for_platforms ~f:(fun platform_env -> Solver_env.extend solver_env_from_context platform_env) | None -> solve_for_platforms) - | false -> [ solver_env ] + | false -> [] in let time_start = Time.now () in let* repos = @@ -327,9 +217,16 @@ let solve_lock_dir let* pins = Pin.Project.resolve project_pins in let time_solve_start = Time.now () in progress_state := Some Progress_indicator.Per_lockdir.State.Solving; + let solver_env, platform_overlays = + Dune_pkg.Opam_solver.base_solver_env_and_platforms + solver_env + ~solve_for_platforms + ~portable_lock_dir + in let* result = - solve_multiple_platforms + Dune_pkg.Opam_solver.solve_lock_dir solver_env + ~platform_overlays (Pkg_common.Version_preference.choose ~from_arg:version_preference ~from_context: @@ -340,17 +237,15 @@ 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) ~selected_depopts:(depopts_of_workspace workspace ~lock_dir_path) - ~solve_for_platforms ~portable_lock_dir in - let solver_result = - match result with - | `All_error messages -> Error messages - | `All_ok solver_result -> Ok (solver_result, []) - in - match solver_result with - | Error messages -> Fiber.return (Error (lock_dir_path, messages)) - | Ok (solver_result, maybe_unsolved_platforms_message) -> + match result with + | Error message -> + let platforms = + List.map platform_overlays ~f:Solver_env.remove_all_except_platform_specific + in + Fiber.return (Error (lock_dir_path, (message, platforms))) + | Ok solver_result -> let { Dune_pkg.Opam_solver.Solver_result.lock_dir ; files ; pinned_packages @@ -376,12 +271,7 @@ let solve_lock_dir in let summary_message = User_message.make - (summary_message - ~portable_lock_dir - ~lock_dir_path - ~lock_dir - ~maybe_perf_stats - ~maybe_unsolved_platforms_message) + (summary_message ~portable_lock_dir ~lock_dir_path ~lock_dir ~maybe_perf_stats) in progress_state := None; let+ lock_dir = Lock_dir.compute_missing_checksums ~pinned_packages lock_dir in @@ -434,26 +324,32 @@ let solve | _ -> Error errors) >>| function | Error errors -> - if portable_lock_dir - then - User_error.raise - (List.concat_map errors ~f:(fun (path, errors) -> - [ Pp.box - @@ Pp.textf - "Unable to solve dependencies while generating lock directory: %s" - (Path.to_string_maybe_quoted path) - ; Pp.vbox (Pp.concat ~sep:Pp.cut (pp_solve_errors_by_platforms errors)) - ])) - else - User_error.raise - ([ Pp.text "Unable to solve dependencies for the following lock directories:" ] - @ List.concat_map errors ~f:(fun (path, errors) -> - let messages = List.map errors ~f:fst in - [ Pp.textf - "Lock directory %s:" - (Path.to_string_maybe_quoted (user_lock_dir_path path)) - ; Pp.vbox (Pp.concat ~sep:Pp.cut messages) - ])) + let solver_errors = + List.concat_map errors ~f:(fun (path, (error, platforms)) -> + match error with + | `Manifest_error message -> raise (User_error.E message) + | `Solve_error error -> + if portable_lock_dir + then + [ Pp.box + @@ Pp.textf + "Unable to solve dependencies while generating lock directory: %s" + (Path.to_string_maybe_quoted path) + ; Pp.vbox (pp_solve_error (error, platforms)) + ] + else + [ Pp.textf + "Lock directory %s:" + (Path.to_string_maybe_quoted (user_lock_dir_path path)) + ; Pp.vbox error + ]) + in + User_error.raise + (if portable_lock_dir + then solver_errors + else + Pp.text "Unable to solve dependencies for the following lock directories:" + :: solver_errors) | Ok write_disks_with_summaries -> let write_disk_list, summary_messages = List.split write_disks_with_summaries in List.iter summary_messages ~f:Console.print_user_message; diff --git a/doc/changes/changed/15982.md b/doc/changes/changed/15982.md new file mode 100644 index 00000000000..a5c1b3cdd2c --- /dev/null +++ b/doc/changes/changed/15982.md @@ -0,0 +1,3 @@ +- Portable lock directories now select one package version across all requested + platforms, and fail when no common version exists. (#15982, fixes #13647, + @Alizter) diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 77f6edaf489..40c2c05ce93 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -1053,24 +1053,6 @@ module Packages = struct List.fold_left pkg.enabled_on_platforms ~init:acc ~f:(fun acc platform -> Solver_env.Map.add_multi acc platform pkg)) ;; - - let merge a b = - Package_name.Map.merge a b ~f:(fun _ a b -> - match a, b with - | None, None -> - (* unreachable *) - None - | Some x, None | None, Some x -> Some x - | Some a, Some b -> - Some - (Package_version.Map.merge a b ~f:(fun _ a b -> - match a, b with - | None, None -> - (* unreachable *) - None - | Some x, None | None, Some x -> Some x - | Some a, Some b -> Some (Pkg.merge_conditionals a b)))) - ;; end type t = @@ -1823,28 +1805,6 @@ let compute_missing_checksums t ~pinned_packages = { t with packages } ;; -let merge_conditionals a b = - let packages = Packages.merge a.packages b.packages in - let solved_for_platforms = - let a_loc, a_solved_for_platforms = a.solved_for_platforms in - let b_loc, b_solved_for_platforms = b.solved_for_platforms in - Loc.span a_loc b_loc, a_solved_for_platforms @ b_solved_for_platforms - in - let normalize t = - { t with - packages = Package_name.Map.empty - ; expanded_solver_variable_bindings = Solver_stats.Expanded_variable_bindings.empty - ; solved_for_platforms = Loc.none, [] - } - 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; solved_for_platforms } -;; - let loc_in_source_tree loc = loc |> Loc.map_pos ~f:(fun ({ pos_fname; _ } as pos) -> diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index 38ac6492af9..5c1d1d584ee 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -193,10 +193,6 @@ val transitive_dependency_closure 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 - (** Returns the packages contained in the solution on the given platform. If the lockdir does not contain a solution compatible with the given platform then a [User_error] is raised. *) diff --git a/src/dune_pkg/lock_pkg.ml b/src/dune_pkg/lock_pkg.ml index 4365c041bc4..b9a6b7bca73 100644 --- a/src/dune_pkg/lock_pkg.ml +++ b/src/dune_pkg/lock_pkg.ml @@ -660,59 +660,38 @@ let opam_package_to_lock_file_pkg_single } ;; -(* Public entry point: handles both single-platform and multi-platform cases. - For portable lockdirs with multiple solver_envs, we evaluate the opam file - against each platform separately and merge the results. This allows - platform-specific build commands, dependencies, etc. to be captured. *) -let opam_package_to_lock_file_pkg +(* Evaluate an opam package separately for each platform. The caller computes + reachability from these branches before merging them, so dependencies from + an unreachable platform cannot leak into the final package. *) +let opam_package_to_lock_file_pkg_branches solver_envs stats_updater - version_by_package_name opam_package ~pinned resolved_package ~portable_lock_dir = try + let solver_envs = + match solver_envs with + | [] -> + Code_error.raise + "opam_package_to_lock_file_pkg_branches called with empty solver_envs" + [] + | first :: _ when not portable_lock_dir -> [ first ] + | _ -> solver_envs + in Ok - (match solver_envs with - | [] -> - Code_error.raise "opam_package_to_lock_file_pkg called with empty solver_envs" [] - | [ solver_env ] -> - (* Single platform: use directly *) - opam_package_to_lock_file_pkg_single - solver_env - stats_updater - version_by_package_name - opam_package - ~pinned - resolved_package - ~portable_lock_dir - | _ when not portable_lock_dir -> - (* Non-portable with multiple envs: just use the first *) - let solver_env = List.hd solver_envs in - opam_package_to_lock_file_pkg_single - solver_env - stats_updater - version_by_package_name - opam_package - ~pinned - resolved_package - ~portable_lock_dir - | first_env :: rest_envs -> - (* Portable with multiple platforms: evaluate per-platform and merge *) - let to_pkg solver_env = - opam_package_to_lock_file_pkg_single + (List.map solver_envs ~f:(fun (solver_env, version_by_package_name) -> + ( solver_env + , opam_package_to_lock_file_pkg_single solver_env stats_updater version_by_package_name opam_package ~pinned resolved_package - ~portable_lock_dir - in - List.fold_left rest_envs ~init:(to_pkg first_env) ~f:(fun acc env -> - Lock_dir.Pkg.merge_conditionals acc (to_pkg env))) + ~portable_lock_dir ))) with | User_error.E exn -> Error exn ;; diff --git a/src/dune_pkg/lock_pkg.mli b/src/dune_pkg/lock_pkg.mli index 4eab9cec7ea..4cbde9dec4d 100644 --- a/src/dune_pkg/lock_pkg.mli +++ b/src/dune_pkg/lock_pkg.mli @@ -23,15 +23,15 @@ val local_package_dependencies -> dune_version:Package_version.t -> (Package_name.t list, Resolve_opam_formula.unsatisfied_formula) result -(** Convert a selected opam package to a package that dune can save to the lock - directory. The list of solver_envs represents the platforms this package - is enabled on. The first solver_env is used for evaluating filters. *) -val opam_package_to_lock_file_pkg - : Solver_env.t list +(** Convert a selected opam package into one lock-directory package branch per + solver environment. Each solver environment is paired with the packages + selected on that platform. The caller can discard unreachable branches + before merging the remaining platform-specific fields. *) +val opam_package_to_lock_file_pkg_branches + : (Solver_env.t * Package_version.t Package_name.Map.t) list -> Solver_stats.Updater.t - -> Package_version.t Package_name.Map.t -> OpamPackage.t -> pinned:bool -> Resolved_package.t -> portable_lock_dir:bool - -> (Lock_dir.Pkg.t, User_message.t) result + -> ((Solver_env.t * Lock_dir.Pkg.t) list, User_message.t) result diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml index 8b5faf92e39..4fab8757f36 100644 --- a/src/dune_pkg/opam_solver.ml +++ b/src/dune_pkg/opam_solver.ml @@ -54,7 +54,6 @@ module Priority = struct ;; let allowed version = { avoid = false; version } - let rejected version = { avoid = true; version } end module Context = struct @@ -66,17 +65,30 @@ module Context = struct Package_version.to_opam_package_version Lock_dir.Pkg_info.default_version ;; + type candidate_origin = + | Local + | Pinned + | Repository + + type candidate = + { priority : Priority.t + ; opam : OpamFile.OPAM.t + ; origin : candidate_origin + } + type candidates = { resolved : Resolved_package.t OpamPackage.Version.Map.t - ; available : (Priority.t * (OpamFile.OPAM.t, rejection) result) list + ; unfiltered : candidate list } type local_package = { opam_file : OpamFile.OPAM.t ; name : Package_name.t ; version : OpamPackage.Version.t - ; depends : OpamTypes.formula Lazy.t - ; conflicts : OpamTypes.formula Lazy.t + ; depends : OpamTypes.filtered_formula + ; conflicts : OpamTypes.filtered_formula + ; filtered_formulas_by_platform : + (Solver_env.t, OpamTypes.formula * OpamTypes.formula) Table.t } type t = @@ -86,14 +98,13 @@ module Context = struct ; local_packages : local_package Package_name.Map.t Lazy.t ; local_constraints : (Package_name.t, local_package list) Table.t Lazy.t ; solver_env : Solver_env.t + (* Base solver env. Full platform-specific envs are computed by extending + this with the platform's own env. *) ; dune_version : OpamPackage.Version.t + ; platforms : Solver_env.t list ; stats_updater : Solver_stats.Updater.t ; candidates_cache : (Package_name.t, candidates) Fiber.Cache.t - ; (* The solver can call this function several times on the same package. - If the package contains an invalid "available" filter we want to print a - warning, but only once per package. This field will keep track of the - packages for which we've printed a warning. *) - available_cache : (OpamPackage.t, bool) Table.t + ; platform_available_cache : (OpamPackage.t, (Solver_env.t, bool) Table.t) Table.t ; constraints : OpamTypes.filtered_formula Package_name.Map.t ; (* Number of versions of each package whose opam files were read from disk while solving. Used to report performance statistics. *) @@ -103,6 +114,7 @@ module Context = struct let create ~pinned_packages ~solver_env + ~platforms ~repos ~local_packages ~version_preference @@ -118,20 +130,18 @@ module Context = struct List.map formulae ~f:Package_dependency.to_opam_filtered_formula |> OpamFormula.ands) in - let available_cache = - Table.create - (module struct - include OpamPackage - - let to_dyn = Opam_dyn.package - end) - 1 + let module Opam_package_key = struct + include OpamPackage + + let to_dyn = Opam_dyn.package + end in + let platform_available_cache = Table.create (module Opam_package_key) 1 in let expanded_packages = Table.create (module Package_name) 1 in let local_constraints = lazy (let acc = Table.create (module Package_name) 20 in - let packages pkg (formula : OpamTypes.formula) = + let packages pkg (formula : OpamTypes.filtered_formula) = OpamFormula.iter (fun (name, _) -> let name = Package_name.of_opam_package_name name in @@ -140,25 +150,34 @@ module Context = struct in Lazy.force local_packages |> Package_name.Map.iter ~f:(fun pkg -> - packages pkg (Lazy.force pkg.depends); - packages pkg (Lazy.force pkg.conflicts)); + packages pkg pkg.depends; + packages pkg pkg.conflicts); acc) in { repos ; version_preference ; local_packages ; pinned_packages - ; solver_env = Solver_env.add_sentinel_values_for_unset_platform_vars solver_env + ; solver_env = + Solver_env.add_sentinel_values_for_unset_platform_vars solver_env + (* The platform envs don't need sentinel values - they only contain + platform-specific vars that will override the sentinels in solver_env + when extended. *) ; dune_version = Dune_dep.version + ; platforms ; stats_updater ; candidates_cache - ; available_cache + ; platform_available_cache ; constraints ; expanded_packages ; local_constraints } ;; + (* Compute the full platform-specific env by extending the base env with the + platform's own (platform-specific) env. *) + let platform_env t platform = Solver_env.extend t.solver_env platform + let pp_rejection = function | Unavailable -> Pp.paragraph "Availability condition not satisfied" | Refuted_by pkg -> @@ -167,62 +186,44 @@ module Context = struct (Package_name.to_string pkg) ;; - let eval_to_bool (filter : OpamTypes.filter) : (bool, [> `Not_a_bool of string ]) result - = - try Ok (OpamFilter.eval_to_bool ~default:false (Fun.const None) filter) with - | Invalid_argument msg -> Error (`Not_a_bool msg) + let eval_to_bool (filter : OpamTypes.filter) = + try OpamFilter.eval_to_bool ~default:false (Fun.const None) filter with + | Invalid_argument _ -> false ;; - let is_opam_available t opam = + let is_opam_available_in_env t ~solver_env opam = let package = OpamFile.OPAM.package opam in - Table.find_or_add t.available_cache package ~f:(fun (_ : OpamPackage.t) -> - let available = OpamFile.OPAM.available opam in - match - OpamFilter.partial_eval - (Solver_env.to_env t.solver_env - |> Solver_stats.Updater.wrap_env t.stats_updater - |> Lock_pkg.add_self_to_filter_env package) - available - |> eval_to_bool - with - | Ok available -> available - | Error (`Not_a_bool msg) -> - (let package_string = OpamFile.OPAM.package opam |> OpamPackage.to_string in - let available_string = OpamFilter.to_string available in - User_warning.emit - [ Pp.textf - "Ignoring package %s as its \"available\" filter can't be resolved to a \ - boolean value." - package_string - ; Pp.textf "available: %s" available_string - ; Pp.text msg - ]); - false) + OpamFile.OPAM.available opam + |> OpamFilter.partial_eval + (Solver_env.to_env solver_env + |> Solver_stats.Updater.wrap_env t.stats_updater + |> Lock_pkg.add_self_to_filter_env package) + |> eval_to_bool ;; - let available_or_error t opam_file = - (* The CONTEXT interface doesn't give us a way to report this type of - error and there's not enough context to give a helpful error message - so just tell opam_0install that there are no versions of this - package available (technically true) and let it produce the error - message. *) - if is_opam_available t opam_file then Ok opam_file else Error Unavailable + let is_available_for_platform t ~platform opam = + let package = OpamFile.OPAM.package opam in + let available_by_platform = + Table.find_or_add t.platform_available_cache package ~f:(fun _ -> + Table.create (module Solver_env) 1) + in + Table.find_or_add available_by_platform platform ~f:(fun platform -> + is_opam_available_in_env t ~solver_env:(platform_env t platform) opam) ;; - let pinned_candidate t resolved_package = + let pinned_candidate resolved_package = let version = Resolved_package.package resolved_package |> OpamPackage.version in - let available = - (* We don't respect avoid-version for pinned packages. This is - intentional. *) - [ ( Priority.allowed version - , Resolved_package.opam_file resolved_package |> available_or_error t ) - ] - in + let opam_file = Resolved_package.opam_file resolved_package in let resolved = OpamPackage.Version.Map.singleton version resolved_package in - { available; resolved } + (* We don't respect avoid-version for pinned packages. This is intentional. *) + { unfiltered = + [ { priority = Priority.allowed version; opam = opam_file; origin = Pinned } ] + ; resolved + } ;; - let filter_deps t package filtered_formula = + (* Filter deps using a specific solver_env *) + let filter_deps_with_env t ~solver_env package filtered_formula = (* Add additional constraints to the formula. This works in two steps. First identify all the additional constraints applied to packages which appear in the current package's dependency formula. Then each additional @@ -245,16 +246,37 @@ module Context = struct |> Package_name.of_opam_package_name |> Package_name.Map.mem (Lazy.force t.local_packages) in - let with_test = package_is_local && with_test t.solver_env in - Solver_env.to_env t.solver_env + let with_test = package_is_local && with_test solver_env in + Solver_env.to_env solver_env |> Solver_stats.Updater.wrap_env t.stats_updater |> Lock_pkg.add_self_to_filter_env package |> Resolve_opam_formula.apply_filter ~with_test ~formula:filtered_formula ;; + (* Filter deps for a specific platform *) + let filter_deps t ~platform package filtered_formula = + let solver_env = platform_env t platform in + filter_deps_with_env t ~solver_env package filtered_formula + ;; + + let filtered_local_formulas t ~platform local_package = + Table.find_or_add + local_package.filtered_formulas_by_platform + platform + ~f:(fun platform -> + let package = + OpamPackage.create + (OpamFile.OPAM.name local_package.opam_file) + local_package.version + in + let solver_env = platform_env t platform in + ( filter_deps_with_env t ~solver_env package local_package.depends + , filter_deps_with_env t ~solver_env package local_package.conflicts )) + ;; + exception Found of Package_name.t - let try_refute t package = + let try_refute t ~platform package = let version = OpamPackage.version package in match let name = Package_name.of_opam_package_name (OpamPackage.name package) in @@ -264,9 +286,10 @@ module Context = struct | Some local_packages -> (try List.iter local_packages ~f:(fun pkg -> + let depends, conflicts = filtered_local_formulas t ~platform pkg in match match - Lazy.force pkg.depends + depends |> OpamFormula.partial_eval (fun (name', f) -> if OpamPackage.Name.equal name' (OpamPackage.name package) then @@ -276,7 +299,7 @@ module Context = struct | `False -> `Reject | `Formula _ | `True -> (match - Lazy.force pkg.conflicts + conflicts |> OpamFormula.partial_eval (fun (name', f) -> if OpamPackage.Name.equal name' (OpamPackage.name package) then @@ -295,59 +318,83 @@ module Context = struct | Found p -> Some p) ;; + let refuted_on_all_platforms t package = + List.for_all t.platforms ~f:(fun platform -> + Option.is_some (try_refute t ~platform package)) + ;; + + let pre_rejections t ~platform name = + let package_name = Package_name.of_opam_package_name name in + if + Package_name.Map.mem (Lazy.force t.local_packages) package_name + || Package_name.Map.mem t.pinned_packages package_name + then [] + else + Opam_repo.all_packages_versions_map t.repos name + |> OpamPackage.Version.Map.keys + |> List.filter_map ~f:(fun version -> + let package = OpamPackage.create name version in + if refuted_on_all_platforms t package + then + try_refute t ~platform package + |> Option.map ~f:(fun name -> package, Refuted_by name) + else None) + ;; + + let rejection_for_platform t ~platform { opam; origin; _ } = + match origin with + | Local -> None + | Pinned -> + if is_available_for_platform t ~platform opam then None else Some Unavailable + | Repository -> + if not (is_available_for_platform t ~platform opam) + then Some Unavailable + else + OpamFile.OPAM.package opam + |> try_refute t ~platform + |> Option.map ~f:(fun package -> Refuted_by package) + ;; + let repo_candidate t name = - let versions = Opam_repo.all_packages_versions_map t.repos name in - let rejected, available = - OpamPackage.Version.Map.fold - (fun version (repo, key) (rejected, available) -> - let pkg = Opam_repo.Key.opam_package key in - match try_refute t pkg with - | Some p -> (version, p) :: rejected, available - | None -> rejected, OpamPackage.Version.Map.add version (repo, key) available) - versions - ([], OpamPackage.Version.Map.empty) + let versions = + Opam_repo.all_packages_versions_map t.repos name + |> OpamPackage.Version.Map.filter (fun version _ -> + let package = OpamPackage.create name version in + not (refuted_on_all_platforms t package)) in - let+ resolved = Opam_repo.load_all_versions_by_keys available in + let+ resolved = Opam_repo.load_all_versions_by_keys versions in Table.add_exn t.expanded_packages (Package_name.of_opam_package_name name) (OpamPackage.Version.Map.cardinal resolved); - let available = + let unfiltered = OpamPackage.Version.Map.values resolved |> List.map ~f:(fun resolved_package -> - let opam_file = Resolved_package.opam_file resolved_package in - let priority = Priority.make opam_file in - let result = available_or_error t opam_file in - priority, result) + let opam = Resolved_package.opam_file resolved_package in + { priority = Priority.make opam; opam; origin = Repository }) + |> List.sort ~compare:(fun x y -> + Priority.compare t.version_preference x.priority y.priority) in - let rejected = - List.map rejected ~f:(fun (version, rejected_by) -> - let priority = Priority.rejected version in - priority, Error (Refuted_by rejected_by)) - in - let available = - rejected @ available - |> List.sort ~compare:(fun (x, _) (y, _) -> - Priority.compare t.version_preference x y) - in - { available; resolved } + { unfiltered; resolved } ;; - let candidates t name = + (* Get all candidates with their opam files, without pre-filtering by availability. + Used for multi-platform solving where availability is checked per-platform. *) + let candidates_unfiltered t name = let* () = Fiber.return () in let key = Package_name.of_opam_package_name name in match Package_name.Map.find (Lazy.force t.local_packages) key with | Some local_package -> - let version = Priority.allowed local_package.version in - Fiber.return [ version, Ok local_package.opam_file ] + let priority = Priority.allowed local_package.version in + Fiber.return [ { priority; opam = local_package.opam_file; origin = Local } ] | None -> let+ res = Fiber.Cache.find_or_add t.candidates_cache key ~f:(fun () -> match Package_name.Map.find t.pinned_packages key with - | Some resolved_package -> Fiber.return (pinned_candidate t resolved_package) + | Some resolved_package -> Fiber.return (pinned_candidate resolved_package) | None -> repo_candidate t name) in - res.available + res.unfiltered ;; let user_restrictions : t -> OpamPackage.Name.t -> OpamFormula.version_constraint option @@ -372,6 +419,21 @@ module Solver = struct | Prevent end + (* Filter a list, keeping the first occurrence of each [Some name] key. + Items whose [key] is [None] are kept unconditionally. *) + let filter_dedup_by_name ~key items = + let seen = ref OpamPackage.Name.Set.empty in + List.filter items ~f:(fun item -> + match key item with + | None -> true + | Some name -> + if OpamPackage.Name.Set.mem name !seen + then false + else ( + seen := OpamPackage.Name.Set.add name !seen; + true)) + ;; + (* Copyright (c) 2020 Thomas Leonard Permission to use, copy, modify, and distribute this software for any @@ -444,7 +506,7 @@ module Solver = struct end type role = - | Real of OpamPackage.Name.t + | Real of OpamPackage.Name.t * Solver_env.t | Virtual of Virtual_id.t * impl list and real_impl = @@ -466,11 +528,21 @@ module Solver = struct | Reject of OpamPackage.t | Dummy (* Used for diagnostics *) + (* Deduplicate a list of dependencies by package name for display purposes. + This avoids showing the same package multiple times for different platforms. *) + let deduplicate_deps_by_name = + filter_dedup_by_name ~key:(fun (dependency : dependency) -> + match dependency.drole with + | Virtual _ -> None + | Real (name, _) -> Some name) + ;; + let rec pp_version = function | RealImpl impl -> Pp.text (OpamPackage.Version.to_string (OpamPackage.version impl.pkg)) | Reject pkg -> Pp.text (OpamPackage.version_to_string pkg) | VirtualImpl (_i, deps) -> + let deps = deduplicate_deps_by_name deps in Pp.concat_map ~sep:(Pp.char '&') deps ~f:(fun d -> pp_role d.drole) | Dummy -> Pp.text "(no version)" @@ -481,7 +553,9 @@ module Solver = struct | Dummy -> Pp.text "(no solution found)" and pp_role = function - | Real name -> Pp.text (OpamPackage.Name.to_string name) + | Real (name, _platform) -> + (* Don't show platform in user-facing output for now *) + Pp.text (OpamPackage.Name.to_string name) | Virtual (_, impls) -> Pp.concat_map ~sep:(Pp.char '|') impls ~f:pp_impl ;; @@ -493,7 +567,10 @@ module Solver = struct let compare a b = match a, b with - | Real a, Real b -> Ordering.of_int (OpamPackage.Name.compare a b) + | Real (a_name, a_platform), Real (b_name, b_platform) -> + (match Ordering.of_int (OpamPackage.Name.compare a_name b_name) with + | Eq -> Solver_env.compare a_platform b_platform + | x -> x) | Virtual (a, _), Virtual (b, _) -> Virtual_id.compare a b | Real _, Virtual _ -> Lt | Virtual _, Real _ -> Gt @@ -505,13 +582,29 @@ module Solver = struct include T let equal x y = Ordering.is_eq (compare x y) - let hash = Poly.hash + + let hash = function + | Real (name, platform) -> + let hash = Hash.create () in + let hash = Hash.feed hash 0 in + let hash = Hash.feed hash (OpamPackage.Name.to_string name |> String.hash) in + Hash.feed hash (Solver_env.hash platform) |> Hash.hash + | Virtual (id, _) -> + let hash = Hash.create () in + let hash = Hash.feed hash 1 in + Hash.feed hash (Virtual_id.hash id) |> Hash.hash + ;; + + let platform = function + | Real (_, platform) -> Some platform + | Virtual _ -> None + ;; let user_restrictions t context = match t with | Virtual _ -> None - | Real role -> - Context.user_restrictions context role + | Real (name, _platform) -> + Context.user_restrictions context name |> Option.map ~f:(fun f -> { Restriction.kind = Ensure; expr = OpamFormula.Atom f }) ;; @@ -521,15 +614,21 @@ module Solver = struct let rejects role context = match role with | Virtual _ -> Fiber.return ([], []) - | Real role -> + | Real (name, platform) -> + let pre_rejections = + Context.pre_rejections context ~platform name + |> List.map ~f:(fun (package, reason) -> Reject package, reason) + in let+ rejects = - Context.candidates context role - >>| List.filter_map ~f:(function - | _, Ok _ -> None - | { Priority.version; _ }, Error reason -> - let pkg = OpamPackage.create role version in + Context.candidates_unfiltered context name + >>| List.filter_map ~f:(fun ({ Context.priority; _ } as candidate) -> + match Context.rejection_for_platform context ~platform candidate with + | None -> None + | Some reason -> + let pkg = OpamPackage.create name priority.version in Some (Reject pkg, reason)) in + let rejects = pre_rejections @ rejects in let notes = [] in rejects, notes ;; @@ -537,6 +636,38 @@ module Solver = struct module Map = Map.Make (T) end + let%expect_test "equal roles have equal hashes" = + let bindings = + [ Package_variable_name.arch, "x86_64" + ; Package_variable_name.os, "linux" + ; Package_variable_name.os_version, "24.04" + ; Package_variable_name.os_distribution, "ubuntu" + ; Package_variable_name.os_family, "debian" + ; Package_variable_name.sys_ocaml_version, "5.3.0" + ] + in + let platform bindings = + List.fold_left bindings ~init:Solver_env.empty ~f:(fun env (name, value) -> + Solver_env.set env name (Variable_value.string value)) + in + let name = OpamPackage.Name.of_string "foo" in + let real_a = Real (name, platform bindings) in + let real_b = Real (name, platform (List.rev bindings)) in + let virtual_id = Virtual_id.gen () in + let virtual_a = Virtual (virtual_id, []) in + let virtual_b = Virtual (virtual_id, [ Dummy ]) in + printfn + "real_equal=%b real_hash_equal=%b virtual_equal=%b virtual_hash_equal=%b" + (Role.equal real_a real_b) + (Role.hash real_a = Role.hash real_b) + (Role.equal virtual_a virtual_b) + (Role.hash virtual_a = Role.hash virtual_b); + [%expect + {| + real_equal=true real_hash_equal=true virtual_equal=true virtual_hash_equal=true + |}] + ;; + module Impl = struct type t = impl @@ -619,11 +750,12 @@ module Solver = struct ;; (* Turn an opam dependency formula into a 0install list of dependencies. *) - let list_deps ~importance ~rank deps = + let list_deps ~importance ~rank ~platform deps = let rec aux (formula : _ OpamTypes.generic_formula) = match formula with | Empty -> [] - | Atom (name, restrictions) -> [ { drole = Real name; restrictions; importance } ] + | Atom (name, restrictions) -> + [ { drole = Real (name, platform); restrictions; importance } ] | Block x -> aux x | And (x, y) -> aux x @ aux y | Or _ as o -> @@ -639,24 +771,27 @@ module Solver = struct aux deps ;; - (* Get all the candidates for a role. *) + (* Get all candidates for a role, applying availability and local-package + constraints in that role's platform environment. *) let implementations role context = match role with | Virtual (_, impls) -> Fiber.return impls - | Real role -> - Context.candidates context role - >>| List.filter_map ~f:(function - | _, Error _rejection -> None - | { Priority.version; avoid }, Ok opam -> - let pkg = OpamPackage.create role version in + | Real (name, platform) -> + Context.candidates_unfiltered context name + >>| List.filter_map ~f:(fun ({ Context.priority; opam; _ } as candidate) -> + match Context.rejection_for_platform context ~platform candidate with + | Some _ -> None + | None -> + let { Priority.version; avoid } = priority in + let pkg = OpamPackage.create name version in (* Note: we ignore depopts here: see opam/doc/design/depopts-and-features *) let requires = lazy (let rank = Rank.assign () in let make_deps importance xform deps = - Context.filter_deps context pkg deps + Context.filter_deps context ~platform pkg deps |> xform - |> list_deps ~importance ~rank + |> list_deps ~importance ~rank ~platform in (OpamFile.OPAM.depends opam |> make_deps Ensure ensure) @ (OpamFile.OPAM.conflicts opam |> make_deps Prevent prevent)) @@ -753,48 +888,167 @@ module Solver = struct end module Conflict_classes = struct - type t = { mutable groups : Sat.lit list ref OpamPackage.Name.Map.t } + (* Key is (conflict_class_name, platform) to ensure conflict classes + are enforced per-platform, not across platforms. In multi-platform + solving, it's valid to select the same package with a conflict class + on multiple platforms, but within each platform, at most one package + with the conflict class can be selected. *) + module Key = struct + type t = OpamPackage.Name.t * Solver_env.t + + let compare (name1, plat1) (name2, plat2) = + match Ordering.of_int (OpamPackage.Name.compare name1 name2) with + | Eq -> Solver_env.compare plat1 plat2 + | x -> x + ;; - let create () = { groups = OpamPackage.Name.Map.empty } + let to_dyn (name, plat) = + Dyn.Tuple + [ Dyn.string (OpamPackage.Name.to_string name); Solver_env.to_dyn plat ] + ;; + end - let var t name = - match OpamPackage.Name.Map.find_opt name t.groups with + module Key_map = Map.Make (Key) + + type t = { mutable groups : Sat.lit list ref Key_map.t } + + let create () = { groups = Key_map.empty } + + let var t key = + match Key_map.find t.groups key with | Some v -> v | None -> let v = ref [] in - t.groups <- OpamPackage.Name.Map.add name v t.groups; + t.groups <- Key_map.set t.groups key v; v ;; - (* Add [impl] to its conflict groups, if any. *) - let process t impl_var impl = - Input.Impl.conflict_class impl - |> List.iter ~f:(fun name -> - let impls = var t name in - impls := impl_var :: !impls) + (* Add [impl] to its conflict groups, if any. + [role] is used to extract the platform for the group key. + Virtual roles never carry conflict classes (see [Input.Impl.conflict_class] + which returns [] for VirtualImpl), so there's nothing to do for them. *) + let process t role impl_var impl = + match role with + | Input.Virtual _ -> () + | Input.Real (_, platform) -> + Input.Impl.conflict_class impl + |> List.iter ~f:(fun name -> + let impls = var t (name, platform) in + impls := impl_var :: !impls) ;; (* Call this at the end to add the final clause with all discovered groups. [t] must not be used after this. *) + let seal t = + Key_map.iter t.groups ~f:(fun impls -> + match !impls with + | _ :: _ :: _ -> + let (_ : Sat.at_most_one_clause) = Sat.at_most_one !impls in + () + | _ -> ()) + ;; + end + + module Cross_platform_version = struct + (* Implements @art-w's cross-platform version equality constraint from + https://github.com/ocaml/dune/issues/13647. For each (package_name, + version) appearing as an impl on any platform, introduce a "somewhere" + SAT variable that is true iff some platform selected [package_name] at + [version]. Two kinds of clauses are added: + - For each per-platform impl: [impl_var implies somewhere]. + - At-most-one across the somewhere-vars of each [name]. + Together these force every platform that selects [name] to select the + same version, while still permitting platforms to omit a package + entirely (e.g. unix-only packages on Windows). *) + + type t = + { sat : Sat.t + ; enabled : bool + ; mutable somewhere_vars : Sat.lit OpamPackage.Map.t + ; (* For each package name, the list of somewhere-vars across its + versions. Used at seal time to add the at-most-one clauses. *) + mutable per_name : Sat.lit list ref OpamPackage.Name.Map.t + } + + let create sat ~enabled = + { sat + ; enabled + ; somewhere_vars = OpamPackage.Map.empty + ; per_name = OpamPackage.Name.Map.empty + } + ;; + + let somewhere_var t package = + let name = OpamPackage.name package in + match OpamPackage.Map.find_opt package t.somewhere_vars with + | Some v -> v + | None -> + (* The user data attached to this SAT variable is opaque to the SAT + engine — we use Dummy since the variable doesn't represent a real + package selection. *) + let v = Sat.add_variable t.sat Input.Dummy in + t.somewhere_vars <- OpamPackage.Map.add package v t.somewhere_vars; + let bucket = + match OpamPackage.Name.Map.find_opt name t.per_name with + | Some b -> b + | None -> + let b = ref [] in + t.per_name <- OpamPackage.Name.Map.add name b t.per_name; + b + in + bucket := v :: !bucket; + v + ;; + + (* Return one canonical selection literal per package version. With + multiple platforms this is the shared [somewhere] variable used for + version equality. With one platform the implementation variable is + already canonical, so no extra encoding is needed. *) + let process t impl_var (impl : Input.impl) = + match impl with + | RealImpl real_impl -> + let pkg = real_impl.pkg in + let selection_var = + if t.enabled + then ( + let som = somewhere_var t pkg in + Sat.implies t.sat impl_var [ som ] ~reason:"cross-platform version equality"; + som) + else impl_var + in + Some (pkg, selection_var) + | VirtualImpl _ | Reject _ | Dummy -> None + ;; + + (* Add at-most-one over the somewhere-vars per package name. Call after + all impls have been processed. *) let seal t = OpamPackage.Name.Map.iter - (fun _ impls -> - match !impls with - | _ :: _ :: _ -> - let (_ : Sat.at_most_one_clause) = Sat.at_most_one !impls in - () - | _ -> ()) - t.groups + (fun _name bucket -> + match !bucket with + | [] | [ _ ] -> () + | vars -> ignore (Sat.at_most_one vars : Sat.at_most_one_clause)) + t.per_name ;; end (* Starting from [root_req], explore all the feeds and implementations we might need, adding all of them to [sat_problem]. *) - let build_problem context root_req sat ~max_avoids ~dummy_impl = + let build_problem + context + root_req + sat + ~enforce_cross_platform_versions + ~max_avoids + ~dummy_impl + = (* For each (iface, source) we have a list of implementations. *) let impl_cache = Fiber.Cache.create (module Input.Role) in let conflict_classes = Conflict_classes.create () in - let avoids = ref [] in + let cross_platform_versions = + Cross_platform_version.create sat ~enabled:enforce_cross_platform_versions + in + let avoids = ref OpamPackage.Map.empty in let+ () = let rec lookup_impl expand_deps role = let impls = ref [] in @@ -808,8 +1062,14 @@ module Solver = struct in let+ () = Fiber.parallel_iter !impls ~f:(fun { var = impl_var; impl } -> - Conflict_classes.process conflict_classes impl_var impl; - if Input.Impl.avoid impl then avoids := impl_var :: !avoids; + Conflict_classes.process conflict_classes role impl_var impl; + let version_selection = + Cross_platform_version.process cross_platform_versions impl_var impl + in + (match version_selection with + | Some (key, selection_var) when Input.Impl.avoid impl -> + avoids := OpamPackage.Map.add key selection_var !avoids + | Some _ | None -> ()); match expand_deps with | `No_expand -> Fiber.return () | `Expand_and_collect_conflicts deferred -> @@ -881,7 +1141,8 @@ module Solver = struct (* All impl_candidates have now been added, so snapshot the cache. *) in Conflict_classes.seal conflict_classes; - (match max_avoids, !avoids with + Cross_platform_version.seal cross_platform_versions; + (match max_avoids, OpamPackage.Map.bindings !avoids |> List.map ~f:snd with | None, _ | _, [] -> () | Some max_avoids, avoids -> let _ : Sat.at_most_clause = Sat.at_most max_avoids avoids in @@ -902,7 +1163,13 @@ module Solver = struct to minimize the number of those bad packages, but still find a solution when they are unavoidable. @return None if the solve fails (only happens if [closest_match] is false). *) - let do_solve context ~closest_match ~max_avoids root_req = + let do_solve + context + ~closest_match + ~enforce_cross_platform_versions + ~max_avoids + root_req + = (* The basic plan is this: 1. Scan the root interface and all dependencies recursively, building up a SAT problem. 2. Solve the SAT problem. Whenever there are multiple options, try the most preferred one first. @@ -916,7 +1183,13 @@ module Solver = struct let sat = Sat.create () in let* impl_clauses = let dummy_impl = if closest_match then Some Input.Dummy else None in - build_problem context root_req sat ~max_avoids ~dummy_impl + build_problem + context + root_req + sat + ~enforce_cross_platform_versions + ~max_avoids + ~dummy_impl in let+ impl_clauses = Fiber.Cache.to_table impl_clauses in (* Run the solve *) @@ -972,21 +1245,50 @@ module Solver = struct ;; let do_solve context ~closest_match root_req = - do_solve context ~closest_match ~max_avoids:(Some 0) root_req + let enforce_cross_platform_versions = + match context.Context.platforms with + | [] | [ _ ] -> false + | _ :: _ :: _ -> true + in + do_solve + context + ~closest_match + ~enforce_cross_platform_versions + ~max_avoids:(Some 0) + root_req >>= function | Some sels -> (* Found a good solution, using no packages flagged as [avoid-version] *) Fiber.return (Some sels) | None -> - do_solve context ~closest_match ~max_avoids:None root_req + do_solve + context + ~closest_match + ~enforce_cross_platform_versions + ~max_avoids:None + root_req >>= (function | None -> (* No solution even when allowing [avoid-version] *) Fiber.return None | Some sels -> let nb_avoids sels = - Input.Role.Map.fold sels ~init:0 ~f:(fun sel count -> - if Input.Impl.avoid sel.impl then count + 1 else count) + Input.Role.Map.fold sels ~init:[] ~f:(fun sel packages -> + if Input.Impl.avoid sel.impl + then ( + match Input.Impl.version sel.impl with + | Some package -> package :: packages + | None -> + Code_error.raise + "avoid-version implementation has no package version" + [ ( "implementation" + , Dyn.string + (Format.asprintf "%a" Pp.to_fmt (Input.Impl.pp sel.impl)) ) + ]) + else packages) + |> List.sort_uniq ~compare:(fun a b -> + Ordering.of_int (OpamPackage.compare a b)) + |> List.length in let upper = nb_avoids sels in (* There exists a solution, using at least 1 and at most [upper] @@ -997,7 +1299,12 @@ module Solver = struct then Fiber.return (Some best_sel) else ( let mid = (lower + upper) / 2 in - do_solve context ~closest_match ~max_avoids:(Some mid) root_req + do_solve + context + ~closest_match + ~enforce_cross_platform_versions + ~max_avoids:(Some mid) + root_req >>= function | None -> search (mid + 1) upper best_sel | Some sels -> @@ -1045,6 +1352,7 @@ module Solver = struct | `DepFailsRestriction of Input.dependency * Input.Restriction.t | `ClassConflict of Input.Role.t * OpamPackage.Name.t | `ConflictsRole of Input.Role.t + | `Cross_platform_version_conflict of Input.Role.t * Input.impl | `DiagnosticsFailure of User_message.Style.t Pp.t ] (* Why a particular implementation was rejected. This could be because the model rejected it, @@ -1194,6 +1502,18 @@ module Solver = struct ++ Input.Role.pp other_role) | `ConflictsRole other_role -> Pp.hovbox (Pp.text "Conflicts with " ++ Input.Role.pp other_role) + | `Cross_platform_version_conflict (other_role, other_impl) -> + let platform = + match Input.Role.platform other_role with + | None -> + Code_error.raise "Virtual role has a cross-platform version conflict" [] + | Some platform -> platform + in + Pp.hovbox + (Pp.text "Version differs from " + ++ Input.pp_impl_long other_impl + ++ Pp.text " selected on " + ++ Solver_env.pp_oneline platform) | `DiagnosticsFailure msg -> Pp.hovbox (Pp.text "Reason for rejection unknown: " ++ msg) ;; @@ -1254,10 +1574,16 @@ module Solver = struct ;; (* Format a textual description of this component's report. *) - let pp ~verbose t = + let pp ~verbose ~platform t = + let platform_suffix = + match platform with + | None -> Pp.nop + | Some platform -> Pp.text " on " ++ Solver_env.pp_oneline platform + in Pp.vbox ~indent:2 - (Pp.hovbox (Input.pp_role t.role ++ Pp.text " -> " ++ pp_outcome t) + (Pp.hovbox + (Input.pp_role t.role ++ Pp.text " -> " ++ pp_outcome t ++ platform_suffix) ++ pp_notes t ++ pp_candidates ~verbose t) ;; @@ -1327,30 +1653,84 @@ module Solver = struct |> Option.iter ~f:(Component.apply_user_restriction component)) ;; + (* Check if two roles refer to the same package (ignoring the platform). + Used for conflict class checking - same package on different platforms + should not be considered in conflict with itself. *) + let same_package_name (role1 : Input.Role.t) (role2 : Input.Role.t) = + match role1, role2 with + | Real (name1, _), Real (name2, _) -> OpamPackage.Name.equal name1 name2 + | Virtual (id1, _), Virtual (id2, _) -> Input.Virtual_id.equal id1 id2 + | Real _, Virtual _ | Virtual _, Real _ -> false + ;; + (** For each selected implementation with a conflict class, reject all candidates - with the same class. *) + with the same class on the same platform. *) let check_conflict_classes report = let classes = Input.Role.Map.foldi report ~init:OpamPackage.Name.Map.empty ~f:(fun role component acc -> - match Component.selected_impl component with - | None -> acc - | Some impl -> + match Component.selected_impl component, Input.Role.platform role with + | None, _ | _, None -> acc + | Some impl, Some platform -> Input.Impl.conflict_class impl - |> List.fold_left ~init:acc ~f:(fun acc x -> - OpamPackage.Name.Map.add x role acc)) + |> List.fold_left ~init:acc ~f:(fun acc conflict_class -> + let platforms = + OpamPackage.Name.Map.find_opt conflict_class acc + |> Option.value ~default:Solver_env.Map.empty + in + OpamPackage.Name.Map.add + conflict_class + (Solver_env.Map.set platforms platform role) + acc)) in Input.Role.Map.iteri report ~f:(fun role component -> - Component.filter_impls component (fun impl -> - Input.Impl.conflict_class impl - |> List.find_map ~f:(fun cl -> - match OpamPackage.Name.Map.find_opt cl classes with - | Some other_role - when not (Ordering.is_eq (Input.Role.compare role other_role)) -> - Some (`ClassConflict (other_role, cl)) - | _ -> None))) + match Input.Role.platform role with + | None -> () + | Some platform -> + Component.filter_impls component (fun impl -> + Input.Impl.conflict_class impl + |> List.find_map ~f:(fun conflict_class -> + OpamPackage.Name.Map.find_opt conflict_class classes + |> Option.bind ~f:(fun platforms -> + match Solver_env.Map.find platforms platform with + | Some other_role when not (same_package_name role other_role) -> + Some (`ClassConflict (other_role, conflict_class)) + | _ -> None)))) + ;; + + (** Reject candidates whose version differs from the version selected for + the same package on another platform. *) + let check_cross_platform_versions report = + let selected_by_package = + Input.Role.Map.foldi + report + ~init:OpamPackage.Name.Map.empty + ~f:(fun role component acc -> + match role, Component.selected_impl component with + | Input.Real (name, _), Some impl -> + let selected = + OpamPackage.Name.Map.find_opt name acc |> Option.value ~default:[] + in + OpamPackage.Name.Map.add name ((role, impl) :: selected) acc + | (Input.Real _ | Input.Virtual _), None | Input.Virtual _, Some _ -> acc) + in + Input.Role.Map.iteri report ~f:(fun role component -> + match role with + | Input.Virtual _ -> () + | Input.Real (name, _) -> + let selected = + OpamPackage.Name.Map.find_opt name selected_by_package + |> Option.value ~default:[] + in + Component.filter_impls component (fun impl -> + List.find_map selected ~f:(fun (other_role, other_impl) -> + if + Input.Role.compare role other_role <> Eq + && Input.Impl.compare_version impl other_impl <> Eq + then Some (`Cross_platform_version_conflict (other_role, other_impl)) + else None))) ;; let of_result context impls = @@ -1380,6 +1760,7 @@ module Solver = struct in examine_extra_restrictions report context; check_conflict_classes report; + check_cross_platform_versions report; Input.Role.Map.iteri ~f:(examine_selection report) report; Input.Role.Map.iteri ~f:(fun _ c -> Component.finalise c) report; report @@ -1387,17 +1768,23 @@ module Solver = struct end let solve context pkgs = + let platforms = context.Context.platforms in let req = - match pkgs with - | [ pkg ] -> Input.Real pkg - | pkgs -> - let impl : Input.Impl.t = - let depends = + match pkgs, platforms with + | [ pkg ], [ platform ] -> + (* Single package, single platform - use Real directly *) + Input.Real (pkg, platform) + | _ -> + (* Multiple packages or platforms - create virtual root *) + let depends = + List.concat_map platforms ~f:(fun platform -> List.map pkgs ~f:(fun name -> - { Input.drole = Real name; importance = Ensure; restrictions = [] }) - in - VirtualImpl (Input.Rank.bottom, depends) + { Input.drole = Real (name, platform) + ; importance = Ensure + ; restrictions = [] + })) in + let impl : Input.Impl.t = VirtualImpl (Input.Rank.bottom, depends) in Input.virtual_role [ impl ] in Solver.do_solve context ~closest_match:false req @@ -1406,7 +1793,49 @@ module Solver = struct | None -> Error req ;; - let pp_rolemap ~verbose reasons = + let role_name = function + | Input.Virtual _ -> None + | Input.Real (name, _) -> Some name + ;; + + let deduplicate_roles_by_name = filter_dedup_by_name ~key:role_name + + (* Deduplicate impls by package name, keeping one representative per package. + For VirtualImpls, skip them if all their deps point to packages we've already seen. *) + let deduplicate_impls_by_name impls = + let seen = ref OpamPackage.Name.Set.empty in + List.filter impls ~f:(fun impl -> + match impl with + | Input.VirtualImpl (_, deps) -> + (* Check if this VirtualImpl has any deps we haven't seen yet *) + let has_new_deps = + List.exists deps ~f:(fun (d : Input.dependency) -> + match d.drole with + | Input.Virtual _ -> true + | Input.Real (name, _) -> not (OpamPackage.Name.Set.mem name !seen)) + in + if has_new_deps + then ( + (* Add all dep names to seen *) + List.iter deps ~f:(fun (d : Input.dependency) -> + match d.drole with + | Input.Virtual _ -> () + | Input.Real (name, _) -> seen := OpamPackage.Name.Set.add name !seen); + true) + else false + | _ -> + (match Input.Impl.version impl with + | None -> true + | Some pkg -> + let name = OpamPackage.name pkg in + if OpamPackage.Name.Set.mem name !seen + then false + else ( + seen := OpamPackage.Name.Set.add name !seen; + true))) + ;; + + let pp_rolemap ~verbose ~total_platforms reasons = let good, bad, unknown = Input.Role.Map.to_list reasons |> List.partition_three ~f:(fun (role, component) -> @@ -1417,20 +1846,86 @@ module Solver = struct | _, `No_candidates -> `Right role | _, _ -> `Middle component)) in - let pp_bad = Diagnostics.Component.pp ~verbose in - let pp_unknown role = Pp.box (Input.Role.pp role) in - match unknown with - | [] -> + let good = deduplicate_impls_by_name good in + let good_names = + List.fold_left good ~init:OpamPackage.Name.Set.empty ~f:(fun names impl -> + match Input.Impl.version impl with + | None -> names + | Some pkg -> OpamPackage.Name.Set.add (OpamPackage.name pkg) names) + in + let component_key component = + Format.asprintf + "%a" + Pp.to_fmt + (Diagnostics.Component.pp ~verbose ~platform:None component) + in + let bad_with_keys = + List.map bad ~f:(fun component -> component, component_key component) + in + let bad_summaries = + List.fold_left + bad_with_keys + ~init:OpamPackage.Name.Map.empty + ~f:(fun summaries (component, key) -> + match (component : Diagnostics.Component.t).role with + | Input.Virtual _ -> summaries + | Input.Real (name, _) -> + let summary = + match OpamPackage.Name.Map.find_opt name summaries with + | None -> 1, key, false + | Some (count, first_key, varied) -> + count + 1, first_key, varied || not (String.equal first_key key) + in + OpamPackage.Name.Map.add name summary summaries) + in + let show_platform_for name = + let count, _, varied = + OpamPackage.Name.Map.find_opt name bad_summaries |> Option.value_exn + in + count < total_platforms || varied || OpamPackage.Name.Set.mem name good_names + in + let seen_names = ref OpamPackage.Name.Set.empty in + let seen_virtual_keys = ref String.Set.empty in + let bad = + List.filter_map bad_with_keys ~f:(fun (component, key) -> + match (component : Diagnostics.Component.t).role with + | Input.Virtual _ -> + if String.Set.mem !seen_virtual_keys key + then None + else ( + seen_virtual_keys := String.Set.add !seen_virtual_keys key; + Some component) + | Input.Real (name, _) -> + if show_platform_for name + then Some component + else if OpamPackage.Name.Set.mem name !seen_names + then None + else ( + seen_names := OpamPackage.Name.Set.add name !seen_names; + Some component)) + in + let unknown = deduplicate_roles_by_name unknown in + let pp_bad (component : Diagnostics.Component.t) = + let platform = + match component.role with + | Input.Virtual _ -> None + | Input.Real (name, platform) -> Option.some_if (show_platform_for name) platform + in + Diagnostics.Component.pp ~verbose ~platform component + in + let known = Pp.paragraph "Selected candidates: " ++ Pp.hovbox (Pp.concat_map ~sep:Pp.space good ~f:Input.pp_impl) ++ Pp.cut ++ Pp.enumerate bad ~f:pp_bad + in + match unknown with + | [] -> known | _ -> - (* In case of unknown packages, no need to print the full diagnostic - list, the problem is simpler. *) Pp.hovbox (Pp.text "The following packages couldn't be found: " - ++ Pp.concat_map ~sep:Pp.space unknown ~f:pp_unknown) + ++ Pp.concat_map ~sep:Pp.space unknown ~f:(fun role -> + Pp.box (Input.Role.pp role))) ;; let diagnostics_rolemap context req = @@ -1439,16 +1934,64 @@ module Solver = struct >>= Diagnostics.of_result context ;; - let diagnostics ?(verbose = false) context req = - let+ diag = diagnostics_rolemap context req in + let diagnostics ?(verbose = false) context solve_error = + let+ diag = diagnostics_rolemap context solve_error in + let total_platforms = List.length context.Context.platforms in Pp.paragraph "Couldn't solve the package dependency formula." ++ Pp.cut - ++ Pp.vbox (pp_rolemap ~verbose diag) + ++ Pp.vbox (pp_rolemap ~verbose ~total_platforms diag) ;; - let packages_of_result sels = - Input.Role.Map.values sels - |> List.filter_map ~f:(fun (sel : Solver.selection) -> Input.Impl.version sel.impl) + (* Extract one package per name and the selected package versions for each + platform. Checking version equality here keeps the SAT invariant close to + the solver result that establishes it. *) + let packages_by_platform ~platforms sels = + let packages_by_platform = + List.fold_left platforms ~init:Solver_env.Map.empty ~f:(fun acc platform -> + Solver_env.Map.set acc platform Package_name.Map.empty) + in + Input.Role.Map.foldi + sels + ~init:(OpamPackage.Name.Map.empty, packages_by_platform) + ~f:(fun role (sel : Solver.selection) (packages, packages_by_platform) -> + match role with + | Input.Virtual _ -> packages, packages_by_platform + | Input.Real (opam_name, platform) -> + (match Input.Impl.version sel.impl with + | None -> packages, packages_by_platform + | Some package -> + let name = Package_name.of_opam_package_name opam_name in + let version = + OpamPackage.version package |> Package_version.of_opam_package_version + in + let packages = + match OpamPackage.Name.Map.find_opt opam_name packages with + | None -> OpamPackage.Name.Map.add opam_name package packages + | Some existing -> + let existing_version = + OpamPackage.version existing |> Package_version.of_opam_package_version + in + if not (Package_version.equal version existing_version) + then + Code_error.raise + "Cross-platform version equality SAT constraint failed: solver \ + selected multiple versions of the same package" + [ "name", Package_name.to_dyn name + ; "version_a", Package_version.to_dyn existing_version + ; "version_b", Package_version.to_dyn version + ]; + packages + in + let platform_packages = + Solver_env.Map.find packages_by_platform platform |> Option.value_exn + in + ( packages + , Solver_env.Map.set + packages_by_platform + platform + (Package_name.Map.set platform_packages name version) ))) + |> fun (packages, packages_by_platform) -> + OpamPackage.Name.Map.bindings packages |> List.map ~f:snd, packages_by_platform ;; end @@ -1469,7 +2012,11 @@ let solve_package_list packages ~context = (* CR-rgrinberg: this needs to be handled right *) Error (`Exn exn)) >>= function - | Ok packages -> Fiber.return @@ Ok (Solver.packages_of_result packages) + | Ok sels -> + let packages, packages_by_platform = + Solver.packages_by_platform ~platforms:context.Context.platforms sels + in + Fiber.return @@ Ok (packages, packages_by_platform) | Error (`Diagnostics e) -> let+ diagnostics = Solver.diagnostics context e in Error (`Solve_error diagnostics) @@ -1495,28 +2042,6 @@ 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.union a.files b.files ~f:(fun _ a b -> - Some - (Package_version.Map.union a b ~f:(fun _ a b -> - (* The package is present in both solutions at the same version. 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))) - 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 = @@ -1614,10 +2139,7 @@ let reject_unreachable_packages = in let depopts = List.filter_map pkg.depopts ~f:(fun (d : Package_dependency.t) -> - Option.some_if - (Package_name.Map.mem local_packages d.name - || Package_name.Map.mem pkgs_by_name d.name) - d.name) + Option.some_if (Package_name.Map.mem pkgs_by_version d.name) d.name) in deps @ depopts) in @@ -1716,8 +2238,25 @@ let resolve_opam_packages opam_packages_to_lock candidates_cache = name, opam_package, resolved_package) ;; +let deduplicate_platform_overlays platform_overlays = + List.rev + (List.fold_left platform_overlays ~init:[] ~f:(fun acc overlay -> + if List.exists acc ~f:(Solver_env.equal overlay) then acc else overlay :: acc)) +;; + +(* Split [solver_env] into a portable base env (with platform-specific + variables unset) and the distinct platform overlays to solve for. *) +let base_solver_env_and_platforms solver_env ~solve_for_platforms ~portable_lock_dir = + if portable_lock_dir + then + ( Solver_env.unset_multi solver_env Dune_lang.Package_variable_name.platform_specific + , deduplicate_platform_overlays solve_for_platforms ) + else solver_env, [ Solver_env.empty ] +;; + let solve_lock_dir solver_env + ~platform_overlays version_preference repos ~local_packages @@ -1726,211 +2265,285 @@ let solve_lock_dir ~selected_depopts ~portable_lock_dir = - match Package_name.Map.add pinned_packages Dune_dep.name Resolved_package.dune with - | Error p -> - let loc = Resolved_package.loc p in - let message = - User_error.make - ~loc - [ Pp.text - "Dune cannot be pinned. The currently running version is the only one that \ - may be used" - ] - in - Fiber.return (Error (`Manifest_error message)) - | Ok pinned_packages -> - let pinned_package_names = Package_name.Set.of_keys pinned_packages in - let stats_updater = Solver_stats.Updater.init () in - let context = - let rec context = - lazy - (Context.create - ~pinned_packages - ~solver_env - ~repos - ~version_preference - ~local_packages:local_packages' - ~stats_updater - ~constraints) - and local_packages' = - lazy - (Package_name.Map.map local_packages ~f:(fun local -> - let opam_file = Local_package.For_solver.to_opam_file local in - let version = - Option.value - opam_file.version - ~default:Context.local_package_default_version - in - let deps = - lazy - (let opam_package = - OpamPackage.create (OpamFile.OPAM.name opam_file) version - in - Context.filter_deps (Lazy.force context) opam_package) - in - let depends = lazy (Lazy.force deps (OpamFile.OPAM.depends opam_file)) in - let conflicts = lazy (Lazy.force deps (OpamFile.OPAM.conflicts opam_file)) in - { Context.opam_file; version; depends; conflicts; name = local.name })) - in - Lazy.force context - in - Package_name.Map.keys local_packages @ selected_depopts - |> List.map ~f:Package_name.to_opam_package_name - |> solve_package_list ~context - >>= (function - | Error _ as e -> Fiber.return e - | Ok solution -> - let is_dune name = Package_name.equal Dune_dep.name name in - (* don't include local packages or dune in the lock dir *) - let opam_packages_to_lock = - let is_local_package = Package_name.Map.mem local_packages in - List.filter solution ~f:(fun package -> - let name = OpamPackage.name package |> Package_name.of_opam_package_name in - (not (is_local_package name)) && not (is_dune name)) + match platform_overlays with + | [] -> Code_error.raise "solve_lock_dir called with empty platform_overlays" [] + | _ -> + (match Package_name.Map.add pinned_packages Dune_dep.name Resolved_package.dune with + | Error p -> + let loc = Resolved_package.loc p in + let message = + User_error.make + ~loc + [ Pp.text + "Dune cannot be pinned. The currently running version is the only one \ + that may be used" + ] in - let* candidates_cache = Fiber.Cache.to_table context.candidates_cache in - let resolve_package name version = - (Table.find_exn candidates_cache name).resolved - |> OpamPackage.Version.Map.find version + Fiber.return (Error (`Manifest_error message)) + | Ok pinned_packages -> + let pinned_package_names = Package_name.Set.of_keys pinned_packages in + let stats_updater = Solver_stats.Updater.init () in + (* The platform envs themselves identify the platforms: every role and + every per-platform selection is keyed by the platform's own + (platform-specific) env. *) + let platforms = platform_overlays in + let platform_envs = + List.map platform_overlays ~f:(fun platform -> + platform, Solver_env.extend solver_env platform) in - let* pkgs_by_name = - let+ pkgs = - let version_by_package_name = - Package_name.Map.of_list_map_exn - solution - ~f:(fun (package : OpamPackage.t) -> - ( Package_name.of_opam_package_name (OpamPackage.name package) - , Package_version.of_opam_package_version (OpamPackage.version package) )) - in - let+ resolved_pkgs = - resolve_opam_packages opam_packages_to_lock candidates_cache - in - List.map resolved_pkgs ~f:(fun (name, opam_package, resolved_package) -> - Lock_pkg.opam_package_to_lock_file_pkg - [ solver_env ] - stats_updater - version_by_package_name - opam_package - ~pinned:(Package_name.Set.mem pinned_package_names name) - resolved_package - ~portable_lock_dir) - |> Result.List.all + let full_solver_envs = List.map platform_envs ~f:snd in + let context = + let local_packages' = + lazy + (Package_name.Map.map local_packages ~f:(fun local -> + let opam_file = Local_package.For_solver.to_opam_file local in + let version = + Option.value + opam_file.version + ~default:Context.local_package_default_version + in + let depends = OpamFile.OPAM.depends opam_file in + let conflicts = OpamFile.OPAM.conflicts opam_file in + { Context.opam_file + ; version + ; depends + ; conflicts + ; name = local.name + ; filtered_formulas_by_platform = Table.create (module Solver_env) 1 + })) in - Result.map pkgs ~f:(fun pkgs -> - match Package_name.Map.of_list_map pkgs ~f:(fun pkg -> pkg.info.name, pkg) with - | Error (name, _pkg1, _pkg2) -> - Code_error.raise - "Solver selected multiple versions for the same package" - [ "name", Package_name.to_dyn name ] - | Ok pkgs_by_name -> - let reachable = - reject_unreachable_packages - solver_env - ~dune_version: - (Package_version.of_opam_package_version context.dune_version) - ~local_packages - ~pkgs_by_name - in - Package_name.Map.filteri pkgs_by_name ~f:(fun name _ -> - Package_name.Set.mem reachable name)) + Context.create + ~pinned_packages + ~solver_env + ~platforms + ~repos + ~version_preference + ~local_packages:local_packages' + ~stats_updater + ~constraints in - let ocaml = - let open Result.O in - let* pkgs_by_name = pkgs_by_name in - (* This doesn't allow the compiler to live in the source tree. Oh + Package_name.Map.keys local_packages @ selected_depopts + |> List.map ~f:Package_name.to_opam_package_name + |> solve_package_list ~context + >>= (function + | Error _ as e -> Fiber.return e + | Ok (solution, packages_by_platform) -> + (* The full solver envs and selected package versions for the + platforms on which a package is selected. *) + let solver_envs_for_package name = + List.filter_map platform_envs ~f:(fun (platform, full_solver_env) -> + let packages = + Solver_env.Map.find packages_by_platform platform |> Option.value_exn + in + Option.some_if + (Package_name.Map.mem packages name) + (full_solver_env, packages)) + in + let is_dune name = Package_name.equal Dune_dep.name name in + (* Don't include local packages or dune in the lock dir. *) + let opam_packages_to_lock = + let is_local_package = Package_name.Map.mem local_packages in + List.filter solution ~f:(fun package -> + let name = OpamPackage.name package |> Package_name.of_opam_package_name in + (not (is_local_package name)) && not (is_dune name)) + in + let* candidates_cache = Fiber.Cache.to_table context.candidates_cache in + let resolve_package name version = + (Table.find_exn candidates_cache name).resolved + |> OpamPackage.Version.Map.find version + in + let* pkgs_by_name = + let+ package_branches = + let+ resolved_pkgs = + resolve_opam_packages opam_packages_to_lock candidates_cache + in + (* Evaluate each package separately on every platform where the + solver selected it. Reachability is computed before these + branches are merged. *) + List.map resolved_pkgs ~f:(fun (name, opam_package, resolved_package) -> + let package_solver_envs = solver_envs_for_package name in + Lock_pkg.opam_package_to_lock_file_pkg_branches + package_solver_envs + stats_updater + opam_package + ~pinned:(Package_name.Set.mem pinned_package_names name) + resolved_package + ~portable_lock_dir + |> Result.map ~f:(fun branches -> name, branches)) + |> Result.List.all + in + Result.map package_branches ~f:(fun package_branches -> + let branches_by_platform = + List.fold_left + platform_envs + ~init:Solver_env.Map.empty + ~f:(fun acc (_, solver_env) -> + Solver_env.Map.set acc solver_env Package_name.Map.empty) + in + let branches_by_platform = + List.fold_left + package_branches + ~init:branches_by_platform + ~f:(fun branches_by_platform (name, branches) -> + List.fold_left + branches + ~init:branches_by_platform + ~f:(fun branches_by_platform (solver_env, package) -> + let packages = + Solver_env.Map.find branches_by_platform solver_env + |> Option.value_exn + in + if Package_name.Map.mem packages name + then + Code_error.raise + "Solver selected multiple versions for the same package" + [ "name", Package_name.to_dyn name ]; + Solver_env.Map.set + branches_by_platform + solver_env + (Package_name.Map.set packages name package))) + in + (* Drop unreachable platform branches before merging package + metadata. In particular, this prevents a dependency pruned on + one platform from surviving because the package is reachable + on another platform. *) + List.fold_left + platform_envs + ~init:Package_name.Map.empty + ~f:(fun merged_packages (_, solver_env) -> + let packages = + Solver_env.Map.find branches_by_platform solver_env + |> Option.value_exn + in + let reachable = + reject_unreachable_packages + solver_env + ~dune_version: + (Package_version.of_opam_package_version context.dune_version) + ~local_packages + ~pkgs_by_name:packages + in + Package_name.Map.foldi + packages + ~init:merged_packages + ~f:(fun name package merged_packages -> + if not (Package_name.Set.mem reachable name) + then merged_packages + else + Package_name.Map.update merged_packages name ~f:(function + | None -> Some package + | Some previous -> + Some (Lock_dir.Pkg.merge_conditionals previous package))))) + in + let ocaml = + let open Result.O in + let* pkgs_by_name = pkgs_by_name in + (* This doesn't allow the compiler to live in the source tree. Oh well, it's not possible now anyway. *) - match - Package_name.Map.filter_map pkgs_by_name ~f:(fun (pkg : Lock_dir.Pkg.t) -> - match - let version = Package_version.to_opam_package_version pkg.info.version in - resolve_package pkg.info.name version |> package_kind - with - | `Compiler -> Some pkg.info.name - | `Non_compiler -> None) - |> Package_name.Map.values - with - | [] -> Ok None - | [ x ] -> Ok (Some (Loc.none, x)) - | _ -> - Error - (User_error.make - (* CR-someday rgrinberg: needs to include locations *) - [ Pp.text "multiple compilers selected" ] - ~hints:[ Pp.text "add a conflict" ]) - in - let lock_dir = - let open Result.O in - let* pkgs_by_name = pkgs_by_name - and* ocaml = ocaml in - let+ () = - Package_name.Map.values pkgs_by_name - |> Result.List.map ~f:(fun { Lock_dir.Pkg.depends; info = { name; _ }; _ } -> - match - Lock_dir.Conditional_choice.choose_for_platform - depends - ~platform:solver_env - with - | None -> Ok () - | Some depends -> - Result.List.map - depends - ~f:(fun { Lock_dir.Dependency.name = dep_name; loc } -> - match - (not (is_dune dep_name)) - && Package_name.Map.mem local_packages dep_name - with - | false -> Ok () - | true -> - Error - (User_error.make - ~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) - ])) - |> Result.map ~f:(fun (_ : unit list) -> ())) - |> Result.map ~f:(fun (_ : unit list) -> ()) - in - let expanded_solver_variable_bindings = - let stats = Solver_stats.Updater.snapshot stats_updater in - Solver_stats.Expanded_variable_bindings.of_variable_set - stats.expanded_variables - solver_env - in - Lock_dir.create_latest_version - pkgs_by_name - ~local_packages:(Package_name.Map.values local_packages) - ~ocaml - ~repos:(Some repos) - ~expanded_solver_variable_bindings - ~solved_for_platforms:[ solver_env ] - ~portable_lock_dir - in - let+ files = - match pkgs_by_name with - | Error e -> Fiber.return (Error e) - | Ok pkgs_by_name -> - let+ files = - Package_name.Map.to_list_map - pkgs_by_name - ~f:(fun name (package : Lock_dir.Pkg.t) -> - Package_version.to_opam_package_version package.info.version - |> resolve_package name) - |> files - in - files - in - (match Result.both lock_dir files with - | Error e -> Error (`Manifest_error e) - | Ok (lock_dir, files) -> - Ok - { Solver_result.lock_dir - ; files - ; pinned_packages = pinned_package_names - ; num_expanded_packages = Context.count_expanded_packages context - })) + match + Package_name.Map.filter_map pkgs_by_name ~f:(fun (pkg : Lock_dir.Pkg.t) -> + match + let version = + Package_version.to_opam_package_version pkg.info.version + in + resolve_package pkg.info.name version |> package_kind + with + | `Compiler -> Some pkg.info.name + | `Non_compiler -> None) + |> Package_name.Map.values + with + | [] -> Ok None + | [ x ] -> Ok (Some (Loc.none, x)) + | _ -> + Error + (User_error.make + (* CR-someday rgrinberg: needs to include locations *) + [ Pp.text "multiple compilers selected" ] + ~hints:[ Pp.text "add a conflict" ]) + in + let lock_dir = + let open Result.O in + let* pkgs_by_name = pkgs_by_name + and* ocaml = ocaml in + let+ () = + Package_name.Map.values pkgs_by_name + |> Result.List.map + ~f:(fun { Lock_dir.Pkg.depends; info = { name; _ }; _ } -> + (* A repository package must not evade validation by + depending on a workspace package only on a + non-primary platform, so validate the dependency + choices for every platform where the package is + selected. *) + let platform_envs = solver_envs_for_package name in + Result.List.map platform_envs ~f:(fun (platform_env, _) -> + match + Lock_dir.Conditional_choice.choose_for_platform + depends + ~platform:platform_env + with + | None -> Ok () + | Some depends -> + Result.List.map + depends + ~f:(fun { Lock_dir.Dependency.name = dep_name; loc } -> + match + (not (is_dune dep_name)) + && Package_name.Map.mem local_packages dep_name + with + | false -> Ok () + | true -> + Error + (User_error.make + ~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) + ])) + |> Result.map ~f:(fun (_ : unit list) -> ())) + |> Result.map ~f:(fun (_ : unit list) -> ())) + |> Result.map ~f:(fun (_ : unit list) -> ()) + in + let expanded_solver_variable_bindings = + let stats = Solver_stats.Updater.snapshot stats_updater in + Solver_stats.Expanded_variable_bindings.of_variable_set + stats.expanded_variables + solver_env + in + Lock_dir.create_latest_version + pkgs_by_name + ~local_packages:(Package_name.Map.values local_packages) + ~ocaml + ~repos:(Some repos) + ~expanded_solver_variable_bindings + ~solved_for_platforms:full_solver_envs + ~portable_lock_dir + in + let+ files = + match pkgs_by_name with + | Error e -> Fiber.return (Error e) + | Ok pkgs_by_name -> + let+ files = + Package_name.Map.to_list_map + pkgs_by_name + ~f:(fun name (package : Lock_dir.Pkg.t) -> + Package_version.to_opam_package_version package.info.version + |> resolve_package name) + |> files + in + files + in + (match Result.both lock_dir files with + | Error e -> Error (`Manifest_error e) + | Ok (lock_dir, files) -> + Ok + { Solver_result.lock_dir + ; files + ; pinned_packages = pinned_package_names + ; num_expanded_packages = Context.count_expanded_packages context + }))) ;; diff --git a/src/dune_pkg/opam_solver.mli b/src/dune_pkg/opam_solver.mli index b3550b5fcd1..d16ef64ccde 100644 --- a/src/dune_pkg/opam_solver.mli +++ b/src/dune_pkg/opam_solver.mli @@ -7,12 +7,22 @@ module Solver_result : sig ; pinned_packages : Package_name.Set.t ; num_expanded_packages : int } - - val merge : t -> t -> t end +(** Derive the solver's base environment and platform overlays. Portable lock + directories unset platform-specific variables from the base and solve the + requested platforms; non-portable lock directories use one empty overlay. *) +val base_solver_env_and_platforms + : Solver_env.t + -> solve_for_platforms:Solver_env.t list + -> portable_lock_dir:bool + -> Solver_env.t * Solver_env.t list + val solve_lock_dir : Solver_env.t + -> platform_overlays:Solver_env.t list + (** [platform_overlays] must be non-empty and contain pairwise-distinct + entries. *) -> Version_preference.t -> Opam_repo.t list -> local_packages:Local_package.For_solver.t Package_name.Map.t diff --git a/src/dune_rules/lock_rules.ml b/src/dune_rules/lock_rules.ml index 6a680e156b3..c1a15f251ce 100644 --- a/src/dune_rules/lock_rules.ml +++ b/src/dune_rules/lock_rules.ml @@ -152,55 +152,22 @@ module Spec = struct ~unset:(Some unset_solver_vars) in let* solver_result = - if portable_lock_dir - then ( - (* CR-someday Alizter: This multi-platform solving logic is duplicated - from bin/pkg/lock.ml:solve_multiple_platforms. The logic for - removing platform-specific variables, solving for multiple platforms - in parallel, merging results, and error handling should be shared - between autolocking and manual locking. Consider extracting this - into a shared function in Dune_pkg.Opam_solver. *) - let portable_solver_env = - Solver_env.unset_multi - solver_env - Dune_lang.Package_variable_name.platform_specific - in - let solve_for_platforms = Solver_env.popular_platform_envs in - let+ results = - Fiber.parallel_map solve_for_platforms ~f:(fun platform_env -> - let solver_env_for_platform = - Solver_env.extend portable_solver_env platform_env - in - Opam_solver.solve_lock_dir - solver_env_for_platform - version_preference - repos - ~pins - ~local_packages - ~constraints - ~selected_depopts - ~portable_lock_dir) - in - let solver_results, errors = - List.partition_map results ~f:(function - | Ok result -> Left result - | Error e -> Right e) - in - match solver_results, errors with - | [], [] -> Code_error.raise "Solver did not run for any platforms." [] - | [], `Manifest_error diagnostic :: _ -> Error (`Manifest_error diagnostic) - | [], `Solve_error diagnostic :: _ -> Error (`Solve_error diagnostic) - | x :: xs, _ -> Ok (List.fold_left xs ~init:x ~f:Opam_solver.Solver_result.merge)) - else - Opam_solver.solve_lock_dir + let base_solver_env, platform_overlays = + Opam_solver.base_solver_env_and_platforms solver_env - version_preference - repos - ~pins - ~local_packages - ~constraints - ~selected_depopts + ~solve_for_platforms:Solver_env.popular_platform_envs ~portable_lock_dir + in + Opam_solver.solve_lock_dir + base_solver_env + ~platform_overlays + version_preference + repos + ~pins + ~local_packages + ~constraints + ~selected_depopts + ~portable_lock_dir in match solver_result with | Error (`Manifest_error diagnostic) -> raise (User_error.E diagnostic) diff --git a/test/blackbox-tests/test-cases/pkg/conflict-class.t b/test/blackbox-tests/test-cases/pkg/conflict-class.t index cb8ba91870b..fc42b97b199 100644 --- a/test/blackbox-tests/test-cases/pkg/conflict-class.t +++ b/test/blackbox-tests/test-cases/pkg/conflict-class.t @@ -30,7 +30,7 @@ Local conflict class defined in a local package: Unable to solve dependencies while generating lock directory: dune.lock Couldn't solve the package dependency formula. - Selected candidates: foo.dev x.dev foo&x + Selected candidates: foo.dev x.dev - bar -> (problem) Rejected candidates: bar.0.0.1: In same conflict class (ccc) as foo diff --git a/test/blackbox-tests/test-cases/pkg/helpers.sh b/test/blackbox-tests/test-cases/pkg/helpers.sh index 89da6a85268..321488efc14 100644 --- a/test/blackbox-tests/test-cases/pkg/helpers.sh +++ b/test/blackbox-tests/test-cases/pkg/helpers.sh @@ -534,9 +534,9 @@ dune_pkg_lock_normalized() { cat "${processed}" else processed="$(mktemp)" - dune_cmd delete-between \ - 'The dependency solver failed to find a solution for the following platforms:' \ - '\.\.\.with this error:' \ + dune_cmd delete-between \ + 'The dependency solver failed to find a solution for the requested platforms:' \ + '\.\.\.with this error:' \ < "${out}" \ > "${processed}" cat "${processed}" diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-all-or-nothing.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-all-or-nothing.t index 20f4f9d9141..104a6cc3f2d 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-all-or-nothing.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-all-or-nothing.t @@ -1,12 +1,6 @@ Demonstrate that locking fails entirely when the requested platform set has no joint solution: no partial lock directory is written. -The all-or-nothing behavior has landed: the lock now fails because the package -is unavailable on the linux platforms, and no lock directory is written. The -failure is still the product of per-platform solving and is reported per -platform; the single-solve change replaces it with one joint failure for the -requested platform set. - $ mkrepo $ add_mock_repo_if_needed @@ -28,13 +22,18 @@ failure is reported once for the requested platform set: Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: - arch = x86_64; os = linux - arch = arm64; os = linux + - arch = x86_64; os = macos + - arch = arm64; os = macos ...with this error: Couldn't solve the package dependency formula. - Selected candidates: x.dev - - foo -> (problem) + Selected candidates: foo.0.0.1 x.dev + - foo -> (problem) on arch = arm64; os = linux + No usable implementations: + foo.0.0.1: Availability condition not satisfied + - foo -> (problem) on arch = x86_64; os = linux No usable implementations: foo.0.0.1: Availability condition not satisfied [1] @@ -43,9 +42,8 @@ No partial lock directory is written: $ test ! -e dune.lock -A package required on only one of several requested platforms fails only that -platform. The later single-solve change will list the full requested platform -set and qualify the package diagnostic: +A package required on only one of several requested platforms must still name +that platform when it cannot be selected anywhere: $ cat > dune-project < (lang dune 3.18) @@ -62,19 +60,21 @@ set and qualify the package diagnostic: Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: - arch = x86_64; os = linux + - arch = arm64; os = linux + - arch = x86_64; os = macos + - arch = arm64; os = macos ...with this error: Couldn't solve the package dependency formula. Selected candidates: x.dev - - foo -> (problem) + - foo -> (problem) on arch = x86_64; os = linux No usable implementations: foo.0.0.1: Availability condition not satisfied [1] -Identical failures on both Linux platforms are grouped under those two -platforms. Once a joint failure lists all four requested platforms, each -affected platform must instead be named on its package diagnostic: +Identical failures on two of four requested platforms must name both affected +platforms: $ cat > dune-project < (lang dune 3.18) @@ -88,13 +88,18 @@ affected platform must instead be named on its package diagnostic: Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: - arch = x86_64; os = linux - arch = arm64; os = linux + - arch = x86_64; os = macos + - arch = arm64; os = macos ...with this error: Couldn't solve the package dependency formula. Selected candidates: x.dev - - foo -> (problem) + - foo -> (problem) on arch = arm64; os = linux + No usable implementations: + foo.0.0.1: Availability condition not satisfied + - foo -> (problem) on arch = x86_64; os = linux No usable implementations: foo.0.0.1: Availability condition not satisfied [1] diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-basic.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-basic.t index a5ab1c9d97e..f7a775ff33b 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-basic.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-basic.t @@ -23,12 +23,11 @@ Create a package that writes a different value to some files depending on the os Dependencies common to all supported platforms: - foo.0.0.1 -The portable lock directory is solved independently for each of the four -platforms. +The SAT engine runs once across all requested platforms. $ dune trace cat \ > | jq -s 'include "dune"; [ .[] | satSolveEvents ] | length' - 4 + 1 $ cat ${default_lock_dir}/lock.dune (lang package 0.1) diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-conflict-class-platform.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-conflict-class-platform.t index 5f408e54a4e..1bf16f4cd3b 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-conflict-class-platform.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-conflict-class-platform.t @@ -15,7 +15,7 @@ class. > EOF $ mkpkg needs-target <<'EOF' > available: os = "macos" - > depends: [ "target" {>= "2"} ] + > depends: [ "target" ] > EOF $ cat >dune-project <<'EOF' @@ -41,20 +41,52 @@ class. > (pkg enabled) > EOF -The transitive macOS dependency cannot use the available target version. The -Linux class peer is unrelated to that rejection. +The transitive macOS dependency and the Linux package must coexist even though +they belong to the same conflict class on different platforms. + $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock + Solution for dune.lock + + Dependencies common to all supported platforms: + (none) + + Additionally, some packages will only be built on specific platforms. + + arch = x86_64; os = linux: + - holder.0.0.1 + + arch = x86_64; os = macos: + - needs-target.0.0.1 + - target.1 + $ test -e dune.lock/holder.0.0.1.pkg + $ test -e dune.lock/target.1.pkg + +An incompatible transitive dependency must still report the actual version +restriction rather than attributing the failure to the conflict class. + + $ mkpkg needs-impossible <<'EOF' + > available: os = "macos" + > depends: [ "target" {>= "2"} ] + > EOF + $ cat >x.opam <<'EOF' + > opam-version: "2.0" + > depends: [ + > "holder" {os = "linux"} + > "needs-impossible" {os = "macos"} + > ] + > EOF $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: + - arch = x86_64; os = linux - arch = x86_64; os = macos ...with this error: Couldn't solve the package dependency formula. - Selected candidates: needs-target.0.0.1 x.dev - - target -> (problem) - needs-target 0.0.1 requires >= 2 + Selected candidates: holder.0.0.1 needs-impossible.0.0.1 x.dev + - target -> (problem) on arch = x86_64; os = macos + needs-impossible 0.0.1 requires >= 2 Rejected candidates: target.1: Incompatible with restriction: >= 2 [1] diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-duplicate-platforms.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-duplicate-platforms.t index 807d4eb2e19..86448ce52d3 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-duplicate-platforms.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-duplicate-platforms.t @@ -1,5 +1,5 @@ -Duplicate entries in solve_for_platforms currently break result merging. Record the -failure before joint solving deduplicates the requested platform set. +Test that duplicate platform entries in solve_for_platforms are solved only +once, so the lock file does not contain duplicated platform conditions. $ mkrepo $ add_mock_repo_if_needed @@ -28,24 +28,33 @@ Solve for a platform set that contains the same platform twice: > ((arch x86_64) (os linux)))) > EOF -Merging successful per-platform results rejects the duplicate solver -environment: + $ dune pkg lock + Solution for dune.lock + + Dependencies common to all supported platforms: + - foo.0.0.1 - $ dune pkg lock >output 2>&1 - [1] - $ grep 'Tried to add duplicate solver env' output - ("Tried to add duplicate solver env to lockdir conditional choice", - -When solving fails before result merging, the duplicate platform is reported -twice: +The solved_for_platforms metadata mentions each platform only once: + $ grep -c 'os macos' ${default_lock_dir}/lock.dune + 1 + $ grep -c 'os linux' ${default_lock_dir}/lock.dune + 1 +Duplicate platforms also appear only once when the joint solve fails: $ mkpkg foo <<'EOF' > available: false > EOF - $ dune pkg lock >output 2>&1 - [1] - $ grep 'arch = arm64; os = macos' output + $ dune pkg lock + Error: + Unable to solve dependencies while generating lock directory: dune.lock + + The dependency solver failed to find a solution for the requested platforms: - arch = arm64; os = macos - - arch = arm64; os = macos - $ grep 'arch = x86_64; os = linux' output - arch = x86_64; os = linux + ...with this error: + Couldn't solve the package dependency formula. + Selected candidates: x.dev + - foo -> (problem) + No usable implementations: + foo.0.0.1: Availability condition not satisfied + [1] diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-language-version-compatibility.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-language-version-compatibility.t deleted file mode 100644 index 8956165e09a..00000000000 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-language-version-compatibility.t +++ /dev/null @@ -1,38 +0,0 @@ -Existing language versions permit a portable lock directory to select different -versions on different platforms. - - $ mkrepo - $ add_mock_repo_if_needed - - $ mkpkg foo 1 <<'EOF' - > available: os = "linux" - > EOF - $ mkpkg foo 2 <<'EOF' - > available: os = "macos" - > EOF - $ cat >dune-project <<'EOF' - > (lang dune 3.18) - > (package - > (name x) - > (depends foo)) - > EOF - - $ DUNE_CONFIG__OS=linux DUNE_CONFIG__ARCH=x86_64 dune pkg lock - Solution for dune.lock - - Dependencies common to all supported platforms: - (none) - - Additionally, some packages will only be built on specific platforms. - - arch = arm64; os = linux: - - foo.1 - - arch = arm64; os = macos: - - foo.2 - - arch = x86_64; os = linux: - - foo.1 - - arch = x86_64; os = macos: - - foo.2 diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-minimize-distinct-avoids.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-minimize-distinct-avoids.t index 41fe8799516..67c749f81f5 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-minimize-distinct-avoids.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-minimize-distinct-avoids.t @@ -1,6 +1,5 @@ -Separate platform solves minimize avoid-version packages independently. They -therefore select two distinct platform-specific avoid-version packages instead -of the single common alternative. +Joint solving minimizes distinct avoid-version package versions rather than +counting the same package once per selected platform. $ mkrepo $ add_mock_repo_if_needed @@ -36,16 +35,13 @@ of the single common alternative. > EOF $ write_portable_lockdirs_project +Selecting common on both platforms contributes one avoid-version package to +the lock directory. Selecting both platform-specific alternatives contributes +two. + $ dune pkg lock Solution for dune.lock Dependencies common to all supported platforms: + - common.0.0.1 (this version should be avoided) - foo.0.0.1 - - Additionally, some packages will only be built on specific platforms. - - arch = x86_64; os = linux: - - linux-alt.0.0.1 (this version should be avoided) - - arch = x86_64; os = macos: - - macos-alt.0.0.1 (this version should be avoided) diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-no-solution.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-no-solution.t index 7438e22ac5a..c5f48d3a553 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-no-solution.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-no-solution.t @@ -31,7 +31,7 @@ Solver error when solving fails with the same error on all platforms: Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: - arch = x86_64; os = linux - arch = arm64; os = linux - arch = x86_64; os = macos @@ -45,11 +45,11 @@ Solver error when solving fails with the same error on all platforms: c.0.2: Incompatible with restriction: = 0.1 [1] -Each of the four platform solves retries twice before reporting the failure. +The single platform-set solve retries twice before reporting the failure. $ dune trace cat \ > | jq -s 'include "dune"; [ .[] | satSolveEvents ] | length' - 12 + 3 No partial lock directory is written: $ test ! -e dune.lock @@ -68,24 +68,27 @@ with the platforms where they are relevant: Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: - arch = x86_64; os = linux - arch = arm64; os = linux + - arch = x86_64; os = macos + - arch = arm64; os = macos ...with this error: Couldn't solve the package dependency formula. Selected candidates: a.0.0.1 b.0.0.1 foo.dev - - c -> (problem) + - c -> (problem) on arch = arm64; os = linux a 0.0.1 requires = 0.1 Rejected candidates: c.0.2: Incompatible with restriction: = 0.1 - - The dependency solver failed to find a solution for the following platforms: - - arch = x86_64; os = macos - - arch = arm64; os = macos - ...with this error: - Couldn't solve the package dependency formula. - Selected candidates: a.0.0.1 b.0.0.1 foo.dev - - c -> (problem) + - c -> (problem) on arch = arm64; os = macos + a 0.0.1 requires = 0.3 + Rejected candidates: + c.0.2: Incompatible with restriction: = 0.3 + - c -> (problem) on arch = x86_64; os = linux + a 0.0.1 requires = 0.1 + Rejected candidates: + c.0.2: Incompatible with restriction: = 0.1 + - c -> (problem) on arch = x86_64; os = macos a 0.0.1 requires = 0.3 Rejected candidates: c.0.2: Incompatible with restriction: = 0.3 diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-older-common-version.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-older-common-version.t index c0642e14fb1..4b474ae53ed 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-older-common-version.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-older-common-version.t @@ -1,6 +1,6 @@ When one platform can only use an older version of a package while another -platform prefers a newer version, the current per-platform solver selects a -different version for each platform. +platform prefers a newer, platform-specific version, the common older version +is selected for all platforms. $ mkrepo $ add_mock_repo_if_needed @@ -35,33 +35,20 @@ Define a package bar which depends on foo without a version constraint: $ make_x_depends_bar_project -Linux prefers foo.2 while macos can only install foo.1. The current -per-platform solver selects each platform's preferred version: +Linux would prefer foo.2 but macos cannot install it. The single solve must +select foo.1 for every platform: $ dune pkg lock Solution for dune.lock Dependencies common to all supported platforms: - bar.0.0.1 - - Additionally, some packages will only be built on specific platforms. - - arch = arm64; os = linux: - - foo.2 - - arch = arm64; os = macos: - - foo.1 - - arch = x86_64; os = linux: - - foo.2 - - arch = x86_64; os = macos: - foo.1 -Build the project as if we were on linux and confirm that version 2 of foo was built: +Build the project as if we were on linux and confirm that version 1 of foo was built: $ export DUNE_CONFIG__OS=linux DUNE_CONFIG__ARCH=arm64 DUNE_CONFIG__OS_FAMILY=debian DUNE_CONFIG__OS_DISTRIBUTION=ubuntu DUNE_CONFIG__OS_VERSION=24.11 $ dune build $ cat $pkg_root/$(dune pkg print-digest foo)/target/share/version - 2 + 1 $ dune clean diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-alternative-selection.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-alternative-selection.t index 5a2ac3bd812..34733dc4251 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-alternative-selection.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-alternative-selection.t @@ -6,17 +6,28 @@ directory. $ add_mock_repo_if_needed Define an implementation for each operating system: + $ LINUX_FILE=mock-opam-repository/packages/linux-impl/linux-impl.0.0.1/files/platform.txt + $ MACOS_FILE=mock-opam-repository/packages/macos-impl/macos-impl.0.0.1/files/platform.txt + $ mkdir -p "$(dirname "$LINUX_FILE")" "$(dirname "$MACOS_FILE")" + $ echo linux >"$LINUX_FILE" + $ echo macos >"$MACOS_FILE" - $ mkpkg linux-impl <<'EOF' + $ mkpkg linux-impl < available: os = "linux" + > extra-files: [ + > ["platform.txt" "md5=$(md5sum "$LINUX_FILE" | cut -f1 -d' ')"] + > ] > build: [ > ["mkdir" "-p" share "%{lib}%/%{name}%"] > ["touch" "%{lib}%/%{name}%/META"] > ] > EOF - $ mkpkg macos-impl <<'EOF' + $ mkpkg macos-impl < available: os = "macos" + > extra-files: [ + > ["platform.txt" "md5=$(md5sum "$MACOS_FILE" | cut -f1 -d' ')"] + > ] > build: [ > ["mkdir" "-p" share "%{lib}%/%{name}%"] > ["touch" "%{lib}%/%{name}%/META"] @@ -54,6 +65,13 @@ The common package accepts either implementation: arch = x86_64; os = macos: - macos-impl.0.0.1 +The lock directory contains the extra files of both selected alternatives: + + $ cat dune.lock/linux-impl.0.0.1.files/platform.txt + linux + $ cat dune.lock/macos-impl.0.0.1.files/platform.txt + macos + The lock directory selects and builds only the appropriate implementation for each platform: diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-dependant-version-extra-files.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-dependant-version-extra-files.t deleted file mode 100644 index 959e088ffe4..00000000000 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-dependant-version-extra-files.t +++ /dev/null @@ -1,82 +0,0 @@ -Test that extra files associated with a package are handled correctly when -multiple different versions of the package are present in the lockdir. - - $ mkrepo - $ add_mock_repo_if_needed - -Define 2 versions of the package foo that write their version number to a file -during their build so we can validate which version was built. - - $ VERSION1_FILE=mock-opam-repository/packages/foo/foo.1/files/version.txt - $ VERSION2_FILE=mock-opam-repository/packages/foo/foo.2/files/version.txt - - $ mkdir -p $(dirname $VERSION1_FILE) - $ echo version_1 > $VERSION1_FILE - - $ mkdir -p $(dirname $VERSION2_FILE) - $ echo version_2 > $VERSION2_FILE - - $ mkpkg foo 1 < build: [ - > ["mkdir" "-p" share "%{lib}%/%{name}%"] - > ["touch" "%{lib}%/%{name}%/META"] # needed for dune to recognize this as a library - > ] - > extra-files: [ - > ["version.txt" "md5=$(md5sum $VERSION1_FILE | cut -f1 -d' ')"] - > ] - > EOF - $ mkpkg foo 2 < build: [ - > ["mkdir" "-p" share "%{lib}%/%{name}%"] - > ["touch" "%{lib}%/%{name}%/META"] # needed for dune to recognize this as a library - > ] - > extra-files: [ - > ["version.txt" "md5=$(md5sum $VERSION2_FILE | cut -f1 -d' ')"] - > ] - > EOF - -Define a package bar which conditionally depends on different versions of foo: - - $ make_platform_dependent_bar_package - -Define a project with a package depending on bar: - $ make_x_depends_bar_project - -Solve the project. The solution will contain extra files for both versions of foo: - $ dune pkg lock - Solution for dune.lock - - Dependencies common to all supported platforms: - - bar.0.0.1 - - Additionally, some packages will only be built on specific platforms. - - arch = arm64; os = linux: - - foo.1 - - arch = arm64; os = macos: - - foo.2 - - arch = x86_64; os = linux: - - foo.1 - - arch = x86_64; os = macos: - - foo.2 - -Verify the contents of the extra files for each version of foo: - $ cat ${default_lock_dir}/foo.1.files/version.txt - version_1 - $ cat ${default_lock_dir}/foo.2.files/version.txt - version_2 - -Build as if we're on linux and verify that the appropriate extra file was copied into _build: - $ DUNE_CONFIG__OS=linux DUNE_CONFIG__ARCH=arm64 DUNE_CONFIG__OS_FAMILY=debian DUNE_CONFIG__OS_DISTRIBUTION=ubuntu DUNE_CONFIG__OS_VERSION=24.11 dune build - $ cat ${default_lock_dir}/foo.1.files/version.txt - version_1 - - $ dune clean - -Build as if we're on macos and verify that the appropriate extra file was copied into _build: - $ DUNE_CONFIG__OS=macos DUNE_CONFIG__ARCH=x86_64 DUNE_CONFIG__OS_FAMILY=homebrew DUNE_CONFIG__OS_DISTRIBUTION=homebrew DUNE_CONFIG__OS_VERSION=15.3.1 dune build - $ cat ${default_lock_dir}/foo.2.files/version.txt - version_2 diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-dependant-version.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-dependant-version.t index eab7cf2e6f4..5f5f2dde3c2 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-dependant-version.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-dependant-version.t @@ -27,44 +27,40 @@ Define a package bar which conditionally depends on different versions of foo: $ make_x_depends_bar_project +Linux requires foo.1 while macos requires foo.2. The cross-platform version +constraint makes the requested platform set unsatisfiable: + $ DUNE_TRACE=+sat dune pkg lock - Solution for dune.lock - - Dependencies common to all supported platforms: - - bar.0.0.1 - - Additionally, some packages will only be built on specific platforms. - - arch = arm64; os = linux: - - foo.1 - - arch = arm64; os = macos: - - foo.2 + Error: + Unable to solve dependencies while generating lock directory: dune.lock - arch = x86_64; os = linux: - - foo.1 - - arch = x86_64; os = macos: - - foo.2 + The dependency solver failed to find a solution for the requested platforms: + - arch = x86_64; os = linux + - arch = arm64; os = linux + - arch = x86_64; os = macos + - arch = arm64; os = macos + ...with this error: + Couldn't solve the package dependency formula. + Selected candidates: bar.0.0.1 foo.1 x.dev + - foo -> (problem) on arch = arm64; os = macos + bar 0.0.1 requires = 2 + Rejected candidates: + foo.2: Version differs from foo.1 selected on arch = x86_64; os = linux + foo.1: Incompatible with restriction: = 2 + - foo -> (problem) on arch = x86_64; os = macos + bar 0.0.1 requires = 2 + Rejected candidates: + foo.2: Version differs from foo.1 selected on arch = x86_64; os = linux + foo.1: Incompatible with restriction: = 2 + [1] -The portable lock directory is solved independently for each of the four -platforms. +The SAT engine itself rejects the conflict; the post-solve version-conflict +check is no longer reached. The do_solve retry path runs SAT 3 times before +reporting the failure, and each run records the same cross-platform conflict. $ dune trace cat \ > | jq -s 'include "dune"; [ .[] | satSolveEvents ] | length' - 4 - -Build the project as if we were on linux and confirm that version 1 of foo was built: - $ export DUNE_CONFIG__OS=linux DUNE_CONFIG__ARCH=arm64 DUNE_CONFIG__OS_FAMILY=debian DUNE_CONFIG__OS_DISTRIBUTION=ubuntu DUNE_CONFIG__OS_VERSION=24.11 - $ dune build - $ cat $pkg_root/$(dune pkg print-digest foo)/target/share/version - 1 - - $ dune clean - -Build the project as if we were on macos and confirm that version 2 of foo was built: - $ export DUNE_CONFIG__OS=macos DUNE_CONFIG__ARCH=x86_64 DUNE_CONFIG__OS_FAMILY=homebrew DUNE_CONFIG__OS_DISTRIBUTION=homebrew DUNE_CONFIG__OS_VERSION=15.3.1 - $ dune build - $ cat $pkg_root/$(dune pkg print-digest foo)/target/share/version - 2 + 3 +No partial lock directory is written: + $ test ! -e dune.lock diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-rejection-reason.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-rejection-reason.t index 8008531bebb..e2d113b991a 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-rejection-reason.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-platform-rejection-reason.t @@ -29,7 +29,7 @@ reason must be derived from Linux rather than a platform-less environment. Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: - arch = x86_64; os = linux ...with this error: Couldn't solve the package dependency formula. @@ -111,13 +111,18 @@ Only the pinned version appears in their rejection lists: Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: + - arch = x86_64; os = linux + - arch = arm64; os = linux - arch = x86_64; os = macos - arch = arm64; os = macos ...with this error: Couldn't solve the package dependency formula. - Selected candidates: x.dev - - foo -> (problem) + Selected candidates: foo.2 x.dev + - foo -> (problem) on arch = arm64; os = macos + No usable implementations: + foo.2: Availability condition not satisfied + - foo -> (problem) on arch = x86_64; os = macos No usable implementations: foo.2: Availability condition not satisfied [1] diff --git a/test/blackbox-tests/test-cases/pkg/workspace-deps/solver-missing-package.t b/test/blackbox-tests/test-cases/pkg/workspace-deps/solver-missing-package.t index 4ada97f2098..4ab9e09ba5e 100644 --- a/test/blackbox-tests/test-cases/pkg/workspace-deps/solver-missing-package.t +++ b/test/blackbox-tests/test-cases/pkg/workspace-deps/solver-missing-package.t @@ -17,7 +17,7 @@ the repository nor in the workspace. The solver should reject this. Error: Unable to solve dependencies while generating lock directory: dune.lock - The dependency solver failed to find a solution for the following platforms: + The dependency solver failed to find a solution for the requested platforms: - arch = x86_64; os = linux - arch = arm64; os = linux - arch = x86_64; os = macos