Merge pull request #2 from kit-ty-kate/avoid-version-2

Add support for the avoid-version flag

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]

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

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

test/cudf/dune

@@ -0,0 +1,4 @@
+(test
+ (name test)
+ (package opam-0install-cudf)
+ (libraries alcotest opam-0install-cudf))

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;
+        ] );
+    ]