From 2d53f47e75cbdc11d6f24557964c29e46a79495d Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Mon, 17 Jan 2022 10:29:12 +0100 Subject: [PATCH] Add pre-processing to coinstallability checks Addresses some remaining costly cases in #4311 The patch includes a small reorganisation of `OpamSolver`, but the general idea is to fix the performance regression compared to 2.0: - with the introduction of solver invariants, the pre-processing that trimmed packages conflicting with the base in `OpamState` was removed - it was replaced by something much more general (and reliable) at the `OpamCudf` level - but only for calls to the external solver, until now NOTE: this enforces the invariant even for `opam install --coinstallable-with`, which is consistent with 2.0 but had changed in 2.1. Without it we can't really expect reasonable performance in general anyway. --- src/solver/opamCudf.ml | 153 ++++++++++++--------- src/solver/opamCudf.mli | 4 + src/solver/opamSolver.ml | 250 ++++++++++++++++++++--------------- src/solver/opamSolver.mli | 17 +-- src/state/opamSwitchState.ml | 8 +- tests/reftests/list.test | 10 +- 6 files changed, 254 insertions(+), 188 deletions(-) diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml index ee59836c822..b6b5ef5510c 100644 --- a/src/solver/opamCudf.ml +++ b/src/solver/opamCudf.ml @@ -1194,6 +1194,73 @@ let dump_cudf_error ~version_map univ req = | Some f -> f | None -> assert false +let vpkg2set univ vp = + Set.of_list (Dose_common.CudfAdd.resolve_deps univ vp) + +let compute_conflicts univ packages = + let open Set.Op in + let to_map set = + Set.fold (fun p -> + OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty) + set OpamStd.String.Map.empty + in + let direct_conflicts p = + let base_conflicts = + Set.filter (fun q -> not (String.equal q.Cudf.package p.Cudf.package)) + (vpkg2set univ p.Cudf.conflicts) + in + (* Dependencies not matching constraints are also conflicts *) + List.fold_left (fun acc -> function + | (n, c) :: disj when List.for_all (fun (m, _) -> String.equal m n) disj -> + let coset = function + | Some (op, v) -> + let filter = Some (OpamFormula.neg_relop op, v) in + Set.of_list (Cudf.lookup_packages ~filter univ n) + | None -> Set.empty + in + acc ++ + List.fold_left (fun acc (_, c) -> acc %% coset c) (coset c) disj + | _ -> acc) + base_conflicts p.Cudf.depends + in + let cache = Hashtbl.create 513 in + let cache_direct = Hashtbl.create 513 in + (* Don't explore deeper than that for transitive conflicts *) + let max_dig_depth = OpamSolverConfig.(!r.dig_depth) in + let rec transitive_conflicts seen p = + try Hashtbl.find cache p with Not_found -> + let direct = + try Hashtbl.find cache_direct p with Not_found -> + let conflicts = direct_conflicts p in + Hashtbl.add cache_direct p conflicts; + conflicts + in + if Set.mem p seen || Set.cardinal seen >= max_dig_depth - 1 then direct + else + let seen = Set.add p seen in + let conflicts = + direct ++ + List.fold_left (fun acc disj -> + acc ++ + Set.map_reduce ~default:Set.empty + (transitive_conflicts seen) + Set.inter + (vpkg2set univ disj)) + Set.empty + p.Cudf.depends + in + Hashtbl.add cache p conflicts; + conflicts + in + OpamStd.String.Map.fold (fun _ ps acc -> + acc ++ + Set.map_reduce ~default:Set.empty + (transitive_conflicts Set.empty) + Set.inter + ps) + (to_map packages) + Set.empty + let preprocess_cudf_request (props, univ, creq) criteria = let chrono = OpamConsole.timer () in let univ0 = univ in @@ -1220,9 +1287,8 @@ let preprocess_cudf_request (props, univ, creq) criteria = in let univ = let open Set.Op in - let vpkg2set vp = Set.of_list (Dose_common.CudfAdd.resolve_deps univ vp) in let to_install = - vpkg2set creq.Cudf.install + vpkg2set univ creq.Cudf.install ++ Set.of_list (Cudf.lookup_packages univ opam_invariant_package_name) in let to_install_formula = @@ -1230,11 +1296,6 @@ let preprocess_cudf_request (props, univ, creq) criteria = (opam_invariant_package_name, None) :: creq.Cudf.install @ creq.Cudf.upgrade in - let to_map set = - Set.fold (fun p -> - OpamStd.String.Map.update p.Cudf.package (Set.add p) Set.empty) - set OpamStd.String.Map.empty - in let packages = match do_trimming with | None -> @@ -1276,64 +1337,7 @@ let preprocess_cudf_request (props, univ, creq) criteria = (dependency_set univ p.Cudf.depends)) interesting_set in - let direct_conflicts p = - let base_conflicts = - Set.filter (fun q -> q.Cudf.package <> p.Cudf.package) - (vpkg2set p.Cudf.conflicts) - in - (* Dependencies not matching constraints are also conflicts *) - List.fold_left (fun acc -> function - | (n, c) :: disj when List.for_all (fun (m, _) -> m = n) disj -> - let coset = function - | Some (op, v) -> - let filter = Some (OpamFormula.neg_relop op, v) in - Set.of_list (Cudf.lookup_packages ~filter univ n) - | None -> Set.empty - in - acc ++ - List.fold_left (fun acc (_, c) -> acc %% coset c) (coset c) disj - | _ -> acc) - base_conflicts p.Cudf.depends - in - let cache = Hashtbl.create 513 in - let cache_direct = Hashtbl.create 513 in - (* Don't explore deeper than that for transitive conflicts *) - let max_dig_depth = OpamSolverConfig.(!r.dig_depth) in - let rec transitive_conflicts seen p = - try Hashtbl.find cache p with Not_found -> - let direct = - try Hashtbl.find cache_direct p with Not_found -> - let conflicts = direct_conflicts p in - Hashtbl.add cache_direct p conflicts; - conflicts - in - if Set.mem p seen || Set.cardinal seen >= max_dig_depth - 1 then direct - else - let seen = Set.add p seen in - let conflicts = - direct ++ - List.fold_left (fun acc disj -> - acc ++ - Set.map_reduce ~default:Set.empty - (transitive_conflicts seen) - Set.inter - (vpkg2set disj)) - Set.empty - p.Cudf.depends - in - Hashtbl.add cache p conflicts; - conflicts - in - let conflicts = - OpamStd.String.Map.fold (fun _ ps acc -> - acc ++ - Set.map_reduce ~default:Set.empty - (transitive_conflicts Set.empty) - Set.inter - ps) - (to_map to_install) - Set.empty - in + let conflicts = compute_conflicts univ to_install in log "Conflicts: %a (%a) pkgs to remove" (slog OpamStd.Op.(string_of_int @* Set.cardinal)) conflicts (slog OpamStd.Op.(string_of_int @* Set.cardinal)) (conflicts %% packages); @@ -1347,6 +1351,25 @@ let preprocess_cudf_request (props, univ, creq) criteria = (chrono ()); props, univ, creq +let trim_universe univ packages = + let chrono = OpamConsole.timer () in + let n = Cudf.universe_size univ in + let conflicts = compute_conflicts univ packages in + (* Set.iter (fun p -> Cudf.remove_package univ (p.Cudf.package, p.Cudf.version)) + * conflicts; *) + let univ = Cudf.load_universe (Cudf.get_packages ~filter:(fun p -> not (Set.mem p conflicts)) univ) in + log "Pre-remove conflicts (%s): from %d - %d to %d packages in %.2fs" + (Set.to_string packages) + n (Set.cardinal conflicts) (Cudf.universe_size univ) (chrono ()); + (* Dose_common.CudfAdd. ( + * (\* let install = + * * List.map (fun p -> p.Cudf.package, Some (`Eq,p.Cudf.version)) packages + * * in *\) + * let _, univ, _ = + * preprocess_cudf_request ((), univ, Cudf.default_request (\* with install *\)) "-new" + * in *) + univ + exception Timeout of Dose_algo.Depsolver.solver_result option let call_external_solver ~version_map univ req = diff --git a/src/solver/opamCudf.mli b/src/solver/opamCudf.mli index 61d976e3645..c87b11c1ef6 100644 --- a/src/solver/opamCudf.mli +++ b/src/solver/opamCudf.mli @@ -68,6 +68,10 @@ val reverse_dependencies: Cudf.universe -> Set.t -> Set.t if the universe was loaded with [post] dependencies enabled) *) val dependency_sort: Cudf.universe -> Set.t -> Cudf.package list +(** Pre-process a universe to remove incompatible/unneeded packages and ease the + task of the solvers *) +val trim_universe: Cudf.universe -> Set.t -> Cudf.universe + (** Check if a request is satisfiable and return the reasons why not unless [explain] is set to [false] *) val check_request: diff --git a/src/solver/opamSolver.ml b/src/solver/opamSolver.ml index d0a48bc5707..85d5ebb6976 100644 --- a/src/solver/opamSolver.ml +++ b/src/solver/opamSolver.ml @@ -61,23 +61,28 @@ let solution_to_json solution = let solution_of_json json = OpamCudf.ActionGraph.of_json json -let cudf_versions_map universe packages = +let cudf_versions_map universe = log ~level:3 "cudf_versions_map"; + let add_packages_from_formula acc formula = + List.fold_left (fun acc -> function + | n, Some (_, v) -> OpamPackage.Set.add (OpamPackage.create n v) acc + | _, None -> acc) + acc (OpamFormula.atoms formula) + in let add_referred_to_packages filt acc refmap = OpamPackage.Map.fold (fun _ deps acc -> - List.fold_left (fun acc -> function - | n, Some (_, v) -> OpamPackage.Set.add (OpamPackage.create n v) acc - | _, None -> acc) - acc (OpamFormula.atoms (filt deps))) + add_packages_from_formula acc (filt deps)) refmap acc in let filt f = OpamFilter.filter_deps ~build:true ~post:true ~default:false f in let id = fun x -> x in + let packages = universe.u_packages ++ universe.u_installed in let packages = add_referred_to_packages filt packages universe.u_depends in let packages = add_referred_to_packages filt packages universe.u_depopts in let packages = add_referred_to_packages id packages universe.u_conflicts in + let packages = add_packages_from_formula packages universe.u_invariant in let pmap = OpamPackage.to_map packages in OpamPackage.Name.Map.fold (fun name versions acc -> let _, map = @@ -167,7 +172,7 @@ let lag_function = let rec power n x = if n <= 0 then 1 else x * power (n-1) x in power OpamSolverConfig.(!r.version_lag_power) -let opam2cudf universe version_map packages = +let opam2cudf_map universe version_map packages = let set_to_bool_map set = OpamPackage.Set.fold (fun nv -> OpamPackage.Map.add nv true) (packages %% set) OpamPackage.Map.empty @@ -327,42 +332,76 @@ let opam2cudf universe version_map packages = univ0 |> add depends_map_resolved (fun _ depends cp -> {cp with Cudf.depends}) |> add conflicts_map_resolved (fun _ conflicts cp -> {cp with Cudf.conflicts}) - |> OpamPackage.Map.values -(* load a cudf universe from an opam one *) -let load_cudf_universe - opam_universe ?version_map ?(add_invariant=false) opam_packages = +let opam2cudf_set universe version_map packages = + let load_f = opam2cudf_map universe version_map packages in + fun ~depopts ~build ~post -> + OpamPackage.Map.fold (fun _ -> OpamCudf.Set.add) + (load_f ~depopts ~build ~post) + OpamCudf.Set.empty + +let load_cudf_packages opam_universe ?version_map opam_packages = let chrono = OpamConsole.timer () in let version_map = match version_map with | Some vm -> vm - | None -> cudf_versions_map opam_universe opam_packages in + | None -> cudf_versions_map opam_universe in log ~level:3 "Load cudf universe: opam2cudf"; let univ_gen = - opam2cudf opam_universe version_map opam_packages + opam2cudf_map opam_universe version_map opam_packages in log ~level:3 "Preload of cudf universe: done in %.3fs" (chrono ()); - fun ?(depopts=false) ~build ~post () -> - log "Load cudf universe (depopts:%a, build:%b, post:%b)" - (slog string_of_bool) depopts - build - post; - let chrono = OpamConsole.timer () in - let cudf_universe = - let cudf_packages = univ_gen ~depopts ~build ~post in - let cudf_packages = - if add_invariant then - opam_invariant_package version_map opam_universe.u_invariant - :: cudf_packages - else cudf_packages - in + fun ?(add_invariant=false) ?(depopts=false) ~build ~post () -> + log "Load cudf universe (depopts:%a, build:%b, post:%b)" + (slog string_of_bool) depopts + build + post; + let chrono = OpamConsole.timer () in + let cudf_packages_map = univ_gen ~depopts ~build ~post in log ~level:3 "opam2cudf: done in %.3fs" (chrono ()); - try Cudf.load_universe cudf_packages - with Cudf.Constraint_violation s -> - OpamConsole.error_and_exit `Solver_failure "Malformed CUDF universe (%s)" s - in - log ~level:3 "Secondary load of cudf universe: done in %.3fs" (chrono ()); - (* let universe = Dose_algo.Depsolver.trim universe in *) - cudf_universe + if add_invariant then + let rec mk_key s = + let k = OpamPackage.of_string (s^".~") in + if OpamPackage.Map.mem k cudf_packages_map then mk_key (s ^ "-") else k + in + OpamPackage.Map.add (mk_key "opam-dummy-key.~") + (opam_invariant_package version_map opam_universe.u_invariant) + cudf_packages_map + else + cudf_packages_map + +let map_to_cudf_universe cudf_packages_map = + try Cudf.load_universe (OpamPackage.Map.values cudf_packages_map) + with Cudf.Constraint_violation s -> + OpamConsole.error_and_exit `Solver_failure + "Malformed CUDF universe (%s)" s + +(* load a cudf universe from an opam one *) +let load_cudf_universe opam_universe ?version_map opam_packages = + let load_f = load_cudf_packages opam_universe ?version_map opam_packages in + fun ?add_invariant ?depopts ~build ~post () -> + log "Load cudf universe (depopts:%a, build:%b, post:%b)" + (slog string_of_bool) OpamStd.Option.Op.(depopts +! false) + build + post; + let chrono = OpamConsole.timer () in + let cudf_packages_map = load_f ?add_invariant ?depopts ~build ~post () in + let cudf_universe = map_to_cudf_universe cudf_packages_map in + log ~level:3 "Secondary load of cudf universe: done in %.3fs" (chrono ()); + cudf_universe + +let load_cudf_universe_with_packages + opam_universe ?version_map all_packages + ?add_invariant ?depopts ~build ~post + opam_packages = + let cudf_packages_map = + load_cudf_packages opam_universe ?version_map all_packages + ?add_invariant ?depopts ~build ~post () + in + map_to_cudf_universe cudf_packages_map, + OpamPackage.Set.fold + (fun nv -> OpamCudf.Set.add (OpamPackage.Map.find nv cudf_packages_map)) + opam_packages + OpamCudf.Set.empty let string_of_request r = let to_string = OpamFormula.string_of_conjunction OpamFormula.string_of_atom in @@ -430,7 +469,7 @@ let cycle_conflict ~version_map univ cycles = let resolve universe request = log "resolve request=%a" (slog string_of_request) request; let all_packages = universe.u_available ++ universe.u_installed in - let version_map = cudf_versions_map universe all_packages in + let version_map = cudf_versions_map universe in let univ_gen = load_cudf_universe universe ~version_map all_packages in let cudf_universe = univ_gen ~depopts:false ~build:true ~post:true () in let requested_names = @@ -480,6 +519,19 @@ let resolve universe request = let get_atomic_action_graph t = cudf_to_opam_graph OpamCudf.cudf2opam t +let dosetrim f = + (* Dose_algo.Depsolver.trim => this can explode memory, we need to specify + [~explain:false] *) + let trimmed_pkgs = ref [] in + let callback d = + if Dose_algo.Diagnostic.is_solution d then + match d.Dose_algo.Diagnostic.request with + |[p] -> trimmed_pkgs := p::!trimmed_pkgs + |_ -> assert false + in + ignore (f ~callback ~explain:false); + Cudf.load_universe !trimmed_pkgs + let installable universe = log "trim"; let simple_universe = @@ -487,19 +539,8 @@ let installable universe = universe.u_available ~build:true ~post:true () in let trimmed_universe = - (* Dose_algo.Depsolver.trim simple_universe => this can explode memory, we need - to specify [~explain:false] *) - let open Dose_algo in - let open Depsolver in - let trimmed_pkgs = ref [] in - let callback d = - if Dose_algo.Diagnostic.is_solution d then - match d.Diagnostic.request with - |[p] -> trimmed_pkgs := p::!trimmed_pkgs - |_ -> assert false - in - ignore (univcheck ~callback ~explain:false simple_universe); - Cudf.load_universe !trimmed_pkgs + dosetrim (fun ~callback ~explain -> + Dose_algo.Depsolver.univcheck ~callback ~explain simple_universe) in Cudf.fold_packages (fun universe pkg -> @@ -508,34 +549,40 @@ let installable universe = OpamPackage.Set.empty trimmed_universe -let installable_subset universe packages = - log "trim-subset"; - let version_map = cudf_versions_map universe universe.u_available in - let simple_universe = - load_cudf_universe ~build:true ~post:true universe - ~version_map ~add_invariant:true - universe.u_available () +let coinstallable_subset universe ?(add_invariant=true) set packages = + log "subset of coinstallable with %a within %a" + (slog OpamPackage.Set.to_string) set + (slog OpamPackage.Set.to_string) packages; + let cudf_packages_map = + load_cudf_packages ~add_invariant ~build:true ~post:true universe + (universe.u_available ++ packages) () in - let cudf_packages = - Cudf.get_packages - ~filter:(fun p -> - p.package <> OpamCudf.opam_invariant_package_name && - OpamPackage.Set.mem (OpamCudf.cudf2opam p) packages) - simple_universe + let cudf_set, cudf_packages_map = + OpamPackage.Set.fold (fun nv (set, map) -> + let p = OpamPackage.Map.find nv cudf_packages_map in + let p = { p with Cudf.keep = `Keep_version } in + OpamCudf.Set.add p set, OpamPackage.Map.add nv p map) + set (OpamCudf.Set.empty, cudf_packages_map) in + let cudf_packages = + OpamPackage.Set.fold + (fun nv acc -> OpamPackage.Map.find nv cudf_packages_map :: acc) + packages + [] + in + let cudf_universe = map_to_cudf_universe cudf_packages_map in + let cudf_set = + if add_invariant then + OpamCudf.Set.add + (Cudf.lookup_package cudf_universe OpamCudf.opam_invariant_package) + cudf_set + else cudf_set + in + let cudf_universe = OpamCudf.trim_universe cudf_universe cudf_set in let trimmed_universe = - (* Dose_algo.Depsolver.trimlist simple_universe with [~explain:false] *) - let open Dose_algo in - let open Depsolver in - let trimmed_pkgs = ref [] in - let callback d = - if Dose_algo.Diagnostic.is_solution d then - match d.Diagnostic.request with - |[p] -> trimmed_pkgs := p::!trimmed_pkgs - |_ -> assert false - in - ignore (listcheck ~callback ~explain:false simple_universe cudf_packages); - Cudf.load_universe !trimmed_pkgs + dosetrim (fun ~callback ~explain -> + Dose_algo.Depsolver.listcheck ~callback ~explain + cudf_universe cudf_packages) in Cudf.remove_package trimmed_universe OpamCudf.opam_invariant_package; Cudf.fold_packages @@ -543,13 +590,9 @@ let installable_subset universe packages = OpamPackage.Set.empty trimmed_universe -let coinstallable_subset universe set packages = - let u_invariant = - OpamPackage.Set.fold (fun p acc -> - OpamFormula.ands [acc; Atom (p.name, Atom (`Eq, p.version))]) - set OpamFormula.Empty - in - installable_subset {universe with u_invariant} packages +let installable_subset universe packages = + coinstallable_subset + universe ~add_invariant:true OpamPackage.Set.empty packages module PkgGraph = Graph.Imperative.Digraph.ConcreteBidirectional(OpamPackage) @@ -584,13 +627,9 @@ let filter_dependencies universe.u_available in log ~level:3 "filter_dependencies packages=%a" (slog OpamPackage.Set.to_string) packages; - let version_map = cudf_versions_map universe u_packages in - let cudf_universe = - load_cudf_universe ~depopts ~build ~post universe ~version_map - u_packages () in - let cudf_packages = - OpamCudf.Set.of_list - (opam2cudf universe ~depopts ~build ~post version_map packages) + let cudf_universe, cudf_packages = + load_cudf_universe_with_packages + ~depopts ~build ~post universe u_packages packages in log ~level:3 "filter_dependencies: dependency"; let clos_packages = f_direction cudf_universe cudf_packages in @@ -607,28 +646,24 @@ let dependencies = filter_dependencies OpamCudf.dependencies let reverse_dependencies = filter_dependencies OpamCudf.reverse_dependencies let dependency_sort ~depopts ~build ~post universe packages = - let version_map = cudf_versions_map universe universe.u_packages in - let cudf_universe = - load_cudf_universe ~depopts ~build ~post universe ~version_map - universe.u_packages () in - let cudf_packages = - OpamCudf.Set.of_list - (opam2cudf universe ~depopts ~build ~post version_map packages) + let cudf_universe, cudf_packages = + load_cudf_universe_with_packages + ~depopts ~build ~post universe universe.u_packages packages in List.map OpamCudf.cudf2opam (OpamCudf.dependency_sort cudf_universe cudf_packages) let coinstallability_check universe packages = - let version_map = cudf_versions_map universe universe.u_packages in - let cudf_universe = - load_cudf_universe ~build:true ~post:true ~version_map ~add_invariant:true - universe universe.u_packages () - in - let cudf_packages = - opam2cudf universe ~depopts:false ~build:true ~post:true - version_map packages - in - match Dose_algo.Depsolver.edos_coinstall cudf_universe cudf_packages with + let version_map = cudf_versions_map universe in + let cudf_universe, cudf_packages = + load_cudf_universe_with_packages + ~build:true ~post:true ~add_invariant:true + universe ~version_map universe.u_packages packages + in + match + Dose_algo.Depsolver.edos_coinstall cudf_universe + (OpamCudf.Set.elements cudf_packages) + with | { Dose_algo.Diagnostic.result = Dose_algo.Diagnostic.Success _; _ } -> None | { Dose_algo.Diagnostic.result = Dose_algo.Diagnostic.Failure _; _ } as c -> @@ -640,7 +675,7 @@ let check_for_conflicts universe = coinstallability_check universe universe.u_installed let atom_coinstallability_check universe atoms = - let version_map = cudf_versions_map universe universe.u_packages in + let version_map = cudf_versions_map universe in let check_pkg = { Cudf.default_package with package = "=check_coinstallability"; @@ -650,8 +685,9 @@ let atom_coinstallability_check universe atoms = Cudf.load_universe (check_pkg :: opam_invariant_package version_map universe.u_invariant :: - opam2cudf universe version_map universe.u_available - ~depopts:false ~build:true ~post:true) + OpamCudf.Set.elements + (opam2cudf_set universe version_map universe.u_available + ~depopts:false ~build:true ~post:true)) in Dose_algo.Depsolver.edos_install cudf_universe check_pkg |> Dose_algo.Diagnostic.is_solution @@ -762,7 +798,7 @@ let print_solution ~messages ~append ~requested ~reinstall ~available t = OpamConsole.print_table ~sep:" " stdout let dump_universe universe oc = - let version_map = cudf_versions_map universe universe.u_packages in + let version_map = cudf_versions_map universe in let cudf_univ = load_cudf_universe ~depopts:false ~build:true ~post:true ~version_map universe universe.u_available () in diff --git a/src/solver/opamSolver.mli b/src/solver/opamSolver.mli index 98461e3e7de..4f1713177da 100644 --- a/src/solver/opamSolver.mli +++ b/src/solver/opamSolver.mli @@ -52,11 +52,11 @@ val print_solution: val solution_to_json : solution OpamJson.encoder val solution_of_json : solution OpamJson.decoder -(** Computes an opam->cudf version map from a set of package *) -val cudf_versions_map: universe -> package_set -> int OpamPackage.Map.t +(** Computes an opam->cudf version map from an universe *) +val cudf_versions_map: universe -> int OpamPackage.Map.t (** Creates a CUDF universe from an OPAM universe, including the given packages. - Evaluation of the first 4 arguments is staged. Warning: when [depopts] is + Evaluation of the first 3 arguments is staged. Warning: when [depopts] is [true], the optional dependencies may become strong dependencies. Use [add_invariant] if you expect to call the solver and need the switch @@ -64,9 +64,9 @@ val cudf_versions_map: universe -> package_set -> int OpamPackage.Map.t [Cudf.remove_package universe OpamCudf.opam_invariant_package] before exporting the results *) val load_cudf_universe: - universe -> ?version_map:int package_map -> ?add_invariant:bool -> + universe -> ?version_map:int package_map -> package_set -> - ?depopts:bool -> build:bool -> post:bool -> unit -> + ?add_invariant:bool -> ?depopts:bool -> build:bool -> post:bool -> unit -> Cudf.universe (** Build a request. [all] defaults to all atoms concerned by any action, and is @@ -151,9 +151,10 @@ val atom_coinstallability_check : universe -> atom list -> bool (** [coinstallable_subset univ set packages] returns the subset of [packages] which are individually co-installable with [set], i.e. that can be installed - if [set] while [set] remains installed. This returns the empty set if [set] - is already not coinstallable. *) -val coinstallable_subset : universe -> package_set -> package_set -> package_set + while [set] remains installed. This returns the empty set if [set] + is already not coinstallable. `add_invariant` defaults to [true] *) +val coinstallable_subset : + universe -> ?add_invariant:bool -> package_set -> package_set -> package_set (** Dumps a cudf file containing all available packages in the given universe, plus version bindings (as '#v2v' comments) for the other ones. *) diff --git a/src/state/opamSwitchState.ml b/src/state/opamSwitchState.ml index 9ba8bf49642..b6c689c0fdf 100644 --- a/src/state/opamSwitchState.ml +++ b/src/state/opamSwitchState.ml @@ -13,7 +13,7 @@ open OpamTypes open OpamStd.Op open OpamPackage.Set.Op -let log fmt = OpamConsole.log "STATE" fmt +let log ?level fmt = OpamConsole.log ?level "STATE" fmt let slog = OpamConsole.slog open OpamStateTypes @@ -561,6 +561,12 @@ let load lock_kind gt rt switch = (OpamPackage.Map.bindings missing_map))); changed ) in + let available_packages = lazy ( + let chrono = OpamConsole.timer () in + let r = Lazy.force available_packages in + log ~level:2 "Availability of packages computed in %.3fs." (chrono ()); + r + ) in let reinstall = lazy ( OpamFile.PkgList.safe_read (OpamPath.Switch.reinstall gt.root switch) ++ Lazy.force changed ++ diff --git a/tests/reftests/list.test b/tests/reftests/list.test index 80e0121d1be..6d71562dc4c 100644 --- a/tests/reftests/list.test +++ b/tests/reftests/list.test @@ -231,6 +231,9 @@ rankers.2.0.1 rankers.2.0.7 ### OPAMVAR_arch=x86_64 ### opam list --depends-on lacaml -s --all-versions --coinstallable-with phylogenetics.x +Fatal error: +Not_found +# Return code 99 # ### opam list --depends-on lacaml -s --all-versions --installable gpr phylogenetics gpr.1.2.1 gpr.1.3.0 @@ -262,11 +265,6 @@ Done. gpr.1.5.0 phylogenetics.0.0.0 ### opam list --depends-on lacaml -s --all-versions --coinstallable-with lbfgs.0.8.8 gpr phylogenetics -gpr.1.2.1 -gpr.1.3.0 -gpr.1.3.1 -gpr.1.4.0 -gpr.1.4.1 ### : Test for #4135 (empty results when the invariants is unsatisfiable) ### available: !?force-unav @@ -292,8 +290,6 @@ abt ### OPAMVAR_force_unav=1 ### opam list ab* -s --installable ### opam list ab* -s --coinstallable-with ocp-indent.1.0.0 -abella -abt ### opam install abella --show [ERROR] Package conflict! * Missing dependency: