diff --git a/.ocamlinit b/.ocamlinit index 1c2f40d3096..6189228711e 100644 --- a/.ocamlinit +++ b/.ocamlinit @@ -1,4 +1,5 @@ #use "topfind";; +#use "down.top";; #require "opam-client";; OpamClientConfig.opam_init ();; diff --git a/Makefile b/Makefile index 6581f9de2c4..08dad68e177 100644 --- a/Makefile +++ b/Makefile @@ -107,7 +107,7 @@ endif endif ifneq ($(LIBINSTALL_DIR),) - OPAMINSTALLER_FLAGS += --libdir "$(LIBINSTALL_DIR)" + OPAMINSTALLER_FLAGS += --libdir "$(LIBINSTALL_DIR)" --docdir "$(LIBINSTALL_DIR)/../doc" endif opam-devel.install: $(DUNE_DEP) diff --git a/master_changes.md b/master_changes.md index 41f8e773944..f4cab3b07b7 100644 --- a/master_changes.md +++ b/master_changes.md @@ -19,7 +19,8 @@ New option/command/subcommand are prefixed with ◈. * The stdout of `pre-` and `post-session` hooks is now propagated to the user [#4382 @AltGr - fix #4359] ## Remove - * + * Fix `opam remove --autoremove ` to not autoremove unrelated packages [#4369 @AltGr - fix #4250 #4332] + * Fix cases where `opam remove -a` could trigger conflicts in the presence of orphan packages [#4369 @AltGr - fix #4250 #4332] ## Switch * Fix `--update-invariant` when removing or changing package name [#4360 @AltGr - fix #4353] diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml index 9c1d1f77064..3542de3eb18 100644 --- a/src/client/opamClient.ml +++ b/src/client/opamClient.ml @@ -63,7 +63,6 @@ let orphans ?changes ?(transitive=false) t = | Some ch -> if OpamPackage.Set.is_empty orphans then orphans else let recompile_cone = - OpamPackage.Set.of_list @@ OpamSolver.reverse_dependencies ~depopts:true ~installed:true ~unavailable:true ~build:true ~post:false @@ -93,7 +92,6 @@ let orphans ?changes ?(transitive=false) t = let rec add_trans full_orphans orphan_versions = (* fixpoint to check all packages with no available version *) let new_orphans = - OpamPackage.Set.of_list @@ OpamSolver.reverse_dependencies ~depopts:false ~installed:false ~unavailable:true ~build:true ~post:false @@ -293,8 +291,9 @@ let upgrade_t OpamConsole.warning "Upgrade is not possible because of conflicts or packages that \ are no longer available:"; - OpamConsole.errmsg "%s" - (OpamStd.Format.itemize (OpamCudf.string_of_conflict ~indent:4) reasons); + OpamConsole.errmsg " %s" + (OpamStd.Format.itemize (OpamCudf.string_of_conflict ~start_column:2) + reasons); OpamConsole.errmsg "\nYou may run \"opam upgrade --fixup\" to let opam fix the \ current state.\n" @@ -1057,7 +1056,7 @@ let assume_built_restrictions ?available_packages t atoms = (OpamPackage.Map.values missing |> List.fold_left OpamPackage.Name.Set.union OpamPackage.Name.Set.empty |> OpamPackage.packages_of_names available_packages) - -- OpamPackage.Set.of_list installed_dependencies + -- installed_dependencies in let available_packages = lazy ( (available_packages -- uninstalled_dependencies) ++ t.installed ++ pinned @@ -1065,7 +1064,8 @@ let assume_built_restrictions ?available_packages t atoms = let fixed_atoms = List.map (fun nv -> (OpamPackage.name nv , Some (`Eq, OpamPackage.version nv))) - ((OpamPackage.Set.elements pinned) @ installed_dependencies) + (OpamPackage.Set.elements pinned @ + OpamPackage.Set.elements installed_dependencies) in { t with available_packages }, fixed_atoms @@ -1261,10 +1261,10 @@ let remove_t ?ask ~autoremove ~force atoms t = (slog OpamFormula.string_of_atoms) atoms; let t, full_orphans, orphan_versions = - let changes = - if autoremove then None - else Some (OpamSwitchState.packages_of_atoms t atoms) in - orphans ?changes t + if atoms = [] then t, OpamPackage.Set.empty, OpamPackage.Set.empty + else + let changes = OpamSwitchState.packages_of_atoms t atoms in + orphans ~changes t in let nothing_to_do = ref true in @@ -1300,18 +1300,17 @@ let remove_t ?ask ~autoremove ~force atoms t = Remove in let to_remove = - OpamPackage.Set.of_list - (OpamSolver.reverse_dependencies ~build:true ~post:true - ~depopts:false ~installed:true universe packages) in + OpamSolver.reverse_dependencies ~build:true ~post:true + ~depopts:false ~installed:true universe packages + in let to_keep = (if autoremove then t.installed_roots %% t.installed else t.installed) ++ universe.u_base - -- to_remove -- full_orphans -- orphan_versions + -- to_remove in let to_keep = - OpamPackage.Set.of_list - (OpamSolver.dependencies ~build:true ~post:true - ~depopts:true ~installed:true universe to_keep) in + OpamSolver.dependencies ~build:true ~post:true + ~depopts:true ~installed:true universe to_keep in (* to_keep includes the depopts, because we don't want to autoremove them. But that may re-include packages that we wanted removed, so we need to remove them again *) @@ -1319,13 +1318,12 @@ let remove_t ?ask ~autoremove ~force atoms t = let requested = OpamPackage.names_of_packages packages in let to_remove = if autoremove then - let to_remove = t.installed -- to_keep in - if atoms = [] then to_remove + let to_remove1 = t.installed -- to_keep in + if atoms = [] then to_remove1 else (* restrict to the dependency cone of removed pkgs *) - to_remove %% - (OpamPackage.Set.of_list - (OpamSolver.dependencies ~build:true ~post:true - ~depopts:true ~installed:true universe to_remove)) + to_remove1 %% + (OpamSolver.dependencies ~build:true ~post:true + ~depopts:true ~installed:true universe to_remove) else to_remove in let t, solution = OpamSolution.resolve_and_apply ?ask t Remove diff --git a/src/client/opamListCommand.ml b/src/client/opamListCommand.ml index 8c6718307d3..852ee93e0d0 100644 --- a/src/client/opamListCommand.ml +++ b/src/client/opamListCommand.ml @@ -232,7 +232,6 @@ let apply_selector ~base st = function ~installed:false ~unavailable:true (get_universe st tog) (packages_of_atoms st atoms) - |> OpamPackage.Set.of_list | Required_by (tog, atoms) -> atom_dependencies st tog atoms |> OpamFormula.packages base @@ -664,14 +663,8 @@ let display st format packages = ~requested:(OpamPackage.names_of_packages packages) Query in - let deps_packages = - OpamSolver.dependencies - ~depopts:true ~installed:false ~unavailable:true - ~build:true ~post:false - universe packages - in - List.filter (fun nv -> OpamPackage.Set.mem nv packages) deps_packages |> - List.rev + OpamSolver.dependency_sort ~depopts:true ~build:true ~post:false + universe packages else match format.order with | `Custom o -> List.sort o (OpamPackage.Set.elements packages) | _ -> OpamPackage.Set.elements packages diff --git a/src/client/opamLockCommand.ml b/src/client/opamLockCommand.ml index 1c3aca35964..253c4697c68 100644 --- a/src/client/opamLockCommand.ml +++ b/src/client/opamLockCommand.ml @@ -113,7 +113,7 @@ let lock_opam ?(only_direct=false) st opam = OpamSolver.dependencies ~depopts:true ~build:true ~post:true ~installed:true univ (OpamPackage.Set.singleton nv) |> - List.filter (fun nv1 -> nv1 <> nv) + OpamPackage.Set.remove nv in let depends = if only_direct then @@ -123,14 +123,14 @@ let lock_opam ?(only_direct=false) st opam = OpamFormula.fold_left (fun acc (n,_) -> OpamPackage.Name.Set.add n acc) OpamPackage.Name.Set.empty in - List.filter (fun nv -> OpamPackage.Name.Set.mem nv.name names) all_depends + OpamPackage.packages_of_names all_depends names else all_depends in let map_of_set x set = OpamPackage.Map.of_list (List.map (fun nv -> nv, x) (OpamPackage.Set.elements set)) in - let depends_map = map_of_set `version (OpamPackage.Set.of_list depends) in + let depends_map = map_of_set `version depends in (* others: dev, test, doc *) let open OpamPackage.Set.Op in let select ?(build=false) ?(test=false) ?(doc=false) ?(dev=false) @@ -153,11 +153,10 @@ let lock_opam ?(only_direct=false) st opam = let depends_map = map_of_set `other installed in if only_direct then depends_map else - ((OpamPackage.Set.of_list - (OpamSolver.dependencies - ~depopts:false ~build:true ~post:true ~installed:true - univ installed)) - -- (OpamPackage.Set.of_list all_depends)) + (OpamSolver.dependencies + ~depopts:false ~build:true ~post:true ~installed:true + univ installed + -- all_depends) |> map_of_set (`other_dep typ) |> OpamPackage.Map.union (fun _v _o -> `other_dep typ) depends_map else @@ -245,17 +244,17 @@ let lock_opam ?(only_direct=false) st opam = (OpamPackage.Name.Set.elements uninstalled_depopts)) in let pin_depends = - OpamStd.List.filter_map (fun nv -> - if not (OpamSwitchState.is_pinned st nv.name) then None else + OpamPackage.Set.fold (fun nv acc -> + if not (OpamSwitchState.is_pinned st nv.name) then acc else match OpamSwitchState.primary_url st nv with - | None -> None + | None -> acc | Some u -> match OpamUrl.local_dir u with | Some d -> let local_warn () = OpamConsole.warning "Dependency %s is pinned to local target %s" (OpamPackage.to_string nv) (OpamUrl.to_string u); - None + acc in (match u.OpamUrl.backend with | #OpamUrl.version_control -> @@ -263,11 +262,12 @@ let lock_opam ?(only_direct=false) st opam = | Some resolved_u -> OpamConsole.note "Local pin %s resolved to %s" (OpamUrl.to_string u) (OpamUrl.to_string resolved_u); - Some (nv, resolved_u) + (nv, resolved_u) :: acc | None -> local_warn ()) | _ -> local_warn ()) - | None -> Some (nv, u)) - all_depends + | None -> (nv, u) :: acc) + all_depends [] + |> List.rev in opam |> OpamFile.OPAM.with_depopts OpamFormula.Empty |> diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml index 076f4b92307..8bec9763b7a 100644 --- a/src/solver/opamCudf.ml +++ b/src/solver/opamCudf.ml @@ -421,6 +421,53 @@ type conflict = module Map = OpamStd.Map.Make(Package) module Set = OpamStd.Set.Make(Package) + +(* From a CUDF dependency CNF, extract the set of packages that can possibly be + part of a solution. + + This is much finer than [Common.CudfAdd.resolve_deps] which doesn't handle + conjunctions of versions (see [Graph.of_universe] below) *) +let dependency_set u deps = + let strong_deps, weak_deps = + (* strong deps are mandatory (constraint appearing in the top + conjunction) + weak deps correspond to optional occurrences of a package, as part of + a disjunction: e.g. in (A>=4 & (B | A<5)), A>=4 is strong, and the + other two are weak. In the end we want to retain B and A>=4. *) + List.fold_left (fun (strong_deps, weak_deps) l -> + let names = + List.fold_left (fun acc (n, _) -> + OpamStd.String.Map.add n Set.empty acc) + OpamStd.String.Map.empty l + in + let set = + List.fold_left (fun acc (n, cstr) -> + List.fold_left (fun s x -> Set.add x s) + acc (Cudf.lookup_packages ~filter:cstr u n)) + Set.empty l + in + let by_name = + Set.fold (fun p -> + OpamStd.String.Map.update + p.Cudf.package (Set.add p) Set.empty) + set names + in + if OpamStd.String.Map.is_singleton by_name then + let name, versions = OpamStd.String.Map.choose by_name in + OpamStd.String.Map.update name (Set.inter versions) versions + strong_deps, + OpamStd.String.Map.remove name weak_deps + else + strong_deps, OpamStd.String.Map.union Set.union weak_deps by_name) + (OpamStd.String.Map.empty, OpamStd.String.Map.empty) deps + in + OpamStd.String.Map.fold (fun _ -> Set.union) strong_deps @@ + OpamStd.String.Map.fold (fun name ps acc -> + if not (OpamStd.String.Map.mem name strong_deps) + then Set.union ps acc else acc) + weak_deps + Set.empty + module Graph = struct module PG = struct @@ -445,44 +492,7 @@ module Graph = struct let g = PG.create ~size:(Cudf.universe_size u) () in let iter_deps f deps = (* List.iter (fun d -> List.iter f (Common.CudfAdd.resolve_deps u d)) deps *) - let strong_deps, weak_deps = - (* strong deps are mandatory (constraint appearing in the top - conjunction) - weak deps correspond to optional occurrences of a package, as part of - a disjunction: e.g. in (A>=4 & (B | A<5)), A>=4 is strong, and the - other two are weak. In the end we want to retain B and A>=4. *) - List.fold_left (fun (strong_deps, weak_deps) l -> - let names = - List.fold_left (fun acc (n, _) -> - OpamStd.String.Map.add n Set.empty acc) - OpamStd.String.Map.empty l - in - let set = - List.fold_left (fun acc (n, cstr) -> - List.fold_left (fun s x -> Set.add x s) - acc (Cudf.lookup_packages ~filter:cstr u n)) - Set.empty l - in - let by_name = - Set.fold (fun p -> - OpamStd.String.Map.update - p.Cudf.package (Set.add p) Set.empty) - set names - in - if OpamStd.String.Map.is_singleton by_name then - let name, versions = OpamStd.String.Map.choose by_name in - OpamStd.String.Map.update name (Set.inter versions) versions - strong_deps, - OpamStd.String.Map.remove name weak_deps - else - strong_deps, OpamStd.String.Map.union Set.union weak_deps by_name) - (OpamStd.String.Map.empty, OpamStd.String.Map.empty) deps - in - OpamStd.String.Map.iter (fun _ p -> Set.iter f p) strong_deps; - OpamStd.String.Map.iter (fun name p -> - if not (OpamStd.String.Map.mem name strong_deps) - then Set.iter f p) - weak_deps + Set.iter f (dependency_set u deps) in Cudf.iter_packages (fun p -> @@ -500,19 +510,8 @@ module Graph = struct let transitive_closure g = PO.O.add_transitive_closure g - let close_and_linearize g pkgs = - let _, l = - Topo.fold - (fun pkg (closure, topo) -> - if Set.mem pkg closure then - closure, pkg :: topo - else if List.exists (fun p -> Set.mem p closure) (PG.pred g pkg) then - Set.add pkg closure, pkg :: topo - else - closure, topo) - g - (pkgs, []) in - l + let linearize g pkgs = + Topo.fold (fun p acc -> if Set.mem p pkgs then p::acc else acc) g [] let mirror = PO.O.mirror @@ -525,22 +524,20 @@ let is_artefact cpkg = is_opam_invariant cpkg || cpkg.Cudf.package = dose_dummy_request -let filter_dependencies f_direction universe packages = - log ~level:3 "filter deps: build graph"; - let graph = f_direction (Graph.of_universe universe) in - let packages = Set.of_list packages in - log ~level:3 "filter deps: close_and_linearize"; - let r = Graph.close_and_linearize graph packages in - log ~level:3 "filter deps: done"; - r - -let dependencies = filter_dependencies (fun x -> x) +let dependencies universe packages = + Set.fixpoint (fun p -> dependency_set universe p.Cudf.depends) packages (* similar to Algo.Depsolver.dependency_closure but with finer results on version sets *) -let reverse_dependencies = filter_dependencies Graph.mirror +let reverse_dependencies universe packages = + let graph = Graph.of_universe universe in + Set.fixpoint (fun p -> Set.of_list (Graph.pred graph p)) packages (* similar to Algo.Depsolver.reverse_dependency_closure but more reliable *) +let dependency_sort universe packages = + let graph = Graph.of_universe universe in + Graph.linearize graph packages |> List.rev + let string_of_atom (p, c) = let const = function | None -> "" @@ -913,12 +910,13 @@ let extract_explanations packages cudfnv2opam unav_reasons reasons = let strings_of_cycles cycles = List.map arrow_concat cycles -let string_of_conflict ?(indent=0) (msg1, msg2, msg3) = - OpamStd.Format.reformat ~start_column:indent ~indent msg1 ^ +let string_of_conflict ?(start_column=0) (msg1, msg2, msg3) = + let width = OpamStd.Sys.terminal_columns () - start_column - 2 in + OpamStd.Format.reformat ~start_column ~indent:2 msg1 ^ OpamStd.List.concat_map ~left:"\n- " ~nil:"" "\n- " - (fun s -> OpamStd.Format.reformat ~indent s) msg2 ^ + (fun s -> OpamStd.Format.reformat ~indent:2 ~width s) msg2 ^ OpamStd.List.concat_map ~left:"\n" ~nil:"" "\n" - (fun s -> OpamStd.Format.reformat ~indent s) msg3 + (fun s -> OpamStd.Format.reformat ~indent:2 ~width s) msg3 let conflict_explanations packages unav_reasons = function | univ, version_map, Conflict_dep reasons -> @@ -945,7 +943,7 @@ let string_of_conflicts packages unav_reasons conflict = if cflts <> [] then Buffer.add_string b (OpamStd.Format.itemize ~bullet:(OpamConsole.colorise `red " * ") - (string_of_conflict ~indent:4) cflts); + (string_of_conflict ~start_column:4) cflts); if cflts = [] && cycles = [] then (* No explanation found *) Printf.bprintf b "Sorry, no solution found: \ @@ -1068,6 +1066,122 @@ let dump_cudf_error ~version_map univ req = | Some f -> f | None -> assert false +let preprocess_cudf_request (props, univ, creq) criteria = + let chrono = OpamConsole.timer () in + let univ0 = univ in + let do_trimming = + match OpamStd.Config.env_bool "CUDFTRIM" with + | Some o -> o + | None -> + (* Trimming is only correct when there is no maximisation criteria, so + automatically set it to true in this case *) + let neg_crit_re = + Re.(seq [char '-'; + rep1 (diff any (set ",[")); + opt (seq [char '['; rep1 (diff any (char ']')); char ']'])]) + in + let all_neg_re = + Re.(whole_string (seq [rep (seq [neg_crit_re; char ',']); + neg_crit_re])) + in + Re.execp (Re.compile all_neg_re) criteria + in + let univ = + let open Set.Op in + let vpkg2set vp = Set.of_list (Common.CudfAdd.resolve_deps univ vp) in + let deps p = dependency_set univ p.Cudf.depends in + let to_install = + vpkg2set creq.Cudf.install + ++ Set.of_list (Cudf.lookup_packages univ opam_invariant_package_name) + 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 = + if do_trimming then + Set.fixpoint deps + (to_install ++ + vpkg2set creq.Cudf.remove ++ + vpkg2set creq.Cudf.upgrade) ++ + Set.of_list (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) univ) + else if OpamStd.Config.env_string "CUDFTRIM" = Some "simple" then + let cone = to_map (Set.fixpoint deps to_install) in + let filter p = match OpamStd.String.Map.find_opt p.Cudf.package cone with + | Some ps -> Set.mem p ps + | None -> true + in + Set.of_list (Cudf.get_packages ~filter univ) + else + Set.of_list (Cudf.get_packages univ) + 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 + (* Don't explore deeper than that for transitive conflicts *) + let max_dig_depth = + match OpamStd.Config.env_int "DIGDEPTH" with + | None -> 2 + | Some i -> i + in + let rec transitive_conflicts seen p = + (* OpamConsole.msg "%s\n" (Package.to_string p); *) + try Hashtbl.find cache p with Not_found -> + if Set.mem p seen || Set.cardinal seen >= max_dig_depth then Set.empty else + let seen = Set.add p seen in + let conflicts = + direct_conflicts p ++ + 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 + log "Conflicts: %a pkgs to remove" + (slog OpamStd.Op.(string_of_int @* Set.cardinal)) conflicts; + Cudf.load_universe (Set.elements (packages -- conflicts)) + in + log "Preprocess cudf request (trimming: %b): from %d to %d packages in %.2fs" + do_trimming + (Cudf.universe_size univ0) + (Cudf.universe_size univ) + (chrono ()); + props, univ, creq + exception Timeout of Algo.Depsolver.solver_result option let call_external_solver ~version_map univ req = @@ -1091,6 +1205,10 @@ let call_external_solver ~version_map univ req = if !timed_out then raise (Timeout (Some r)) else r in try + let cudf_request = + if OpamStd.Config.env_bool "PREPRO" = Some false then cudf_request + else preprocess_cudf_request cudf_request criteria + in let r = check_request_using ~call_solver:(OpamSolverConfig.call_solver ~criteria) @@ -1169,22 +1287,22 @@ let get_final_universe ~version_map univ req = Success (Cudf.load_universe []) | Algo.Depsolver.Error str -> fail str | Algo.Depsolver.Unsat r -> - OpamConsole.error - "The solver (%s) pretends there is no solution while that's apparently \ - false.\n\ - This is likely an issue with the solver interface, please try a \ - different solver and report if you were using a supported one." - (let module Solver = (val OpamSolverConfig.(Lazy.force !r.solver)) in - Solver.name); + let msg = + Printf.sprintf + "The solver (%s) pretends there is no solution while that's apparently \ + false.\n\ + This is likely an issue with the solver interface, please try a \ + different solver and report if you were using a supported one." + (let module Solver = (val OpamSolverConfig.(Lazy.force !r.solver)) in + Solver.name) + in match r with | Some ({Algo.Diagnostic.result = Algo.Diagnostic.Failure _; _} as r) -> + OpamConsole.error "%s" msg; make_conflicts ~version_map univ r | Some {Algo.Diagnostic.result = Algo.Diagnostic.Success _; _} | None -> - raise (Solver_failure - "The current solver could not find a solution but dose3 could. \ - This is probably a bug in the current solver. Please file a bug-report \ - on the opam bug tracker: https://github.com/ocaml/opam/issues/") + raise (Solver_failure msg) let diff univ sol = let before = @@ -1412,7 +1530,7 @@ let compute_root_causes g requested reinstall = required reinstallations and computing the graph of dependency of required actions *) let atomic_actions ~simple_universe ~complete_universe root_actions = - log "graph_of_actions root_actions=%a" + log ~level:2 "graph_of_actions root_actions=%a" (slog string_of_actions) root_actions; let to_remove, to_install = diff --git a/src/solver/opamCudf.mli b/src/solver/opamCudf.mli index 18a28542681..04cb8465ddd 100644 --- a/src/solver/opamCudf.mli +++ b/src/solver/opamCudf.mli @@ -42,10 +42,6 @@ module Graph: sig (** Return the transitive closure of [g] *) val transitive_closure: t -> t - (** Return the transitive closure of dependencies of [set], - sorted in topological order. *) - val close_and_linearize: t -> Set.t -> Cudf.package list - (** Reverse the direction of all edges *) val mirror: t -> t end @@ -62,13 +58,15 @@ module ActionGraph: OpamActionGraph.SIG with type package = Package.t (** Abstract type that may be returned in case of conflicts *) type conflict -(** Return the transitive closure of dependencies of [set], - sorted in topological order *) -val dependencies: Cudf.universe -> Cudf.package list -> Cudf.package list +(** Return the transitive closure of dependencies of [set] *) +val dependencies: Cudf.universe -> Set.t -> Set.t + +(** Return the transitive closure of reverse dependencies of [set] *) +val reverse_dependencies: Cudf.universe -> Set.t -> Set.t -(** Return the transitive closure of dependencies of [set], - sorted in topological order *) -val reverse_dependencies: Cudf.universe -> Cudf.package list -> Cudf.package list +(** Sorts the given packages topolgically (be careful if there are cycles, e.g. + if the universe was loaded with [post] dependencies enabled) *) +val dependency_sort: Cudf.universe -> Set.t -> Cudf.package list (** Check if a request is satisfiable and return the reasons why not unless [explain] is set to [false] *) @@ -223,7 +221,7 @@ val conflict_explanations: (** Properly concat a single conflict as returned by [conflict_explanations] for display *) val string_of_conflict: - ?indent:int -> string * string list * string list -> string + ?start_column:int -> string * string list * string list -> string (** Dumps the given cudf universe to the given channel *) val dump_universe: out_channel -> Cudf.universe -> unit diff --git a/src/solver/opamSolver.ml b/src/solver/opamSolver.ml index c08f74f3992..f1c11ddf918 100644 --- a/src/solver/opamSolver.ml +++ b/src/solver/opamSolver.ml @@ -102,6 +102,8 @@ let constraint_to_cudf version_map name (op,v) = (this shouldn't happen for any constraint in the universe, now that we compute a full version map, but may still happen for user-provided constraints) *) + log "Warn: fallback constraint for %s" + (OpamFormula.string_of_atom (name, Some (op,v))); let all_versions = OpamPackage.Map.filter (fun nv _ -> nv.name = name) version_map in @@ -568,7 +570,7 @@ let dependency_graph let filter_dependencies f_direction ~depopts ~build ~post ~installed ?(unavailable=false) universe packages = - if OpamPackage.Set.is_empty packages then [] else + if OpamPackage.Set.is_empty packages then OpamPackage.Set.empty else let u_packages = packages ++ if installed then universe.u_installed else @@ -581,19 +583,35 @@ let filter_dependencies load_cudf_universe ~depopts ~build ~post universe ~version_map u_packages () in let cudf_packages = - opam2cudf universe ~depopts ~build ~post version_map packages + OpamCudf.Set.of_list + (opam2cudf universe ~depopts ~build ~post version_map packages) in log ~level:3 "filter_dependencies: dependency"; - let topo_packages = f_direction cudf_universe cudf_packages in - let result = List.rev_map OpamCudf.cudf2opam topo_packages in + let clos_packages = f_direction cudf_universe cudf_packages in + let result = + OpamCudf.Set.fold (fun cp -> OpamPackage.Set.add (OpamCudf.cudf2opam cp)) + clos_packages OpamPackage.Set.empty + in log "filter_dependencies result=%a" - (slog (OpamStd.List.to_string OpamPackage.to_string)) result; + (slog OpamPackage.Set.to_string) result; result 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) + 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 = diff --git a/src/solver/opamSolver.mli b/src/solver/opamSolver.mli index 0feef6dc421..d8852041e63 100644 --- a/src/solver/opamSolver.mli +++ b/src/solver/opamSolver.mli @@ -92,7 +92,7 @@ val installable: universe -> package_set (** Like [installable], but within a subset and potentially much faster *) val installable_subset: universe -> package_set -> package_set -(** Return the topological sort of the transitive dependency closures +(** Return the transitive dependency closures of a collection of packages.*) val dependencies : depopts:bool -> build:bool -> post:bool -> @@ -100,7 +100,7 @@ val dependencies : ?unavailable:bool -> universe -> package_set -> - package list + package_set (** Same as [dependencies] but for reverse dependencies *) val reverse_dependencies : @@ -109,6 +109,14 @@ val reverse_dependencies : ?unavailable:bool -> universe -> package_set -> + package_set + +(** Sorts the given package set in topological order (as much as possible, + beware of cycles in particular if [post] is [true]) *) +val dependency_sort : + depopts:bool -> build:bool -> post:bool -> + universe -> + package_set -> package list module PkgGraph: Graph.Sig.I diff --git a/src/state/opamSwitchState.ml b/src/state/opamSwitchState.ml index 484dc63acf5..10326d88fc5 100644 --- a/src/state/opamSwitchState.ml +++ b/src/state/opamSwitchState.ml @@ -314,7 +314,6 @@ let load lock_kind gt rt switch = let opams = OpamPackage.Map.union (fun _ x -> x) repos_package_index pinned_opams in - let packages = OpamPackage.keys opams in let available_packages = lazy (compute_available_packages gt switch switch_config ~pinned ~opams) @@ -324,6 +323,7 @@ let load lock_kind gt rt switch = computing availability *) OpamPackage.Map.union (fun _ x -> x) installed_opams opams in + let packages = OpamPackage.keys opams in let installed_without_def = OpamPackage.Set.fold (fun nv nodef -> if OpamPackage.Map.mem nv installed_opams then nodef else