Fix the install cache storing the wrong version of the opam file afte…

…r a build or fetch failure
ocaml · Oct 10, 2024 · 9b891a7 · 9b891a7
1 parent bb77b2d
commit 9b891a7
Show file tree

Hide file tree

Showing 3 changed files with 43 additions and 21 deletions.
diff --git a/master_changes.md b/master_changes.md
@@ -22,6 +22,7 @@ users)
 ## Config report
 
 ## Actions
+  * Fix the install cache storing the wrong version of the opam file after a build failure [#6213 @kit-ty-kate]
 
 ## Install
 

diff --git a/src/client/opamSolution.ml b/src/client/opamSolution.ml
@@ -824,15 +824,45 @@ let parallel_apply t
 
   (* 2/ Display errors and finalize *)
 
-  OpamSwitchState.Installed_cache.save
-    (OpamPath.Switch.installed_opams_cache t.switch_global.root t.switch)
-    (OpamPackage.Set.fold (fun nv opams ->
-         let opam =
-           OpamSwitchState.opam t nv |>
-           OpamFile.OPAM.with_metadata_dir None
-         in
-         OpamPackage.Map.add nv opam opams)
-        t.installed OpamPackage.Map.empty);
+  let save_installed_cache failed =
+    OpamSwitchState.Installed_cache.save
+      (OpamPath.Switch.installed_opams_cache t.switch_global.root t.switch)
+      (OpamPackage.Set.fold (fun nv opams ->
+           let pkg_failed =
+             List.exists (function
+                 | `Fetch ps -> List.for_all (OpamPackage.equal nv) ps
+                 | `Build p
+                 | `Change (_, _, p)
+                 | `Install p
+                 | `Reinstall p
+                 | `Remove p -> OpamPackage.equal nv p)
+               failed
+           in
+           let add_to_opams opam =
+             let opam = OpamFile.OPAM.with_metadata_dir None opam in
+             OpamPackage.Map.add nv opam opams
+           in
+           if pkg_failed then
+             match OpamPackage.Map.find_opt nv t.installed_opams with
+             | None -> opams
+             | Some opam -> add_to_opams opam
+           else
+             add_to_opams (OpamSwitchState.opam t nv))
+          t.installed OpamPackage.Map.empty);
+  in
+  begin match action_results with
+  | `Exception _ | `Error Aborted -> ()
+  | `Error (Nothing_to_do | OK _) -> assert false
+  | `Error (Partial_error res) ->
+    let { actions_successes = _;
+          actions_errors;
+          actions_aborted;
+        } = res
+    in
+    save_installed_cache (List.map fst actions_errors @ actions_aborted)
+  | `Successful _ ->
+    save_installed_cache []
+  end;
 
   let cleanup_artefacts graph =
     PackageActionGraph.iter_vertex (function

diff --git a/tests/reftests/cache.test b/tests/reftests/cache.test
@@ -76,20 +76,14 @@ build: "true"
 opam-version: "2.0"
 name: "upgrade"
 version: "1"
-build: "false"
+build: "true"
 => always-here.1 <=
 opam-version: "2.0"
 name: "always-here"
 version: "1"
 ### opam upgrade
-The following actions will be performed:
-=== recompile 1 package
-  - recompile upgrade 1 [upstream or system changes]
-
-<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
--> removed   upgrade.1
--> installed upgrade.1
-Done.
+Already up-to-date.
+Nothing to do.
 ### opam-cache installed action-failure
 => upgrade.1 <=
 opam-version: "2.0"
@@ -319,9 +313,6 @@ opam-version: "2.0"
 opam-version: "2.0"
 name: "upgrade"
 version: "1"
-url {
-  src: "file:///inexistent/path"
-}
 => always-here.1 <=
 opam-version: "2.0"
 name: "always-here"