matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Quieter output (#40) 

Makes the output quieter by default and add a `--verbose` argument. Print a message when waiting for background jobs to finish only it it takes more than 0.5 seconds.
This commit is contained in:
Stephen Dolan 2017-03-30 17:36:58 +01:00 committed by Jérémie Dimino
parent 06710d56a9
commit b5ae1b1f52
12 changed files with 259 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
bin/main.ml
View File

@ -15,6 +15,7 @@ type common =
; debug_dep_path : bool
; debug_findlib : bool
; dev_mode : bool
; verbose : bool
; workspace_file : string option
; root : string
; target_prefix : string
@ -30,7 +31,8 @@ let set_common c =
Clflags.debug_dep_path := c.debug_dep_path;
Clflags.debug_findlib := c.debug_findlib;
Clflags.dev_mode := c.dev_mode;
Printf.eprintf "Workspace root: %s\n" c.root;
Clflags.verbose := c.verbose;
Clflags.workspace_root := c.root;
if c.root <> Filename.current_dir_name then
Sys.chdir c.root
@ -114,6 +116,7 @@ let common =
debug_dep_path
debug_findlib
dev_mode
verbose
workspace_file
root
=
@ -128,6 +131,7 @@ let common =
; debug_dep_path
; debug_findlib
; dev_mode
; verbose
; workspace_file
; root
; target_prefix = String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/"))
@ -188,6 +192,12 @@ let common =
& info ["dev"] ~docs
~doc:{|Use stricter compilation flags by default.|})
in
let verbose =
Arg.(value
& flag
& info ["verbose"] ~docs
~doc:"Print detailed information about commands being run")
in
let workspace_file =
Arg.(value
& opt (some file) None
@ -211,6 +221,7 @@ let common =
$ ddep_path
$ dfindlib
$ dev
$ verbose
$ workspace_file
$ root
)
@ -248,7 +259,7 @@ type target =
| File of Path.t
| Alias of Path.t * Alias.t
let resolve_targets common (setup : Main.setup) user_targets =
let resolve_targets ~log common (setup : Main.setup) user_targets =
match user_targets with
| [] -> []
| _ ->
@ -295,13 +306,15 @@ let resolve_targets common (setup : Main.setup) user_targets =
| l -> l
)
in
Printf.printf "Actual targets:\n";
List.iter targets ~f:(function
| File path ->
Printf.printf "- %s\n" (Path.to_string path)
| Alias (path, _) ->
Printf.printf "- alias %s\n" (Path.to_string path));
flush stdout;
if !Clflags.verbose then begin
Log.info log "Actual targets:";
List.iter targets ~f:(function
| File path ->
Log.info log @@ "- " ^ (Path.to_string path)
| Alias (path, _) ->
Log.info log @@ "- alias " ^ (Path.to_string path));
flush stdout;
end;
List.map targets ~f:(function
| File path -> path
| Alias (_, alias) -> Alias.file alias)
@ -320,7 +333,7 @@ let build_targets =
let log = Log.create () in
Future.Scheduler.go ~log
(Main.setup ~log common >>= fun setup ->
let targets = resolve_targets common setup targets in
let targets = resolve_targets ~log common setup targets in
do_build setup targets) in
( Term.(const go
$ common
@ -377,7 +390,7 @@ let external_lib_deps =
Future.Scheduler.go ~log
(Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
>>= fun setup ->
let targets = resolve_targets common setup targets in
let targets = resolve_targets ~log common setup targets in
let failure =
String_map.fold ~init:false
(Build_system.all_lib_deps_by_context setup.build_system targets)
@ -497,7 +510,8 @@ let install_uninstall ~what =
get_prefix context ~from_command_line:prefix >>= fun prefix ->
Future.all_unit
(List.map install_files ~f:(fun path ->
Future.run Strict (Path.to_string opam_installer)
let purpose = Future.Build_job install_files in
Future.run ~purpose Strict (Path.to_string opam_installer)
[ sprintf "-%c" what.[0]
; "--prefix"
; Path.to_string prefix

42
src/action.ml
View File

@ -231,28 +231,28 @@ module Mini_shexp = struct
| None -> Terminal
| Some (fn, oc) -> Opened_file { filename = fn; tail = false; desc = Channel oc }
let run ~dir ~env ~env_extra ~stdout_to ~stderr_to prog args =
let run ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to prog args =
let stdout_to = get_std_output stdout_to in
let stderr_to = get_std_output stderr_to in
let env = Context.extend_env ~vars:env_extra ~env in
Future.run Strict ~dir:(Path.to_string dir) ~env ~stdout_to ~stderr_to
Future.run Strict ~dir:(Path.to_string dir) ~env ~stdout_to ~stderr_to ~purpose
(Path.reach_for_running ~from:dir prog) args
let rec exec t ~dir ~env ~env_extra ~stdout_to ~stderr_to =
let rec exec t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
match t with
| Run (prog, args) ->
run ~dir ~env ~env_extra ~stdout_to ~stderr_to prog args
run ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to prog args
| Chdir (dir, t) ->
exec t ~env ~env_extra ~stdout_to ~stderr_to ~dir
exec t ~purpose ~env ~env_extra ~stdout_to ~stderr_to ~dir
| Setenv (var, value, t) ->
exec t ~dir ~env ~stdout_to ~stderr_to
exec t ~purpose ~dir ~env ~stdout_to ~stderr_to
~env_extra:(String_map.add env_extra ~key:var ~data:value)
| Redirect (outputs, fn, t) ->
redirect outputs fn t ~dir ~env ~env_extra ~stdout_to ~stderr_to
redirect ~purpose outputs fn t ~dir ~env ~env_extra ~stdout_to ~stderr_to
| Ignore (outputs, t) ->
redirect outputs Config.dev_null t ~dir ~env ~env_extra ~stdout_to ~stderr_to
redirect ~purpose outputs Config.dev_null t ~dir ~env ~env_extra ~stdout_to ~stderr_to
| Progn l ->
exec_list l ~dir ~env ~env_extra ~stdout_to ~stderr_to
exec_list l ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to
| Echo str ->
return
(match stdout_to with
@ -311,9 +311,9 @@ module Mini_shexp = struct
let path, arg =
Utils.system_shell_exn ~needed_to:"interpret (system ...) actions"
in
run ~dir ~env ~env_extra ~stdout_to ~stderr_to path [arg; cmd]
run ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to path [arg; cmd]
| Bash cmd ->
run ~dir ~env ~env_extra ~stdout_to ~stderr_to
run ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to
(Utils.bash_exn ~needed_to:"interpret (bash ...) actions")
["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
| Update_file (fn, s) ->
@ -324,7 +324,7 @@ module Mini_shexp = struct
write_file fn s;
return ()
and redirect outputs fn t ~dir ~env ~env_extra ~stdout_to ~stderr_to =
and redirect outputs fn t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
let fn = Path.to_string fn in
let oc = open_out_bin fn in
let out = Some (fn, oc) in
@ -334,18 +334,18 @@ module Mini_shexp = struct
| Stderr -> (stdout_to, out)
| Outputs -> (out, out)
in
exec t ~dir ~env ~env_extra ~stdout_to ~stderr_to >>| fun () ->
exec t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to >>| fun () ->
close_out oc
and exec_list l ~dir ~env ~env_extra ~stdout_to ~stderr_to =
and exec_list l ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
match l with
| [] ->
Future.return ()
| [t] ->
exec t ~dir ~env ~env_extra ~stdout_to ~stderr_to
exec t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to
| t :: rest ->
exec t ~dir ~env ~env_extra ~stdout_to ~stderr_to >>= fun () ->
exec_list rest ~dir ~env ~env_extra ~stdout_to ~stderr_to
exec t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to >>= fun () ->
exec_list rest ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to
end
type t =
@ -382,18 +382,20 @@ let sexp_of_t { context; dir; action } =
in
Sexp.List fields
let exec { action; dir; context } =
let exec ~targets { action; dir; context } =
let env =
match context with
| None -> Lazy.force Context.initial_env
| Some c -> c.env
in
Mini_shexp.exec action ~dir ~env ~env_extra:String_map.empty
let targets = Path.Set.elements targets in
let purpose = Future.Build_job targets in
Mini_shexp.exec action ~purpose ~dir ~env ~env_extra:String_map.empty
~stdout_to:None ~stderr_to:None
type for_hash = string option * Path.t * Mini_shexp.t
let for_hash { context; dir; action } =
let for_hash { context; dir; action; _ } =
(Option.map context ~f:(fun c -> c.name),
dir,
action)

2
src/action.mli
View File

@ -58,7 +58,7 @@ type t =
val t : Context.t String_map.t -> t Sexp.Of_sexp.t
val sexp_of_t : t Sexp.To_sexp.t
val exec : t -> unit Future.t
val exec : targets:Path.Set.t -> t -> unit Future.t
type for_hash
val for_hash : t -> for_hash

2
src/ansi_color.ml
View File

@ -168,6 +168,8 @@ let styles_of_tag = function
| "kwd" -> [Bold; Foreground Blue]
| "id" -> [Bold; Foreground Yellow]
| "prompt" -> [Bold; Foreground Green]
| "details" -> [Dim; Foreground White]
| "ok" -> [Dim; Foreground Green]
| "debug" -> [Underlined; Foreground Bright_cyan]
| _ -> []

2
src/build.ml
View File

@ -160,7 +160,7 @@ let run ?(dir=Path.root) ?stdout_to ?context ?(extra_targets=[]) prog args =
let action ?(dir=Path.root) ?context ~targets action =
Targets targets
>>^ fun () ->
{ Action. context; dir; action }
{ Action. context; dir; action }
let update_file fn s =
action ~targets:[fn] (Update_file (fn, s))

2
src/build_system.ml
View File

@ -383,7 +383,7 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
in
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 ~targets action >>| fun () ->
(* 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

3
src/clflags.ml
View File

@ -3,8 +3,9 @@ let concurrency = ref 4
let g = ref true
let debug_rules = ref false
let debug_actions = ref false
let debug_run = ref true
let verbose = ref false
let debug_findlib = ref false
let warnings = ref "-40"
let debug_dep_path = ref false
let dev_mode = ref false
let workspace_root = ref "."

7
src/clflags.mli
View File

@ -15,8 +15,8 @@ val debug_rules : bool ref
(** Print actions *)
val debug_actions : bool ref
(** Print executed commands *)
val debug_run : bool ref
(** Print executed commands verbosely *)
val verbose : bool ref
(** Print dependency path in case of error *)
val debug_dep_path : bool ref
@ -29,3 +29,6 @@ val warnings : string ref
(** Whether we are compiling with extra warnings *)
val dev_mode : bool ref
(** The path to the workspace root *)
val workspace_root : string ref

207
src/future.ml
View File

@ -177,6 +177,11 @@ and opened_file_desc =
| Fd of Unix.file_descr
| Channel of out_channel
(** Why a Future.t was run *)
type purpose =
| Internal_job
| Build_job of Path.t list
type job =
{ prog : string
; args : string list
@ -186,11 +191,12 @@ type job =
; env : string array option
; ivar : int Ivar.t
; ok_codes : accepted_codes
; purpose : purpose
}
let to_run : job Queue.t = Queue.create ()
let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ?env fail_mode prog args =
let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ?env ~purpose fail_mode prog args =
let dir =
match dir with
| Some "." -> None
@ -205,10 +211,11 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ?env fail_mode
; env
; ivar
; ok_codes = accepted_codes fail_mode
; purpose
} to_run)
let run ?dir ?stdout_to ?stderr_to ?env fail_mode prog args =
map_result fail_mode (run_internal ?dir ?stdout_to ?stderr_to ?env fail_mode prog args)
let run ?dir ?stdout_to ?stderr_to ?env ?(purpose=Internal_job) fail_mode prog args =
map_result fail_mode (run_internal ?dir ?stdout_to ?stderr_to ?env ~purpose fail_mode prog args)
~f:ignore
module Temp = struct
@ -230,9 +237,9 @@ module Temp = struct
tmp_files := String_set.remove fn !tmp_files
end
let run_capture_gen ?dir ?env fail_mode prog args ~f =
let run_capture_gen ?dir ?env ?(purpose=Internal_job) fail_mode prog args ~f =
let fn = Temp.create "jbuild" ".output" in
map_result fail_mode (run_internal ?dir ~stdout_to:(File fn) ?env fail_mode prog args)
map_result fail_mode (run_internal ?dir ~stdout_to:(File fn) ?env ~purpose fail_mode prog args)
~f:(fun () ->
let x = f fn in
Temp.destroy fn;
@ -241,8 +248,8 @@ let run_capture_gen ?dir ?env fail_mode prog args ~f =
let run_capture = run_capture_gen ~f:read_file
let run_capture_lines = run_capture_gen ~f:lines_of_file
let run_capture_line ?dir ?env fail_mode prog args =
run_capture_gen ?dir ?env fail_mode prog args ~f:(fun fn ->
let run_capture_line ?dir ?env ?(purpose=Internal_job) fail_mode prog args =
run_capture_gen ?dir ?env ~purpose fail_mode prog args ~f:(fun fn ->
match lines_of_file fn with
| [x] -> x
| l ->
@ -260,10 +267,10 @@ let run_capture_line ?dir ?env fail_mode prog args =
cmdline (String.concat l ~sep:"\n"))
module Scheduler = struct
let colorize_prog s =
let split_prog s =
let len = String.length s in
if len = 0 then
s
"", "", ""
else begin
let rec find_prog_start i =
if i < 0 then
@ -286,10 +293,18 @@ module Scheduler = struct
in
let before = String.sub s ~pos:0 ~len:prog_start in
let after = String.sub s ~pos:prog_end ~len:(len - prog_end) in
let key = String.sub s ~pos:prog_start ~len:(prog_end - prog_start) in
before ^ Ansi_color.colorize ~key key ^ after
let prog = String.sub s ~pos:prog_start ~len:(prog_end - prog_start) in
before, prog, after
end
let colorize_prog s =
let len = String.length s in
if len = 0 then
s
else
let before, prog, after = split_prog s in
before ^ Ansi_color.colorize ~key:prog prog ^ after
let rec colorize_args = function
| [] -> []
| "-o" :: fn :: rest ->
@ -319,6 +334,75 @@ module Scheduler = struct
| Terminal -> s
| File fn | Opened_file { filename = fn; _ } -> sprintf "%s 2> %s" s fn
let pp_purpose ppf = function
| Internal_job ->
Format.fprintf ppf "(internal)"
| Build_job targets ->
let rec split_paths targets_acc ctxs_acc = function
| [] -> List.rev targets_acc, String_set.(elements (of_list ctxs_acc))
| path :: rest ->
match Path.extract_build_context path with
| None ->
split_paths (Path.to_string path :: targets_acc) ctxs_acc rest
| Some ("default", filename) ->
split_paths (Path.to_string filename :: targets_acc) ctxs_acc rest
| Some (".aliases", filename) ->
let ctxs_acc, filename = match Path.extract_build_context filename with
| None -> ctxs_acc, Path.to_string filename
| Some (ctx, fn) ->
let strip_digest fn =
let fn = Path.to_string fn in
match String.rsplit2 fn ~on:'-' with
| None -> fn
| Some (name, digest) ->
match Digest.from_hex digest with
| _ -> name
| exception (Invalid_argument _) -> fn in
let ctxs_acc =
if ctx = "default" then ctxs_acc else ctx :: ctxs_acc in
ctxs_acc, strip_digest fn in
split_paths (("alias " ^ filename) :: targets_acc) ctxs_acc rest
| Some (ctx, filename) ->
split_paths (Path.to_string filename :: targets_acc) (ctx :: ctxs_acc) rest in
let target_names, contexts = split_paths [] [] targets in
let rec group_by_ext = function
| [] -> []
| x :: xs ->
let eq_ext a b =
let chop s =
try Filename.chop_extension s with Invalid_argument _ -> s in
chop a = chop b in
let (similar, rest) = List.partition ~f:(eq_ext x) xs in
(x :: similar) :: group_by_ext rest in
let pp_ext ppf filename =
let ext = match Filename.ext filename with
| Some s when s.[0] = '.' ->
String.sub ~pos:1 ~len:(String.length s - 1) s
| Some s -> s
| None -> "" in
Format.fprintf ppf "%s" ext in
let pp_comma ppf () = Format.fprintf ppf "," in
let pp_group ppf = function
| [] -> assert false
| [s] -> Format.fprintf ppf "%s" s
| (x :: _) as group ->
Format.fprintf ppf "%s.{%a}"
(Filename.chop_extension x)
(Format.pp_print_list ~pp_sep:pp_comma pp_ext)
group in
let pp_contexts ppf = function
| [] -> ()
| ctxs ->
Format.fprintf ppf " @{<details>[%a]@}"
(Format.pp_print_list ~pp_sep:pp_comma
(fun ppf s -> Format.fprintf ppf "%s" s))
ctxs in
Format.fprintf ppf "%a%a"
(Format.pp_print_list ~pp_sep:pp_comma pp_group)
(group_by_ext target_names)
pp_contexts
contexts;
type running_job =
{ id : int
; job : job
@ -350,30 +434,53 @@ module Scheduler = struct
~output:output
~exit_status:status;
if not exiting then begin
let _, progname, _ = split_prog job.job.prog in
match status with
| WEXITED n when code_is_ok job.job.ok_codes n ->
if output <> "" then
Format.eprintf "@{<kwd>Output@}[@{<id>%d@}]:\n%s%!" job.id output;
if n <> 0 then
Format.eprintf
"@{<warning>Warning@}: Command [@{<id>%d@}] exited with code %d, \
but I'm ignore it, hope that's OK.\n%!" job.id n;
if !Clflags.verbose then begin
if output <> "" then
Format.eprintf "@{<kwd>Output@}[@{<id>%d@}]:\n%s%!" job.id output;
if n <> 0 then
Format.eprintf
"@{<warning>Warning@}: Command [@{<id>%d@}] exited with code %d, \
but I'm ignore it, hope that's OK.\n%!" job.id n;
end else if output <> "" || job.job.purpose <> Internal_job then begin
Format.eprintf "@{<ok>%12s@} %a@." progname pp_purpose job.job.purpose;
Format.eprintf "%s%!" output;
end;
Ivar.fill job.job.ivar n
| WEXITED n ->
Format.eprintf "\n@{<kwd>Command@} [@{<id>%d@}] exited with code %d:\n\
@{<prompt>$@} %s\n%s%!"
job.id n
(Ansi_color.strip_colors_for_stderr job.command_line)
(Ansi_color.strip_colors_for_stderr output);
if !Clflags.verbose then begin
Format.eprintf "\n@{<kwd>Command@} [@{<id>%d@}] exited with code %d:\n\
@{<prompt>$@} %s\n%s%!"
job.id n
(Ansi_color.strip_colors_for_stderr job.command_line)
(Ansi_color.strip_colors_for_stderr output)
end else begin
Format.eprintf "@{<error>%12s@} %a @{<error>(exit %d)@}@."
progname pp_purpose job.job.purpose n;
Format.eprintf "@{<details>%s@}@."
(Ansi_color.strip job.command_line);
Format.eprintf "%s%!" output;
end;
die ""
| WSIGNALED n ->
Format.eprintf "\n@{<kwd>Command@} [@{<id>%d@}] got signal %s:\n\
@{<prompt>$@} %s\n%s%!"
job.id (Utils.signal_name n)
(Ansi_color.strip_colors_for_stderr job.command_line)
(Ansi_color.strip_colors_for_stderr output);
if !Clflags.verbose then begin
Format.eprintf "\n@{<kwd>Command@} [@{<id>%d@}] got signal %s:\n\
@{<prompt>$@} %s\n%s%!"
job.id (Utils.signal_name n)
(Ansi_color.strip_colors_for_stderr job.command_line)
(Ansi_color.strip_colors_for_stderr output);
end else begin
Format.eprintf "@{<error>%12s@} %a @{<error>(got signal %s)@}@."
progname pp_purpose job.job.purpose (Utils.signal_name n);
Format.eprintf "@{<details>%s@}@."
(Ansi_color.strip job.command_line);
Format.eprintf "%s%!" output;
end;
die ""
| WSTOPPED _ -> assert false
| WSTOPPED _ -> assert false;
end
let gen_id =
@ -408,17 +515,36 @@ module Scheduler = struct
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 rec wait_for_jobs msg_time jobs = match jobs with
| [] -> ()
| job :: jobs when msg_time > 0. ->
let pid, status = Unix.waitpid [WNOHANG] job.pid in
if pid <> 0 then begin
process_done job status ~exiting:true;
wait_for_jobs msg_time jobs
end else begin
let dt = 0.05 in
let _ = Unix.select [] [] [] dt in
wait_for_jobs (msg_time -. dt) (job :: jobs)
end
| jobs ->
if !Clflags.verbose then begin
let pp_job ppf job =
let (_, name, _) = split_prog job.job.prog in
Format.fprintf ppf "%s [@{<id>%d@}]" name job.id in
Format.eprintf "\nWaiting for the following jobs to finish: %a@."
(Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ") pp_job)
jobs;
end else begin
let n = List.length jobs in
Format.eprintf "\nWaiting for %d %s to finish.@."
n
(if n = 1 then "job" else "jobs")
end;
List.iter jobs ~f:(fun job ->
let _, status = Unix.waitpid [] job.pid in
process_done job status ~exiting:true) in
wait_for_jobs 0.5 jobs
let () =
at_exit (fun () ->
@ -452,7 +578,7 @@ module Scheduler = struct
let job = Queue.pop to_run in
let id = gen_id () in
let command_line = command_line job in
if !Clflags.debug_run then
if !Clflags.verbose then
Format.eprintf "@{<kwd>Running@}[@{<id>%d@}]: %s@." id
(Ansi_color.strip_colors_for_stderr command_line);
let argv = Array.of_list (job.prog :: job.args) in
@ -503,6 +629,7 @@ module Scheduler = struct
let go ?(log=Log.no_log) t =
Lazy.force Ansi_color.setup_env_for_opam_colors;
Log.info log ("Workspace root: " ^ !Clflags.workspace_root);
let cwd = Sys.getcwd () in
go_rec cwd log t
end

9
src/future.mli
View File

@ -44,12 +44,18 @@ and opened_file_desc =
| Fd of Unix.file_descr
| Channel of out_channel
(** Why a Future.t was run *)
type purpose =
| Internal_job
| Build_job of Path.t list
(** [run ?dir ?stdout_to prog args] spawns a sub-process and wait for its termination *)
val run
: ?dir:string
-> ?stdout_to:std_output_to
-> ?stderr_to:std_output_to
-> ?env:string array
-> ?purpose:purpose
-> (unit, 'a) failure_mode
-> string
-> string list
@ -59,6 +65,7 @@ val run
val run_capture
: ?dir:string
-> ?env:string array
-> ?purpose:purpose
-> (string, 'a) failure_mode
-> string
-> string list
@ -66,6 +73,7 @@ val run_capture
val run_capture_line
: ?dir:string
-> ?env:string array
-> ?purpose:purpose
-> (string, 'a) failure_mode
-> string
-> string list
@ -73,6 +81,7 @@ val run_capture_line
val run_capture_lines
: ?dir:string
-> ?env:string array
-> ?purpose:purpose
-> (string list, 'a) failure_mode
-> string
-> string list

11
src/log.ml
View File

@ -21,10 +21,13 @@ let create () =
Some { oc; buf; ppf }
let info_internal { oc; _ } str =
List.iter (String.split_lines str) ~f:(function
| "" -> output_string oc "#\n"
| s -> Printf.fprintf oc "# %s\n" s);
flush oc
let write oc =
List.iter (String.split_lines str) ~f:(function
| "" -> output_string oc "#\n"
| s -> Printf.fprintf oc "# %s\n" s);
flush oc in
write oc;
if !Clflags.verbose then write stderr
let info t str =
match t with

16
test/jbuild
View File

@ -47,3 +47,19 @@
)))))))
;; execute this to check the behavior when background jobs take time to finish:
;;
;; $ ./_build/default/bin/main.exe build @test/fail-with-background-jobs-running
;;
(alias
((name sleep5)
(action (system "sleep 5"))))
(alias
((name sleep1-and-fail)
(action (system "sleep 1; exit 1"))))
(alias
((name fail-with-background-jobs-running)
(deps ((alias sleep5)
(alias sleep1-and-fail)))))