Delete pending targets when a command fails

src/action.ml

@@ -134,6 +134,26 @@ module Mini_shexp = struct
   let t = Ast.t string Path.t
   let sexp_of_t = Ast.sexp_of_t Sexp.To_sexp.string Path.sexp_of_t
 
+  let updated_files =
+    let rec loop acc t =
+      match t with
+      | Update_file (fn, _) -> Path.Set.add fn acc
+      | Chdir (_, t)
+      | Setenv (_, _, t)
+      | With_stdout_to (_, t) -> loop acc t
+      | Progn l -> List.fold_left l ~init:acc ~f:loop
+      | Run _ -> acc
+      | Echo _
+      | Cat _
+      | Create_file _
+      | Copy _
+      | Symlink _
+      | Copy_and_add_line_directive _
+      | System _
+      | Bash _ -> acc
+    in
+    fun t -> loop Path.Set.empty t
+
   module Unexpanded = struct
     type t = (String_with_vars.t, String_with_vars.t) Ast.t
     let sexp_of_t = Ast.sexp_of_t String_with_vars.sexp_of_t String_with_vars.sexp_of_t

src/action.mli

@@ -31,6 +31,9 @@ module Mini_shexp : sig
   val t : t Sexp.Of_sexp.t
   val sexp_of_t : t Sexp.To_sexp.t
 
+  (** Return the list of files under an [Update_file] *)
+  val updated_files : t -> Path.Set.t
+
   module Unexpanded : sig
     type desc = t
     type t = (String_with_vars.t, String_with_vars.t) Ast.t

src/build_system.ml

@@ -266,6 +266,16 @@ let wait_for_deps t deps ~targeting =
   all_unit
     (Pset.fold deps ~init:[] ~f:(fun fn acc -> wait_for_file t fn ~targeting :: acc))
 
+(* This contains the targets of the actions that are being executed. On exit, we need to
+   delete them as they might contain garbage *)
+let pending_targets = ref Pset.empty
+
+let () =
+  Future.Scheduler.at_exit_after_waiting_for_commands (fun () ->
+    let fns = !pending_targets in
+    pending_targets := Pset.empty;
+    Pset.iter fns ~f:Path.unlink_no_err)
+
 let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
   let { Pre_rule. build; targets = target_specs } = pre_rule in
   let deps = Build_interpret.deps build ~all_targets_by_dir in
@@ -308,14 +318,14 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
     if !Clflags.debug_actions then
       Format.eprintf "@{<debug>Action@}: %s@."
         (Sexp.to_string (Action.sexp_of_t action));
-    let all_deps = Pset.elements all_deps in
-    let targets  = Pset.elements targets  in
+    let all_deps_as_list = Pset.elements all_deps in
+    let targets_as_list  = Pset.elements targets  in
     let hash =
-      let trace = (all_deps, targets, Action.for_hash action) in
+      let trace = (all_deps_as_list, targets_as_list, Action.for_hash action) in
       Digest.string (Marshal.to_string trace [])
     in
     let rule_changed =
-      List.fold_left targets ~init:false ~f:(fun acc fn ->
+      List.fold_left targets_as_list ~init:false ~f:(fun acc fn ->
         match Hashtbl.find t.trace fn with
         | None ->
           Hashtbl.add t.trace ~key:fn ~data:hash;
@@ -324,19 +334,20 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
           Hashtbl.replace t.trace ~key:fn ~data:hash;
           acc || prev_hash <> hash)
     in
-    if rule_changed || min_timestamp t targets < max_timestamp t all_deps then begin
-      (* CR-someday jdimino: we should remove the targets to be sure
-         the action re-generate them, however it breaks incrementality
-         regarding [Write_file ...] actions, since they end up
-         systematically re-creating the file:
-
-         {[
-           List.iter targets ~f:Path.unlink_no_err;
-         ]}
-      *)
+    if rule_changed ||
+       min_timestamp t targets_as_list < max_timestamp t all_deps_as_list then (
+      (* Do not remove files that are just updated, otherwise this would break incremental
+         compilation *)
+      let targets_to_remove =
+        Pset.diff targets (Action.Mini_shexp.updated_files action.action)
+      in
+      Pset.iter targets_to_remove ~f:Path.unlink_no_err;
+      pending_targets := Pset.union targets_to_remove !pending_targets;
       Action.exec action >>| fun () ->
-      refresh_targets_timestamps_after_rule_execution t targets
-    end else
+      (* All went well, these targets are no longer pending *)
+      pending_targets := Pset.diff !pending_targets targets_to_remove;
+      refresh_targets_timestamps_after_rule_execution t targets_as_list
+    ) else
       return ()
   ) in
   let rule =

src/future.ml

@@ -418,22 +418,33 @@ module Scheduler = struct
       List.iter finished ~f:(fun (job, status) ->
         process_done job status)
 
+  let at_exit_handlers = Queue.create ()
+  let at_exit_after_waiting_for_commands f = Queue.push f at_exit_handlers
+  let exec_at_exit_handlers () =
+    while not (Queue.is_empty at_exit_handlers) do
+      Queue.pop at_exit_handlers ()
+    done
+
+  let wait_for_unfinished_jobs () =
+    let jobs =
+      Hashtbl.fold running ~init:[] ~f:(fun ~key:_ ~data:job acc -> job :: acc)
+    in
+    match jobs with
+    | [] -> ()
+    | first :: others ->
+      Format.eprintf "\nWaiting for the following jobs to finish: %t@."
+        (fun ppf ->
+           Format.fprintf ppf "[@{<id>%d@}]" first.id;
+           List.iter others ~f:(fun job ->
+             Format.fprintf ppf ", [@{<id>%d@}]" job.id));
+      List.iter jobs ~f:(fun job ->
+        let _, status = Unix.waitpid [] job.pid in
+        process_done job status ~exiting:true)
+
   let () =
     at_exit (fun () ->
-      let jobs =
-        Hashtbl.fold running ~init:[] ~f:(fun ~key:_ ~data:job acc -> job :: acc)
-      in
-      match jobs with
-      | [] -> ()
-      | first :: others ->
-        Format.eprintf "\nWaiting for the following jobs to finish: %t@."
-          (fun ppf ->
-             Format.fprintf ppf "[@{<id>%d@}]" first.id;
-             List.iter others ~f:(fun job ->
-               Format.fprintf ppf ", [@{<id>%d@}]" job.id));
-        List.iter jobs ~f:(fun job ->
-          let _, status = Unix.waitpid [] job.pid in
-          process_done job status ~exiting:true))
+      wait_for_unfinished_jobs ();
+      exec_at_exit_handlers ())
 
   let rec go_rec cwd log t =
     match (repr t).state with

src/future.mli

@@ -75,4 +75,7 @@ val run_capture_lines
 
 module Scheduler : sig
   val go : ?log:out_channel -> 'a t -> 'a
+
+  (** Executes [f] before exiting, after all pending commands have finished *)
+  val at_exit_after_waiting_for_commands : (unit -> unit) -> unit
 end