Delete pending targets when a command fails
This commit is contained in:
parent
427e8582c0
commit
3db4514d3a
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -418,8 +418,14 @@ module Scheduler = struct
|
|||
List.iter finished ~f:(fun (job, status) ->
|
||||
process_done job status)
|
||||
|
||||
let () =
|
||||
at_exit (fun () ->
|
||||
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
|
||||
|
@ -433,7 +439,12 @@ module Scheduler = struct
|
|||
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))
|
||||
process_done job status ~exiting:true)
|
||||
|
||||
let () =
|
||||
at_exit (fun () ->
|
||||
wait_for_unfinished_jobs ();
|
||||
exec_at_exit_handlers ())
|
||||
|
||||
let rec go_rec cwd log t =
|
||||
match (repr t).state with
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue