Adjust actions trimming to take post-deps into account

ocaml · Dec 16, 2021 · ae22bc8 · ae22bc8
1 parent 4fe28e8
commit ae22bc8
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 3 deletions.
diff --git a/src/solver/opamCudf.ml b/src/solver/opamCudf.ml
@@ -1767,8 +1767,30 @@ let atomic_actions ~simple_universe ~complete_universe root_actions =
   | [] -> g
   | cycles -> raise (Cyclic_actions cycles)
 
-let trim_actions req g =
+let trim_actions univ req g =
   if OpamPackage.Name.Set.is_empty req then () else
+  let post_dependencies_map =
+    let packages_actions =
+      ActionGraph.fold_vertex (fun a ->
+          Map.update (action_contents a) (Action.Set.add a) Action.Set.empty)
+        g Map.empty
+    in
+    let univ =
+      Cudf.load_universe @@ Cudf.get_packages univ
+        ~filter:(fun p -> Map.mem p packages_actions)
+    in
+    let deps univ p =
+      let p = Cudf.lookup_package univ (p.Cudf.package, p.Cudf.version) in
+      List.fold_right (List.fold_right Set.add)
+        (Dose_common.CudfAdd.who_depends univ p)
+        Set.empty
+    in
+    ActionGraph.fold_vertex (fun a ->
+        Action.Map.add a
+          (Set.fold (fun p -> Action.Set.union (Map.find p packages_actions))
+             (deps univ (action_contents a)) Action.Set.empty))
+      g Action.Map.empty
+  in
   let root_actions, other_actions =
     ActionGraph.fold_vertex (fun a (root,other) ->
         let pkg = action_contents a in
@@ -1784,7 +1806,7 @@ let trim_actions req g =
     Action.Set.fixpoint (fun a ->
         ActionGraph.fold_succ Action.Set.add g a @@
         ActionGraph.fold_pred Action.Set.add g a @@
-        Action.Set.empty)
+        Action.Map.find a post_dependencies_map)
       root_actions
   in
   let discard_actions = Action.Set.diff other_actions connex_actions in

diff --git a/src/solver/opamSolver.ml b/src/solver/opamSolver.ml
@@ -477,7 +477,7 @@ let resolve universe request =
       let atomic_actions =
         OpamCudf.atomic_actions
           ~simple_universe ~complete_universe actions in
-      OpamCudf.trim_actions requested_names atomic_actions;
+      OpamCudf.trim_actions cudf_universe requested_names atomic_actions;
       Success atomic_actions
     with OpamCudf.Cyclic_actions cycles ->
       cycle_conflict ~version_map complete_universe cycles