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 t = Ast.t string Path.t
|
||||||
let sexp_of_t = Ast.sexp_of_t Sexp.To_sexp.string Path.sexp_of_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
|
module Unexpanded = struct
|
||||||
type t = (String_with_vars.t, String_with_vars.t) Ast.t
|
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
|
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 t : t Sexp.Of_sexp.t
|
||||||
val sexp_of_t : t Sexp.To_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
|
module Unexpanded : sig
|
||||||
type desc = t
|
type desc = t
|
||||||
type t = (String_with_vars.t, String_with_vars.t) Ast.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
|
all_unit
|
||||||
(Pset.fold deps ~init:[] ~f:(fun fn acc -> wait_for_file t fn ~targeting :: acc))
|
(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 compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
let { Pre_rule. build; targets = target_specs } = pre_rule in
|
let { Pre_rule. build; targets = target_specs } = pre_rule in
|
||||||
let deps = Build_interpret.deps build ~all_targets_by_dir 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
|
if !Clflags.debug_actions then
|
||||||
Format.eprintf "@{<debug>Action@}: %s@."
|
Format.eprintf "@{<debug>Action@}: %s@."
|
||||||
(Sexp.to_string (Action.sexp_of_t action));
|
(Sexp.to_string (Action.sexp_of_t action));
|
||||||
let all_deps = Pset.elements all_deps in
|
let all_deps_as_list = Pset.elements all_deps in
|
||||||
let targets = Pset.elements targets in
|
let targets_as_list = Pset.elements targets in
|
||||||
let hash =
|
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 [])
|
Digest.string (Marshal.to_string trace [])
|
||||||
in
|
in
|
||||||
let rule_changed =
|
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
|
match Hashtbl.find t.trace fn with
|
||||||
| None ->
|
| None ->
|
||||||
Hashtbl.add t.trace ~key:fn ~data:hash;
|
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;
|
Hashtbl.replace t.trace ~key:fn ~data:hash;
|
||||||
acc || prev_hash <> hash)
|
acc || prev_hash <> hash)
|
||||||
in
|
in
|
||||||
if rule_changed || min_timestamp t targets < max_timestamp t all_deps then begin
|
if rule_changed ||
|
||||||
(* CR-someday jdimino: we should remove the targets to be sure
|
min_timestamp t targets_as_list < max_timestamp t all_deps_as_list then (
|
||||||
the action re-generate them, however it breaks incrementality
|
(* Do not remove files that are just updated, otherwise this would break incremental
|
||||||
regarding [Write_file ...] actions, since they end up
|
compilation *)
|
||||||
systematically re-creating the file:
|
let targets_to_remove =
|
||||||
|
Pset.diff targets (Action.Mini_shexp.updated_files action.action)
|
||||||
{[
|
in
|
||||||
List.iter targets ~f:Path.unlink_no_err;
|
Pset.iter targets_to_remove ~f:Path.unlink_no_err;
|
||||||
]}
|
pending_targets := Pset.union targets_to_remove !pending_targets;
|
||||||
*)
|
|
||||||
Action.exec action >>| fun () ->
|
Action.exec action >>| fun () ->
|
||||||
refresh_targets_timestamps_after_rule_execution t targets
|
(* All went well, these targets are no longer pending *)
|
||||||
end else
|
pending_targets := Pset.diff !pending_targets targets_to_remove;
|
||||||
|
refresh_targets_timestamps_after_rule_execution t targets_as_list
|
||||||
|
) else
|
||||||
return ()
|
return ()
|
||||||
) in
|
) in
|
||||||
let rule =
|
let rule =
|
||||||
|
|
|
@ -418,22 +418,33 @@ module Scheduler = struct
|
||||||
List.iter finished ~f:(fun (job, status) ->
|
List.iter finished ~f:(fun (job, status) ->
|
||||||
process_done 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 () =
|
let () =
|
||||||
at_exit (fun () ->
|
at_exit (fun () ->
|
||||||
let jobs =
|
wait_for_unfinished_jobs ();
|
||||||
Hashtbl.fold running ~init:[] ~f:(fun ~key:_ ~data:job acc -> job :: acc)
|
exec_at_exit_handlers ())
|
||||||
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 rec go_rec cwd log t =
|
let rec go_rec cwd log t =
|
||||||
match (repr t).state with
|
match (repr t).state with
|
||||||
|
|
|
@ -75,4 +75,7 @@ val run_capture_lines
|
||||||
|
|
||||||
module Scheduler : sig
|
module Scheduler : sig
|
||||||
val go : ?log:out_channel -> 'a t -> 'a
|
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
|
end
|
||||||
|
|
Loading…
Reference in New Issue