diff --git a/opam-0install-cudf.opam b/opam-0install-cudf.opam index 9cf1621..ab00cbe 100644 --- a/opam-0install-cudf.opam +++ b/opam-0install-cudf.opam @@ -25,6 +25,7 @@ depends: [ "cudf" {>= "0.10"} "ocaml" {>= "4.08.0"} "0install-solver" {>= "2.18"} + "alcotest" {with-test} ] build: ["dune" "build" "-p" name "-j" jobs] run-test: ["dune" "test" "-p" name "-j" jobs] diff --git a/src/opam_0install_cudf.ml b/src/opam_0install_cudf.ml index 878a49f..cdc2d41 100644 --- a/src/opam_0install_cudf.ml +++ b/src/opam_0install_cudf.ml @@ -1,11 +1,33 @@ +let tagged_with_avoid_version pkg = + List.exists (function + | "avoid-version", (`Int 1 | `Bool true) -> true + | _ -> false + ) pkg.Cudf.pkg_extra + +let version_rev_compare ~prefer_oldest ~handle_avoid_version = + 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 + module Context = struct type rejection = UserConstraint of Cudf_types.vpkg type t = { universe : Cudf.universe; constraints : (Cudf_types.pkgname * (Cudf_types.relop * Cudf_types.version)) list; - prefer_oldest : bool; fresh_id : int ref; + version_rev_compare : Cudf.package -> Cudf.package -> int; } let user_restrictions t name = @@ -16,19 +38,13 @@ module Context = struct acc ) [] t.constraints - let version_compare t pkg1 pkg2 = - if t.prefer_oldest then - compare (pkg1.Cudf.version : int) pkg2.Cudf.version - else - compare (pkg2.Cudf.version : int) pkg1.Cudf.version - let candidates t name = let user_constraints = user_restrictions t name in match Cudf.lookup_packages t.universe name with | [] -> [] (* Package not found *) | versions -> - List.fast_sort (version_compare t) versions (* Higher versions are preferred. *) + List.fast_sort t.version_rev_compare versions (* Higher versions are preferred. *) |> List.map (fun pkg -> let rec check_constr = function | [] -> (pkg.Cudf.version, Ok pkg) @@ -74,8 +90,13 @@ type t = Context.t type selections = Solver.Output.t type diagnostics = Input.requirements (* So we can run another solve *) -let create ?(prefer_oldest=false) ~constraints universe = - { Context.universe; constraints; prefer_oldest; fresh_id = ref 0 } +let create ?(prefer_oldest=false) ?(handle_avoid_version=true) ~constraints universe = + { + Context.universe; + constraints; + fresh_id = ref 0; + version_rev_compare = version_rev_compare ~prefer_oldest ~handle_avoid_version; + } let solve context pkgs = let req = requirements ~context pkgs in diff --git a/src/opam_0install_cudf.mli b/src/opam_0install_cudf.mli index 08fe1eb..fb1ecec 100644 --- a/src/opam_0install_cudf.mli +++ b/src/opam_0install_cudf.mli @@ -6,6 +6,7 @@ type diagnostics val create : ?prefer_oldest:bool -> + ?handle_avoid_version:bool -> constraints:(Cudf_types.pkgname * (Cudf_types.relop * Cudf_types.version)) list -> Cudf.universe -> t diff --git a/test/cudf/dune b/test/cudf/dune new file mode 100644 index 0000000..beefe6b --- /dev/null +++ b/test/cudf/dune @@ -0,0 +1,4 @@ +(test + (name test) + (package opam-0install-cudf) + (libraries alcotest opam-0install-cudf)) diff --git a/test/cudf/test.ml b/test/cudf/test.ml new file mode 100644 index 0000000..323aea8 --- /dev/null +++ b/test/cudf/test.ml @@ -0,0 +1,87 @@ +let universe = + Cudf.load_universe [ + {Cudf.default_package with package = "a"; version = 1}; + {Cudf.default_package with package = "a"; version = 2}; + {Cudf.default_package with package = "a"; version = 3}; + {Cudf.default_package with package = "a"; version = 4}; + + {Cudf.default_package with package = "b"; version = 1}; + {Cudf.default_package with package = "b"; version = 2; pkg_extra = [("avoid-version", `Int 1)]}; + {Cudf.default_package with package = "b"; version = 3; pkg_extra = [("avoid-version", `Int 0)]}; + {Cudf.default_package with package = "b"; version = 4}; + + {Cudf.default_package with package = "c"; version = 1; pkg_extra = [("avoid-version", `Int 1)]}; + {Cudf.default_package with package = "c"; version = 2}; + {Cudf.default_package with package = "c"; version = 3}; + {Cudf.default_package with package = "c"; version = 4; pkg_extra = [("avoid-version", `Int 0)]}; + + {Cudf.default_package with package = "d"; version = 1; pkg_extra = [("avoid-version", `Int 0)]}; + {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)]}; + ] + +let solve ?prefer_oldest req = + let x = Opam_0install_cudf.create ?prefer_oldest ~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) + +let simple_solve () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("a", 4)]) + (solve [("a", `Essential)]) + +let simple_oldest () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("a", 1)]) + (solve ~prefer_oldest:true [("a", `Essential)]) + +let simple_avoid_1 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("b", 4)]) + (solve [("b", `Essential)]) + +let oldest_avoid_1 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("b", 1)]) + (solve ~prefer_oldest:true [("b", `Essential)]) + +let simple_avoid_2 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("c", 4)]) + (solve [("c", `Essential)]) + +let oldest_avoid_2 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("c", 2)]) + (solve ~prefer_oldest:true [("c", `Essential)]) + +let simple_avoid_3 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("d", 3)]) + (solve [("d", `Essential)]) + +let oldest_avoid_3 () = + Alcotest.(check (result (list (pair string int)) string)) + "equal" (Ok [("d", 1)]) + (solve ~prefer_oldest:true [("d", `Essential)]) + +let () = + Alcotest.run "cudf" + [ + ( "simple solve", + [ + Alcotest.test_case "normal" `Quick simple_solve; + Alcotest.test_case "oldest" `Quick simple_oldest; + ] ); + ( "avoid-version", + [ + Alcotest.test_case "normal 1" `Quick simple_avoid_1; + Alcotest.test_case "oldest 1" `Quick oldest_avoid_2; + Alcotest.test_case "normal 2" `Quick simple_avoid_2; + Alcotest.test_case "oldest 2" `Quick oldest_avoid_2; + Alcotest.test_case "normal 3" `Quick simple_avoid_3; + Alcotest.test_case "oldest 3" `Quick oldest_avoid_3; + ] ); + ]