From 3daeaa3d4ddbf4d6064d7e2700618f2df4a28fe0 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 16 Apr 2023 15:49:00 -0600 Subject: [PATCH] fix: delete stale directory targets For unsandboxed rules, directory targets weren't being cleared when running rules were interrupted. This PR treats files and directories in the same way. Signed-off-by: Rudi Grinberg --- CHANGES.md | 3 +++ src/dune_engine/build_system.ml | 36 ++++++++++++++++++++------------- src/dune_engine/targets.ml | 11 ++++++++++ src/dune_engine/targets.mli | 9 +++++++++ 4 files changed, 45 insertions(+), 14 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5f8c37bfd7e..e74487407b2 100644 --- a/CHANGES.md +++ b/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) diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index c87ec4d7a35..9e7915a8bb7 100644 --- a/src/dune_engine/build_system.ml +++ b/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 = diff --git a/src/dune_engine/targets.ml b/src/dune_engine/targets.ml index 2a1962fb6ac..8f4099a445e 100644 --- a/src/dune_engine/targets.ml +++ b/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 diff --git a/src/dune_engine/targets.mli b/src/dune_engine/targets.mli index d5693b65960..081818d0bf1 100644 --- a/src/dune_engine/targets.mli +++ b/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