fix: delete stale directory targets

CHANGES.md

@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- When a rule's action is interrupted, delete any leftover directory targets.
+  This is consistent with how we treat file targets. (@rgrinberg, 7564)
+
 - Fix plugin loading with findlib. The functionality was broken in 3.7.0.
   (#7556, @anmonteiro)
 

src/dune_engine/build_system.ml

@@ -215,18 +215,28 @@ let rec with_locks ~f = function
       (Table.find_or_add State.locks m ~f:(fun _ -> Fiber.Mutex.create ()))
       ~f:(fun () -> with_locks ~f mutexes)
 
-(* All file targets of non-sandboxed actions that are currently being executed.
-   On exit, we need to delete them as they might contain garbage. There is no
-   [pending_dir_targets] since actions with directory targets are sandboxed. *)
-let pending_file_targets = ref Path.Build.Set.empty
+module Pending_targets = struct
+  (* All file and directory targets of non-sandboxed actions that are currently
+     being executed. On exit, we need to delete them as they might contain
+     garbage. *)
 
-let () = Hooks.End_of_build.always Metrics.reset
+  let t = ref Targets.empty
+
+  let remove targets =
+    t := Targets.diff !t (Targets.Validated.unvalidate targets)
 
-let () =
-  Hooks.End_of_build.always (fun () ->
-      let fns = !pending_file_targets in
-      pending_file_targets := Path.Build.Set.empty;
-      Path.Build.Set.iter fns ~f:(fun p -> Path.Build.unlink_no_err p))
+  let add targets =
+    t := Targets.combine !t (Targets.Validated.unvalidate targets)
+
+  let () =
+    Hooks.End_of_build.always (fun () ->
+        let targets = !t in
+        t := Targets.empty;
+        Targets.iter targets ~file:Path.Build.unlink_no_err ~dir:(fun p ->
+            Path.rm_rf (Path.build p)))
+end
+
+let () = Hooks.End_of_build.always Metrics.reset
 
 type rule_execution_result =
   { deps : Dep.Fact.t Dep.Map.t
@@ -440,8 +450,7 @@ end = struct
       | None ->
         (* If the action is not sandboxed, we use [pending_file_targets] to
            clean up the build directory if the action is interrupted. *)
-        pending_file_targets :=
-          Path.Build.Set.union targets.files !pending_file_targets;
+        Pending_targets.add targets;
         None
     in
     let action =
@@ -513,8 +522,7 @@ end = struct
     | Some sandbox -> Sandbox.destroy sandbox
     | None ->
       (* All went well, these targets are no longer pending. *)
-      pending_file_targets :=
-        Path.Build.Set.diff !pending_file_targets targets.files);
+      Pending_targets.remove targets);
     exec_result
 
   let promote_targets ~rule_mode ~dir ~targets ~promote_source =

src/dune_engine/targets.ml

@@ -27,6 +27,11 @@ let combine x y =
   ; dirs = Path.Build.Set.union x.dirs y.dirs
   }
 
+let diff t { files; dirs } =
+  { files = Path.Build.Set.diff t.files files
+  ; dirs = Path.Build.Set.diff t.dirs dirs
+  }
+
 let is_empty { files; dirs } =
   Path.Build.Set.is_empty files && Path.Build.Set.is_empty dirs
 
@@ -55,6 +60,10 @@ let pp { files; dirs } =
 let exists { files; dirs } ~f =
   Path.Build.Set.exists files ~f || Path.Build.Set.exists dirs ~f
 
+let iter { files; dirs } ~file ~dir =
+  Path.Build.Set.iter files ~f:file;
+  Path.Build.Set.iter dirs ~f:dir
+
 module Validated = struct
   type nonrec t = t =
     { files : Path.Build.Set.t
@@ -64,6 +73,8 @@ module Validated = struct
   let to_dyn = to_dyn
 
   let head = head_exn
+
+  let unvalidate t = t
 end
 
 module Validation_result = struct

src/dune_engine/targets.mli

@@ -13,6 +13,11 @@ val is_empty : t -> bool
 (** Combine the sets of file and directory targets. *)
 val combine : t -> t -> t
 
+val diff : t -> t -> t
+
+val iter :
+  t -> file:(Path.Build.t -> unit) -> dir:(Path.Build.t -> unit) -> unit
+
 module File : sig
   (** A single file target. *)
   val create : Path.Build.t -> t
@@ -27,6 +32,8 @@ end
 val create : files:Path.Build.Set.t -> dirs:Path.Build.Set.t -> t
 
 module Validated : sig
+  type unvalidated := t
+
   (** A rule can produce a set of files whose names are known upfront, as well
       as a set of "opaque" directories whose contents is initially unknown. *)
   type t = private
@@ -39,6 +46,8 @@ module Validated : sig
   val head : t -> Path.Build.t
 
   val to_dyn : t -> Dyn.t
+
+  val unvalidate : t -> unvalidated
 end
 
 module Validation_result : sig