Handle unavailable packages through a cusom dependency

src/solver/opamCudf.ml

@@ -34,6 +34,12 @@ let opam_invariant_package =
 let is_opam_invariant p =
   p.Cudf.package = opam_invariant_package_name
 
+let unavailable_package_name =
+  Dose_common.CudfAdd.encode "=unavailable"
+let unavailable_package_version = 1
+let unavailable_package = unavailable_package_name, unavailable_package_version
+let is_unavailable_package p = p.Cudf.package = unavailable_package_name
+
 let cudf2opam cpkg =
   if is_opam_invariant cpkg then
     OpamConsole.error_and_exit `Internal_error
@@ -933,9 +939,21 @@ let extract_explanations packages cudfnv2opam reasons : explanation list =
               msg :: explanations, ct_chains
           | Missing (p, deps) ->
             let ct_chains, csp = cst ~hl_last:false ct_chains p in
-            let fdeps = formula_of_vpkgl cudfnv2opam packages deps in
-            let sdeps = OpamFormula.to_string fdeps in
-            let msg = `Missing (Some csp, sdeps, fdeps) in
+            let msg =
+              if List.exists
+                  (fun (name, _) -> name = unavailable_package_name)
+                  deps
+              then
+                let msg =
+                  Printf.sprintf "%s: no longer available"
+                    (OpamPackage.to_string (cudf2opam p))
+                in
+                `Missing (Some csp, msg, OpamFormula.Empty)
+              else
+              let fdeps = formula_of_vpkgl cudfnv2opam packages deps in
+              let sdeps = OpamFormula.to_string fdeps in
+              `Missing (Some csp, sdeps, fdeps)
+            in
             if List.mem msg explanations then raise Not_found else
               msg :: explanations, ct_chains
           | Dependency _ ->
@@ -1481,9 +1499,9 @@ let resolve ~extern ~version_map universe request =
   in
   resp
 
-let to_actions f universe result =
+let to_actions universe result =
   let aux u1 u2 =
-    let diff = diff (f u1) u2 in
+    let diff = diff u1 u2 in
     actions_of_diff diff
   in
   map_success (aux universe) result
@@ -1552,11 +1570,11 @@ let compute_root_causes g requested reinstall available =
       List.fold_left (fun l a -> if List.mem a l then l else a::l)
     in
     match c1, c2 with
+    | Unavailable, _ | _, Unavailable -> Unavailable, depth1
     | Required_by a, Required_by b -> Required_by (a @ b), depth1
     | Use a, Use b -> Use (a @ b), depth1
     | Conflicts_with a, Conflicts_with b -> Conflicts_with (a @ b), depth1
     | Requested, a | a, Requested
-    | Unavailable, a | a, Unavailable
     | Unknown, a | a, Unknown
     | Upstream_changes , a | a, Upstream_changes -> a, depth1
     | _, c -> c, depth1
@@ -1641,6 +1659,15 @@ let compute_root_causes g requested reinstall available =
             | _ -> false)
       else (Map.map (fun _ -> Requested, 0) requested_actions) in
     get_causes causes roots in
+  let causes =
+    (* Compute causes for no longer available packages *)
+    let roots =
+      make_roots causes Unavailable (function
+          | `Remove p | `Change (_,p,_) ->
+            not (OpamPackage.Set.mem (cudf2opam p) available)
+          | _ -> false)
+    in
+    get_causes causes roots in
   let causes =
     (* Compute causes for remaining upgrades
        (maybe these could be removed from the actions altogether since they are
@@ -1662,14 +1689,6 @@ let compute_root_causes g requested reinstall available =
           | _ -> false)
     in
     get_causes causes roots in
-  let causes =
-    (* Compute causes for no longer available packages *)
-    let roots =
-      make_roots causes Unavailable (function
-          | `Remove p -> not (OpamPackage.Set.mem (cudf2opam p) available)
-          | _ -> false)
-    in
-    get_causes causes roots in
   Map.map fst causes
 
 (* Compute a full solution from a set of root actions. This means adding all

src/solver/opamCudf.mli

@@ -111,8 +111,9 @@ val atomic_actions:
   ActionGraph.t
 
 (** Removes from a graph of actions the disjoint subgraphs that don't concern
-    requested packages. *)
-val trim_actions: OpamPackage.Name.Set.t -> ActionGraph.t -> unit
+   requested packages. The provided universe should *include*
+   [post]-dependencies so that they don't get trimmed away. *)
+val trim_actions: Cudf.universe -> OpamPackage.Name.Set.t -> ActionGraph.t -> unit
 
 (** Heuristic to compute the likely cause of all actions in a graph from the set
     of packages passed in the original request. Assumes a reduced graph. Takes
@@ -140,11 +141,8 @@ val resolve:
 (** Computes a list of actions to proceed from the result of [resolve].
     Note however than the action list is not yet complete: the transitive closure
     of reinstallations is not yet completed, as it requires to fold over the
-    dependency graph in considering the optional dependencies.
-    The first argument specifies a function that will be applied to the starting
-    universe before computation: useful to re-add orphan packages. *)
+    dependency graph in considering the optional dependencies. *)
 val to_actions:
-  (Cudf.universe -> Cudf.universe) ->
   Cudf.universe ->
   (Cudf.universe, conflict) result ->
   (Cudf.package atomic_action list, conflict) result
@@ -198,6 +196,11 @@ val opam_invariant_package: string * int
 
 val is_opam_invariant: Cudf.package -> bool
 
+(** dummy package that shouldn't exist and encodes unavailability (by depending on it) *)
+val unavailable_package_name: string
+val unavailable_package: string * int
+val is_unavailable_package: Cudf.package -> bool
+
 (** {2 Pretty-printing} *)
 
 (** Convert a package constraint to something readable. *)

src/solver/opamSolver.ml

@@ -271,6 +271,17 @@ let opam2cudf universe version_map packages =
     OpamPackage.Map.map preresolve_deps
       (only_packages universe.u_depends)
   in
+  let depends_map =
+    let unav_dep =
+      OpamFormula.Atom (OpamCudf.unavailable_package_name, (FBool true, None))
+    in
+    OpamPackage.Set.fold (fun nv ->
+        OpamPackage.Map.update nv
+          (fun deps -> OpamFormula.ands [unav_dep; deps])
+          OpamFormula.Empty)
+      (universe.u_installed -- universe.u_available)
+      depends_map
+  in
   let depopts_map =
     OpamPackage.Map.map preresolve_deps
       (only_packages universe.u_depopts)
@@ -437,32 +448,19 @@ let resolve universe request =
     in
     { request with extra_attributes }
   in
-  let cudf_orphans =
-    OpamPackage.Set.fold (fun nv acc ->
-        Cudf.lookup_package cudf_universe
-          (name_to_cudf nv.name, OpamPackage.Map.find nv version_map)
-        :: acc)
-      (universe.u_installed -- universe.u_available) []
-  in
   let request = cleanup_request universe request in
   let cudf_request = map_request (atom2cudf universe version_map) request in
   let invariant_pkg =
     opam_invariant_package version_map universe.u_invariant
   in
   let solution =
     try
-      List.iter (fun p ->
-          Cudf.remove_package cudf_universe (p.Cudf.package, p.Cudf.version))
-        cudf_orphans;
       Cudf.add_package cudf_universe invariant_pkg;
       let resp =
         OpamCudf.resolve ~extern:true ~version_map cudf_universe cudf_request
       in
-      Cudf.remove_package cudf_universe
-        (invariant_pkg.Cudf.package, invariant_pkg.Cudf.version);
-      List.iter (Cudf.add_package cudf_universe) cudf_orphans;
-      OpamCudf.to_actions (fun u -> u (*@LG trim here ?*))
-        cudf_universe resp
+      Cudf.remove_package cudf_universe OpamCudf.opam_invariant_package;
+      OpamCudf.to_actions cudf_universe resp
     with OpamCudf.Solver_failure msg ->
       let bt = Printexc.get_raw_backtrace () in
       OpamConsole.error "%s" msg;

tests/reftests/opamroot-versions.test

@@ -744,6 +744,7 @@ STATE                           Switch state loaded in 0.000s
 # Name            # Installed # Synopsis
 i-am-sys-compiler 2           One-line description
 ### # ro global state, ro repo state, rw switch state
+### OPAMSYSCOMP=2
 ### opam install i-am-package | "(${OPAMROOTVERSION})" -> "current"
 GSTATE                          LOAD-GLOBAL-STATE @ ${BASEDIR}/OPAM
 FMT_UPG                         On-the-fly config upgrade, from 2.0 to current

tests/reftests/opamrt-reinstall.test

@@ -189,17 +189,22 @@ d.1
 d
 ### : 10/ Reinstall c
 ### opam reinstall c
-The following actions will be performed:
-  - recompile c 1
-  - recompile d 1 [uses c]
-===== 2 to recompile =====
+  * Missing dependency:
+    - b.1: no longer available
 
-<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
--> removed   d.1
--> removed   c.1
--> installed c.1
--> installed d.1
-Done.
+No solution found, exiting
+# Return code 20 #
+### <pkg:b.1>
+opam-version: "2.0"
+depends: "a"
+build:   [ "test" "-d" a:lib ]
+remove:  [ "test" "-d" a:lib ]
+install: [ "mkdir" _:lib ]
+### opam update
+
+<><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><>
+[default] synchronised from file://${BASEDIR}/REPO
+Now run 'opam upgrade' to apply any package updates.
 ### opam list -sV
 a.1
 b.1
@@ -298,22 +303,29 @@ install: [ "mkdir" _:lib ]
 Now run 'opam upgrade' to apply any package updates.
 ### opam upgrade
 The following actions will be performed:
-  - remove  d 1      [uses c]
-  - remove  c 2      [uses b]
-  - remove  b 1      [conflicts with a]
-  - upgrade a 1 to 2
-===== 1 to upgrade | 3 to remove =====
+  - upgrade   a 1 to 2
+  - recompile b 1      [uses a]
+  - recompile c 2      [uses b]
+  - recompile d 1      [uses c]
+===== 3 to recompile | 1 to upgrade =====
 
 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
 -> removed   d.1
 -> removed   c.2
 -> removed   b.1
 -> removed   a.1
 -> installed a.2
+-> installed b.1
+-> installed c.2
+-> installed d.1
 Done.
 ### opam list -sV
 a.2
+b.1
+c.2
+d.1
 ### opam list -sA --roots
+d
 ### : 15/ Remove that new version of a and upgrade
 ### rm REPO/packages/a/a.2 -rf
 ### opam update
@@ -323,19 +335,37 @@ a.2
 Now run 'opam upgrade' to apply any package updates.
 ### opam upgrade
 The following actions will be performed:
-  - downgrade a 2 to 1
+  - downgrade a 2 to 1 [no longer available]
+  - recompile b 1      [uses a]
+  - recompile c 2      [uses b]
+  - recompile d 1      [uses c]
+===== 3 to recompile | 1 to downgrade =====
 
 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
+-> removed   d.1
+-> removed   c.2
+-> removed   b.1
 -> removed   a.2
 -> installed a.1
+-> installed b.1
+-> installed c.2
+-> installed d.1
 Done.
 ### opam list -sV
 a.1
+b.1
+c.2
+d.1
 ### opam list -sA --roots
+d
 ### : 16/ Upgrade again
 ### opam upgrade
 Already up-to-date.
 Nothing to do.
 ### opam list -sV
 a.1
+b.1
+c.2
+d.1
 ### opam list -sA --roots
+d

tests/reftests/orphans.test

@@ -33,7 +33,7 @@ available: false
 [default] synchronised from file://${BASEDIR}/REPO
 Now run 'opam upgrade' to apply any package updates.
 ### opam reinstall foo
-[ERROR] Sorry, these packages are no longer available from the repositories: foo (= 1)
+[ERROR] foo: unmet availability conditions: 'false'
 # Return code 5 #
 ### : no action should be triggered on foo
 ### opam install baz --show
@@ -46,24 +46,26 @@ The following actions would be performed:
   - remove bar 1 [uses foo]
   - remove foo 1 [no longer available]
 ===== 2 to remove =====
+### opam upgrade --show --fixup
+The following actions would be performed:
+  - remove bar 1 [uses foo]
+  - remove foo 1 [no longer available]
+===== 2 to remove =====
 ### : dependency foo is installed but no longer available
 ### opam upgrade bar
-The following actions will be performed:
-  - recompile foo 1 [upstream or system changes]
-  - recompile bar 1
-===== 2 to recompile =====
+[ERROR] Package conflict!
+  * Missing dependency:
+    - foo.1: no longer available
 
-<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
--> removed   bar.1
--> removed   foo.1
--> installed foo.1
--> installed bar.1
-Done.
+# Return code 20 #
 ### opam clean -s
 Cleaning up switch sw
 ### opam upgrade bar
-Already up-to-date.
-Nothing to do.
+[ERROR] Package conflict!
+  * Missing dependency:
+    - foo.1: no longer available
+
+# Return code 20 #
 ### : replay the same sequence but with another version of `foo` present
 ### <pkg:foo.2>
 opam-version: "2.0"
@@ -73,13 +75,10 @@ opam-version: "2.0"
 [default] synchronised from file://${BASEDIR}/REPO
 Now run 'opam upgrade' to apply any package updates.
 ### opam upgrade --show
-[WARNING] Upgrade is not possible because of conflicts or packages that are no longer available:
-    - Missing dependency:
-    - foo < 2
-    unmet availability conditions: 'false'
-
-You may run "opam upgrade --fixup" to let opam fix the current state.
-# Return code 20 #
+The following actions would be performed:
+  - remove  bar 1      [conflicts with foo]
+  - upgrade foo 1 to 2
+===== 1 to upgrade | 1 to remove =====
 ### <pkg:bar.2>
 opam-version: "2.0"
 depends: "foo" {>= "1"}
@@ -88,6 +87,16 @@ depends: "foo" {>= "1"}
 <><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><>
 [default] synchronised from file://${BASEDIR}/REPO
 Now run 'opam upgrade' to apply any package updates.
+### opam upgrade --show
+The following actions would be performed:
+  - upgrade foo 1 to 2
+  - upgrade bar 1 to 2
+===== 2 to upgrade =====
+### opam upgrade --show --fixup
+The following actions would be performed:
+  - upgrade foo 1 to 2 [required by bar]
+  - upgrade bar 1 to 2
+===== 2 to upgrade =====
 ### opam reinstall baz
 baz is not installed. Install it? [Y/n] y
 The following actions will be performed:
@@ -98,9 +107,13 @@ The following actions will be performed:
 Done.
 ### opam upgrade bar
 The following actions will be performed:
+  - upgrade foo 1 to 2 [required by bar]
   - upgrade bar 1 to 2
+===== 2 to upgrade =====
 
 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
 -> removed   bar.1
+-> removed   foo.1
+-> installed foo.2
 -> installed bar.2
 Done.