From 51e35215d43724bc7257a0d2be6bf619ed32194a Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Mon, 24 Jun 2019 17:38:42 +0200 Subject: [PATCH] Add a 'switch invariant' in switch-config that is enforced by the solver --- src/client/opamAdminCheck.ml | 1 + src/format/opamFile.ml | 6 +++++ src/format/opamFile.mli | 1 + src/format/opamTypes.mli | 1 + src/solver/opamCudf.ml | 46 +++++++++++++++++++++++++++------- src/solver/opamCudf.mli | 6 +++++ src/solver/opamSolver.ml | 31 ++++++++++++++++++++--- src/state/opamFormatUpgrade.ml | 1 + src/state/opamStateTypes.mli | 7 +++++- src/state/opamSwitchAction.ml | 3 ++- src/state/opamSwitchState.ml | 7 +++++- 11 files changed, 95 insertions(+), 15 deletions(-) diff --git a/src/client/opamAdminCheck.ml b/src/client/opamAdminCheck.ml index 4f8f02965e9..933d4e566d2 100644 --- a/src/client/opamAdminCheck.ml +++ b/src/client/opamAdminCheck.ml @@ -58,6 +58,7 @@ let get_universe ~with_test ~with_doc ~dev opams = u_installed_roots = OpamPackage.Set.empty; u_pinned = OpamPackage.Set.empty; u_base = OpamPackage.Set.empty; + u_invariant = OpamFormula.Empty; u_attrs = []; u_reinstall = OpamPackage.Set.empty; } diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index 3b8c5c535c2..23413812aaa 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -1499,6 +1499,7 @@ module Switch_configSyntax = struct opam_root: dirname option; wrappers: Wrappers.t; env: env_update list; + invariant: OpamFormula.t; } let empty = { @@ -1510,6 +1511,7 @@ module Switch_configSyntax = struct opam_root = None; wrappers = Wrappers.empty; env = []; + invariant = OpamFormula.Empty; } (* When adding a field or section, make sure to add it in @@ -1548,6 +1550,10 @@ module Switch_configSyntax = struct "setenv", Pp.ppacc (fun env t -> {t with env}) (fun t -> t.env) (Pp.V.map_list ~depth:2 Pp.V.env_binding); + "invariant", Pp.ppacc + (fun invariant t -> {t with invariant}) (fun t -> t.invariant) + (Pp.V.package_formula `Conj Pp.V.(constraints version)); + ] @ List.map (fun (fld, ppacc) -> diff --git a/src/format/opamFile.mli b/src/format/opamFile.mli index f965622381a..4150f641c2f 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -908,6 +908,7 @@ module Switch_config: sig opam_root: dirname option; wrappers: Wrappers.t; env: env_update list; + invariant: OpamFormula.t; } val variable: t -> variable -> variable_contents option val path: t -> std_path -> string option diff --git a/src/format/opamTypes.mli b/src/format/opamTypes.mli index 4e71bd12190..c74606789fc 100644 --- a/src/format/opamTypes.mli +++ b/src/format/opamTypes.mli @@ -296,6 +296,7 @@ type universe = { u_installed_roots: package_set; u_pinned : package_set; u_base : package_set; + u_invariant: formula; u_reinstall: package_set; u_attrs : (string * package_set) list; } diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml index 2c4e4e003fa..20ca830fefa 100644 --- a/src/solver/opamCudf.ml +++ b/src/solver/opamCudf.ml @@ -23,7 +23,19 @@ let s_installed_root = "installed-root" let s_pinned = "pinned" let s_version_lag = "version-lag" +let opam_invariant_package_name = + Common.CudfAdd.encode "=opam-invariant" + +let opam_invariant_package_version = 0 + +let is_opam_invariant p = + p.Cudf.package = opam_invariant_package_name + let cudf2opam cpkg = + if is_opam_invariant cpkg then + OpamConsole.error_and_exit `Internal_error + "Internal error: tried to access the CUDF opam invariant as an opam \ + package"; let sname = Cudf.lookup_package_property cpkg s_source in let name = OpamPackage.Name.of_string sname in let sver = Cudf.lookup_package_property cpkg s_source_number in @@ -506,7 +518,9 @@ end (** Special package used by Dose internally, should generally be filtered out *) let dose_dummy_request = Algo.Depsolver.dummy_request.Cudf.package -let is_dose_request cpkg = cpkg.Cudf.package = dose_dummy_request +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"; @@ -601,9 +615,12 @@ let strings_of_reasons packages cudfnv2opam unav_reasons rs = let rec aux = function | [] -> [] | Conflict (i,j,jc)::rs -> - if is_dose_request i || is_dose_request j then - let a = if is_dose_request i then j else i in - if is_dose_request a then aux rs else + if is_artefact i && is_artefact j then + let str = "The request is conflicting with the switch" in + str :: aux rs + else if is_artefact i || is_artefact j then + let a = if is_artefact i then j else i in + if is_artefact a then aux rs else if is_base a then let str = Printf.sprintf "Package %s is part of the base for this compiler \ @@ -652,7 +669,7 @@ let strings_of_reasons packages cudfnv2opam unav_reasons rs = (OpamFormula.of_atom_formula (Atom (vpkg2atom cudfnv2opam jc)))) in str :: aux rs - | Missing (p,missing) :: rs when is_dose_request p -> + | Missing (p,missing) :: rs when is_artefact p -> (* Requested pkg missing *) let atoms = List.map (fun vp -> @@ -687,12 +704,12 @@ let make_chains packages cudfnv2opam depends = with Not_found -> Map.add k v map in let roots,notroots,deps,vpkgs = List.fold_left (fun (roots,notroots,deps,vpkgs) -> function - | Dependency (i, vpkgl, jl) when not (is_dose_request i) -> + | Dependency (i, vpkgl, jl) when not (is_artefact i) -> Set.add i roots, List.fold_left (fun notroots j -> Set.add j notroots) notroots jl, map_addlist i jl deps, map_addlist i vpkgl vpkgs - | Missing (i, vpkgl) when not (is_dose_request i) -> + | Missing (i, vpkgl) when not (is_artefact i) -> let jl = List.map (fun (package,_) -> {Cudf.default_package with Cudf.package}) @@ -1049,8 +1066,19 @@ let actions_of_diff (install, remove) = let resolve ~extern ~version_map universe request = log "resolve request=%a" (slog string_of_request) request; - if extern then get_final_universe ~version_map universe request - else check_request ~version_map universe request + let resp = + if extern then get_final_universe ~version_map universe request + else check_request ~version_map universe request + in + let cleanup univ = + Cudf.remove_package univ + (opam_invariant_package_name, opam_invariant_package_version) + in + let () = match resp with + | Success univ -> cleanup univ + | Conflicts (univ, _, _) -> cleanup univ + in + resp let to_actions f universe result = let aux u1 u2 = diff --git a/src/solver/opamCudf.mli b/src/solver/opamCudf.mli index a23091a1466..335d2745b14 100644 --- a/src/solver/opamCudf.mli +++ b/src/solver/opamCudf.mli @@ -183,6 +183,12 @@ val s_pinned: string (** the number of versions of the package since this one, cubed *) val s_version_lag: string +(** valid cudf name for the dummy package used for enforcing opam's switch + invariants *) +val opam_invariant_package_name: string + +val is_opam_invariant: Cudf.package -> bool + (** {2 Pretty-printing} *) (** Convert a package constraint to something readable. *) diff --git a/src/solver/opamSolver.ml b/src/solver/opamSolver.ml index 4cef1e66c02..14aadaf4141 100644 --- a/src/solver/opamSolver.ml +++ b/src/solver/opamSolver.ml @@ -32,6 +32,7 @@ let empty_universe = u_installed_roots = OpamPackage.Set.empty; u_pinned = OpamPackage.Set.empty; u_base = OpamPackage.Set.empty; + u_invariant = OpamFormula.Empty; u_reinstall = OpamPackage.Set.empty; u_attrs = []; } @@ -130,6 +131,26 @@ let atom2cudf _universe (version_map : int OpamPackage.Map.t) (name,cstr) = name_to_cudf name, OpamStd.Option.Op.(cstr >>= constraint_to_cudf version_map name) +let opam_invariant_package version_map invariant = + let depends = + OpamFormula.to_atom_formula invariant + |> OpamFormula.map (fun at -> Atom (atom2cudf () version_map at)) + |> OpamFormula.cnf_of_formula + |> OpamFormula.ands_to_list + |> List.map (OpamFormula.fold_right (fun acc x -> x::acc) []) + in { + Cudf. + package = OpamCudf.opam_invariant_package_name; + version = 0; + depends; + conflicts = []; + provides = []; + installed = true; + was_installed = true; + keep = `Keep_version; + pkg_extra = []; + } + let lag_function = let exp = OpamStd.Option.default 1 (OpamStd.Config.env_int "VERSIONLAGPOWER") @@ -314,9 +335,7 @@ let load_cudf_universe post; let chrono = OpamConsole.timer () in let cudf_universe = - let cudf_packages = - univ_gen ~depopts ~build ~post - in + let cudf_packages = 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 -> @@ -424,7 +443,13 @@ let resolve universe ~orphans request = let cudf_request = map_request (atom2cudf universe version_map) request in let resolve u req = try + let invariant_pkg = + opam_invariant_package version_map universe.u_invariant + in + Cudf.add_package u invariant_pkg; let resp = OpamCudf.resolve ~extern:true ~version_map u req in + Cudf.remove_package u + (invariant_pkg.Cudf.package, invariant_pkg.Cudf.version); OpamCudf.to_actions add_orphan_packages u resp with OpamCudf.Solver_failure msg -> OpamConsole.error_and_exit `Solver_failure "%s" msg diff --git a/src/state/opamFormatUpgrade.ml b/src/state/opamFormatUpgrade.ml index d507c08110a..16805c01da7 100644 --- a/src/state/opamFormatUpgrade.ml +++ b/src/state/opamFormatUpgrade.ml @@ -937,6 +937,7 @@ let from_2_0_alpha2_to_2_0_alpha3 root conf = repos = None; opam_root; paths; variables; wrappers = OpamFile.Wrappers.empty; env = []; + invariant = OpamFormula.Empty; } in OpamFile.Switch_config.write (OpamFile.make new_config_file) new_config; diff --git a/src/state/opamStateTypes.mli b/src/state/opamStateTypes.mli index 181066804cf..80587b46d25 100644 --- a/src/state/opamStateTypes.mli +++ b/src/state/opamStateTypes.mli @@ -96,8 +96,13 @@ type +'lock switch_state = { switch: switch; (** The current active switch *) + switch_invariant: formula; + (** Defines the "base" of the switch, e.g. what compiler is desired *) + compiler_packages: package_set; - (** The packages that form the base of the current compiler *) + (** The packages that form the base of the current compiler. Normally equal to + the subset of installed packages matching the invariant defined in + switch_config *) switch_config: OpamFile.Switch_config.t; (** The configuration file for this switch *) diff --git a/src/state/opamSwitchAction.ml b/src/state/opamSwitchAction.ml index c4373814c9d..12ee4498421 100644 --- a/src/state/opamSwitchAction.ml +++ b/src/state/opamSwitchAction.ml @@ -35,7 +35,8 @@ let gen_switch_config root ?(synopsis="") ?repos _switch = opam_root = Some root; repos; wrappers = OpamFile.Wrappers.empty; - env = []; } + env = []; + invariant = OpamFormula.Empty } let install_switch_config root switch config = log "install_switch_config switch=%a" (slog OpamSwitch.to_string) switch; diff --git a/src/state/opamSwitchState.ml b/src/state/opamSwitchState.ml index 1d92bad482c..3b63838d964 100644 --- a/src/state/opamSwitchState.ml +++ b/src/state/opamSwitchState.ml @@ -233,6 +233,9 @@ let load lock_kind gt rt switch = conf else switch_config in + let switch_invariant = + switch_config.OpamFile.Switch_config.invariant + in let conf_files = OpamPackage.Set.fold (fun nv acc -> OpamPackage.Name.Map.add nv.name @@ -293,7 +296,7 @@ let load lock_kind gt rt switch = switch_global = (gt :> unlocked global_state); switch_repos = (rt :> unlocked repos_state); switch_lock = lock; - switch; compiler_packages; switch_config; + switch; switch_invariant; compiler_packages; switch_config; repos_package_index; installed_opams; installed; pinned; installed_roots; opams; conf_files; @@ -324,6 +327,7 @@ let load_virtual ?repos_list ?(avail_default=true) gt rt = switch_repos = (rt :> unlocked repos_state); switch_lock = OpamSystem.lock_none; switch = OpamSwitch.unset; + switch_invariant = OpamFormula.Empty; compiler_packages = OpamPackage.Set.empty; switch_config = { OpamFile.Switch_config.empty @@ -636,6 +640,7 @@ let universe st u_installed_roots = st.installed_roots; u_pinned = OpamPinned.packages st; u_base = base; + u_invariant = st.switch_invariant; u_reinstall; u_attrs = ["opam-query", requested_allpkgs]; }