From 40582d40e2f6285625f531f16190fb564e01afa1 Mon Sep 17 00:00:00 2001 From: Kate Date: Fri, 28 Jan 2022 02:52:25 +0000 Subject: [PATCH] Add an option to encourage keeping installed packages if possible --- src/opam_0install_cudf.ml | 36 ++++++++++++++++++-------- src/opam_0install_cudf.mli | 9 ++++++- test/cudf/test.ml | 53 ++++++++++++++++++++++++++++++++++++-- 3 files changed, 84 insertions(+), 14 deletions(-) diff --git a/src/opam_0install_cudf.ml b/src/opam_0install_cudf.ml index cdc2d41..93f71df 100644 --- a/src/opam_0install_cudf.ml +++ b/src/opam_0install_cudf.ml @@ -4,21 +4,35 @@ let tagged_with_avoid_version pkg = | _ -> false ) pkg.Cudf.pkg_extra -let version_rev_compare ~prefer_oldest ~handle_avoid_version = +let version_rev_compare ~prefer_oldest ~handle_avoid_version ~prefer_installed = + (* cmp ordered from least important to most important setting *) let cmp = if prefer_oldest then fun pkg1 pkg2 -> Int.compare pkg1.Cudf.version pkg2.Cudf.version else fun pkg1 pkg2 -> Int.compare pkg2.Cudf.version pkg1.Cudf.version in - if handle_avoid_version then - fun pkg1 pkg2 -> - match tagged_with_avoid_version pkg1, tagged_with_avoid_version pkg2 with - | true, true | false, false -> cmp pkg1 pkg2 - | true, false -> 1 - | false, true -> -1 - else - cmp + let cmp = + if handle_avoid_version then + fun pkg1 pkg2 -> + match tagged_with_avoid_version pkg1, tagged_with_avoid_version pkg2 with + | true, true | false, false -> cmp pkg1 pkg2 + | true, false -> 1 + | false, true -> -1 + else + cmp + in + let cmp = + if prefer_installed then + fun pkg1 pkg2 -> + match pkg1.Cudf.installed, pkg2.Cudf.installed with + | true, true | false, false -> cmp pkg1 pkg2 + | true, false -> -1 + | false, true -> 1 + else + cmp + in + cmp module Context = struct type rejection = UserConstraint of Cudf_types.vpkg @@ -90,12 +104,12 @@ type t = Context.t type selections = Solver.Output.t type diagnostics = Input.requirements (* So we can run another solve *) -let create ?(prefer_oldest=false) ?(handle_avoid_version=true) ~constraints universe = +let create ?(prefer_oldest=false) ?(handle_avoid_version=true) ?(prefer_installed=false) ~constraints universe = { Context.universe; constraints; fresh_id = ref 0; - version_rev_compare = version_rev_compare ~prefer_oldest ~handle_avoid_version; + version_rev_compare = version_rev_compare ~prefer_oldest ~handle_avoid_version ~prefer_installed; } let solve context pkgs = diff --git a/src/opam_0install_cudf.mli b/src/opam_0install_cudf.mli index fb1ecec..fcf791a 100644 --- a/src/opam_0install_cudf.mli +++ b/src/opam_0install_cudf.mli @@ -7,6 +7,7 @@ type diagnostics val create : ?prefer_oldest:bool -> ?handle_avoid_version:bool -> + ?prefer_installed:bool -> constraints:(Cudf_types.pkgname * (Cudf_types.relop * Cudf_types.version)) list -> Cudf.universe -> t @@ -16,7 +17,13 @@ val create : @param prefer_oldest if [true] the solver is set to return the least up-to-date version of each package, if a solution exists. This is [false] by default. - @before 0.4 the [prefer_oldest] parameter did not exist. *) + @before 0.4 the [prefer_oldest] parameter did not exist. + + @param prefer_installed if [true] the solver will try to prioritize keeping + the versions of packages installed at their current version instead of + the latest possible version. + This is [false] by default. + @before 0.5 the [prefer_installed] parameter did not exist. *) val solve : t -> diff --git a/test/cudf/test.ml b/test/cudf/test.ml index 323aea8..bfa6c65 100644 --- a/test/cudf/test.ml +++ b/test/cudf/test.ml @@ -19,10 +19,20 @@ let universe = {Cudf.default_package with package = "d"; version = 2}; {Cudf.default_package with package = "d"; version = 3}; {Cudf.default_package with package = "d"; version = 4; pkg_extra = [("avoid-version", `Int 1)]}; + + {Cudf.default_package with package = "e"; version = 1}; + {Cudf.default_package with package = "e"; version = 2; installed = true}; + {Cudf.default_package with package = "e"; version = 3}; + {Cudf.default_package with package = "e"; version = 4}; + + {Cudf.default_package with package = "f"; version = 1}; + {Cudf.default_package with package = "f"; version = 2}; + {Cudf.default_package with package = "f"; version = 3}; + {Cudf.default_package with package = "f"; version = 4; installed = true; pkg_extra = [("avoid-version", `Int 1)]}; ] -let solve ?prefer_oldest req = - let x = Opam_0install_cudf.create ?prefer_oldest ~constraints:[] universe in +let solve ?prefer_oldest ?prefer_installed req = + let x = Opam_0install_cudf.create ?prefer_oldest ?prefer_installed ~constraints:[] universe in match Opam_0install_cudf.solve x req with | Ok sel -> Ok (Opam_0install_cudf.packages_of_result sel) | Error diag -> Error (Opam_0install_cudf.diagnostics ~verbose:true diag) @@ -67,6 +77,36 @@ let oldest_avoid_3 () = "equal" (Ok [("d", 1)]) (solve ~prefer_oldest:true [("d", `Essential)]) +let prefer_installed_1 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("e", 2)]) + (solve ~prefer_installed:true [("e", `Essential)]) + +let prefer_installed_2 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("e", 2)]) + (solve ~prefer_installed:true [("e", `Recommended)]) + +let prefer_installed_3 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("e", 4)]) + (solve [("e", `Essential)]) + +let prefer_installed_4 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("e", 4)]) + (solve [("e", `Recommended)]) + +let prefer_installed_5 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("f", 4)]) + (solve ~prefer_installed:true [("f", `Essential)]) + +let prefer_installed_6 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("f", 3)]) + (solve [("f", `Essential)]) + let () = Alcotest.run "cudf" [ @@ -84,4 +124,13 @@ let () = Alcotest.test_case "normal 3" `Quick simple_avoid_3; Alcotest.test_case "oldest 3" `Quick oldest_avoid_3; ] ); + ( "keep-installed", + [ + Alcotest.test_case "normal 1" `Quick prefer_installed_1; + Alcotest.test_case "normal 2" `Quick prefer_installed_2; + Alcotest.test_case "normal 3" `Quick prefer_installed_3; + Alcotest.test_case "normal 4" `Quick prefer_installed_4; + Alcotest.test_case "avoid-version=1" `Quick prefer_installed_5; + Alcotest.test_case "keep-installed=0, avoid-version=1" `Quick prefer_installed_6; + ] ); ]