From 3db4514d3a7122ee4573673d2baa4a42a91f751b Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 7 Mar 2017 10:14:16 +0000 Subject: [PATCH] Delete pending targets when a command fails --- src/action.ml | 20 ++++++++++++++++++++ src/action.mli | 3 +++ src/build_system.ml | 43 +++++++++++++++++++++++++++---------------- src/future.ml | 39 +++++++++++++++++++++++++-------------- src/future.mli | 3 +++ 5 files changed, 78 insertions(+), 30 deletions(-) diff --git a/src/action.ml b/src/action.ml index c52acc30..6a7c015a 100644 --- a/src/action.ml +++ b/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 diff --git a/src/action.mli b/src/action.mli index 1493039c..2ddb32fe 100644 --- a/src/action.mli +++ b/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 diff --git a/src/build_system.ml b/src/build_system.ml index 7d227240..b4458c6d 100644 --- a/src/build_system.ml +++ b/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 "@{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 = diff --git a/src/future.ml b/src/future.ml index aaca1a5e..4b453d4f 100644 --- a/src/future.ml +++ b/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 "[@{%d@}]" first.id; + List.iter others ~f:(fun job -> + Format.fprintf ppf ", [@{%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 "[@{%d@}]" first.id; - List.iter others ~f:(fun job -> - Format.fprintf ppf ", [@{%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 diff --git a/src/future.mli b/src/future.mli index 035868c8..31a38042 100644 --- a/src/future.mli +++ b/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