Add a few more redirections
- with-{stdout,stderr,outputs}-to - ignore-{stdout,stderr,outputs} - variable ${null} for /dev/null or NUL on Win32
This commit is contained in:
parent
3e9b52ad0f
commit
ba08f27678
|
@ -12,6 +12,13 @@
|
|||
|
||||
- Add a few more things in the log file to help debugging
|
||||
|
||||
- Added a few forms to the DSL:
|
||||
+ =with-{stderr,outputs}-to=
|
||||
+ =ignore-{stdout,stderr,outputs}=
|
||||
|
||||
- Added =${null}= which expands to =/dev/null= on Unix and =NUL= on
|
||||
Windows
|
||||
|
||||
* 1.0+beta1 (07/03/2017)
|
||||
|
||||
- Added a manual
|
||||
|
|
7
Makefile
7
Makefile
|
@ -15,10 +15,13 @@ uninstall:
|
|||
|
||||
reinstall: uninstall reinstall
|
||||
|
||||
test:
|
||||
$(BIN) runtest
|
||||
|
||||
all-supported-ocaml-versions:
|
||||
$(BIN) build @install --workspace jbuild-workspace.dev --root .
|
||||
$(BIN) build @install @runtest --workspace jbuild-workspace.dev --root .
|
||||
|
||||
clean:
|
||||
rm -rf _build
|
||||
|
||||
.PHONY: default install uninstall reinstall clean
|
||||
.PHONY: default install uninstall reinstall clean test
|
||||
|
|
|
@ -614,6 +614,7 @@ Jbuilder supports the following variables:
|
|||
- =ocaml_where= is the output of =ocamlc -where=
|
||||
- =ARCH_SIXTYFOUR= is =true= if using a compiler targeting a 64 bit
|
||||
architecture and =false= otherwise
|
||||
- =null= is =/dev/null= on Unix or =nul= on Windows
|
||||
|
||||
In addition, =(action ...)= fields support the following special variables:
|
||||
|
||||
|
@ -885,7 +886,11 @@ The following constructions are available:
|
|||
- =(run <prog> <args>)= to execute a program
|
||||
- =(chdir <dir> <DSL>)= to change the current directory
|
||||
- =(setenv <var> <value> <DSL>)= to set an environment variable
|
||||
- =(with-stdout-to <file> <DSL>)= to redirect the output to a file
|
||||
- =(with-<outputs>-to <file> <DSL>)= to redirect the output to a file,
|
||||
where =<outputs>= is one of: =stdout=, =stderr= or =outputs= (for
|
||||
both =stdout= and =stderr=)
|
||||
- =(ignore-<outputs> <DSL)= to ignore the output, where =<outputs>= is
|
||||
one of: =stdout=, =stderr= or =outputs=
|
||||
- =(progn <DSL>...)= to execute several commands in sequence
|
||||
- =(echo <string>)= to output a string on stdout
|
||||
- =(cat <file>)= to print the contents of a file to stdout
|
||||
|
|
115
src/action.ml
115
src/action.ml
|
@ -54,11 +54,22 @@ let expand_prog ctx ~dir ~f template =
|
|||
|
||||
module Mini_shexp = struct
|
||||
module Ast = struct
|
||||
type outputs =
|
||||
| Stdout
|
||||
| Stderr
|
||||
| Outputs (* Both Stdout and Stderr *)
|
||||
|
||||
let string_of_outputs = function
|
||||
| Stdout -> "stdout"
|
||||
| Stderr -> "stderr"
|
||||
| Outputs -> "outputs"
|
||||
|
||||
type ('a, 'path) t =
|
||||
| Run of 'path * 'a list
|
||||
| Chdir of 'path * ('a, 'path) t
|
||||
| Setenv of 'a * 'a * ('a, 'path) t
|
||||
| With_stdout_to of 'path * ('a, 'path) t
|
||||
| Redirect of outputs * 'path * ('a, 'path) t
|
||||
| Ignore of outputs * ('a, 'path) t
|
||||
| Progn of ('a, 'path) t list
|
||||
| Echo of 'a
|
||||
| Create_file of 'path
|
||||
|
@ -75,7 +86,12 @@ module Mini_shexp = struct
|
|||
[ cstr_rest "run" (p @> nil) a (fun prog args -> Run (prog, args))
|
||||
; cstr "chdir" (p @> t a p @> nil) (fun dn t -> Chdir (dn, t))
|
||||
; cstr "setenv" (a @> a @> t a p @> nil) (fun k v t -> Setenv (k, v, t))
|
||||
; cstr "with-stdout-to" (p @> t a p @> nil) (fun fn t -> With_stdout_to (fn, t))
|
||||
; cstr "with-stdout-to" (p @> t a p @> nil) (fun fn t -> Redirect (Stdout, fn, t))
|
||||
; cstr "with-stderr-to" (p @> t a p @> nil) (fun fn t -> Redirect (Stderr, fn, t))
|
||||
; cstr "with-outputs-to" (p @> t a p @> nil) (fun fn t -> Redirect (Outputs, fn, t))
|
||||
; cstr "ignore-stdout" (t a p @> nil) (fun t -> Ignore (Stdout, t))
|
||||
; cstr "ignore-stderr" (t a p @> nil) (fun t -> Ignore (Stderr, t))
|
||||
; cstr "ignore-outputs" (t a p @> nil) (fun t -> Ignore (Outputs, t))
|
||||
; cstr_rest "progn" nil (t a p) (fun l -> Progn l)
|
||||
; cstr "echo" (a @> nil) (fun x -> Echo x)
|
||||
; cstr "cat" (p @> nil) (fun x -> Cat x)
|
||||
|
@ -96,7 +112,15 @@ module Mini_shexp = struct
|
|||
| Run (a, xs) -> List (Atom "run" :: g a :: List.map xs ~f)
|
||||
| Chdir (a, r) -> List [Atom "chdir" ; g a ; sexp_of_t f g r]
|
||||
| Setenv (k, v, r) -> List [Atom "setenv" ; f k ; f v ; sexp_of_t f g r]
|
||||
| With_stdout_to (fn, r) -> List [Atom "with-stdout-to"; g fn; sexp_of_t f g r]
|
||||
| Redirect (outputs, fn, r) ->
|
||||
List [ Atom (sprintf "with-%s-to" (string_of_outputs outputs))
|
||||
; g fn
|
||||
; sexp_of_t f g r
|
||||
]
|
||||
| Ignore (outputs, r) ->
|
||||
List [ Atom (sprintf "ignore-%s" (string_of_outputs outputs))
|
||||
; sexp_of_t f g r
|
||||
]
|
||||
| Progn l -> List (Atom "progn" :: List.map l ~f:(sexp_of_t f g))
|
||||
| Echo x -> List [Atom "echo"; f x]
|
||||
| Cat x -> List [Atom "cat"; g x]
|
||||
|
@ -116,7 +140,8 @@ module Mini_shexp = struct
|
|||
| Run (prog, args) -> List.fold_left args ~init:(f acc prog) ~f
|
||||
| Chdir (fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
| Setenv (var, value, t) -> fold t ~init:(f (f acc var) value) ~f
|
||||
| With_stdout_to (fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
| Redirect (_, fn, t) -> fold t ~init:(f acc fn) ~f
|
||||
| Ignore (_, t) -> fold t ~init:acc ~f
|
||||
| Progn l -> List.fold_left l ~init:acc ~f:(fun init t -> fold t ~init ~f)
|
||||
| Echo x -> f acc x
|
||||
| Cat x -> f acc x
|
||||
|
@ -140,7 +165,8 @@ module Mini_shexp = struct
|
|||
| Update_file (fn, _) -> Path.Set.add fn acc
|
||||
| Chdir (_, t)
|
||||
| Setenv (_, _, t)
|
||||
| With_stdout_to (_, t) -> loop acc t
|
||||
| Redirect (_, _, t)
|
||||
| Ignore (_, t) -> loop acc t
|
||||
| Progn l -> List.fold_left l ~init:acc ~f:loop
|
||||
| Run _ -> acc
|
||||
| Echo _
|
||||
|
@ -180,8 +206,10 @@ module Mini_shexp = struct
|
|||
| Setenv (var, value, t) ->
|
||||
Setenv (expand_str ~dir ~f var, expand_str ~dir ~f value,
|
||||
expand ctx dir t ~f)
|
||||
| With_stdout_to (fn, t) ->
|
||||
With_stdout_to (expand_path ~dir ~f fn, expand ctx dir t ~f)
|
||||
| Redirect (outputs, fn, t) ->
|
||||
Redirect (outputs, expand_path ~dir ~f fn, expand ctx dir t ~f)
|
||||
| Ignore (outputs, t) ->
|
||||
Ignore (outputs, expand ctx dir t ~f)
|
||||
| Progn l -> Progn (List.map l ~f:(fun t -> expand ctx dir t ~f))
|
||||
| Echo x -> Echo (expand_str ~dir ~f x)
|
||||
| Cat x -> Cat (expand_path ~dir ~f x)
|
||||
|
@ -199,46 +227,45 @@ module Mini_shexp = struct
|
|||
|
||||
open Future
|
||||
|
||||
let run ~dir ~env ~env_extra ~stdout_to ~tail prog args =
|
||||
let stdout_to : Future.stdout_to =
|
||||
match stdout_to with
|
||||
let get_std_output : _ -> Future.std_output_to = function
|
||||
| None -> Terminal
|
||||
| Some (fn, oc) -> Opened_file { filename = fn; tail; desc = Channel oc }
|
||||
in
|
||||
| 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 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
|
||||
Future.run Strict ~dir:(Path.to_string dir) ~env ~stdout_to ~stderr_to
|
||||
(Path.reach_for_running ~from:dir prog) args
|
||||
|
||||
let rec exec t ~dir ~env ~env_extra ~stdout_to ~tail =
|
||||
let rec exec t ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
match t with
|
||||
| Run (prog, args) ->
|
||||
run ~dir ~env ~env_extra ~stdout_to ~tail prog args
|
||||
run ~dir ~env ~env_extra ~stdout_to ~stderr_to prog args
|
||||
| Chdir (dir, t) ->
|
||||
exec t ~env ~env_extra ~stdout_to ~tail ~dir
|
||||
exec t ~env ~env_extra ~stdout_to ~stderr_to ~dir
|
||||
| Setenv (var, value, t) ->
|
||||
exec t ~dir ~env ~stdout_to ~tail
|
||||
exec t ~dir ~env ~stdout_to ~stderr_to
|
||||
~env_extra:(String_map.add env_extra ~key:var ~data:value)
|
||||
| With_stdout_to (fn, t) ->
|
||||
if tail then Option.iter stdout_to ~f:(fun (_, oc) -> close_out oc);
|
||||
let fn = Path.to_string fn in
|
||||
exec t ~dir ~env ~env_extra ~tail
|
||||
~stdout_to:(Some (fn, open_out_bin fn))
|
||||
| Redirect (outputs, fn, t) ->
|
||||
redirect 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
|
||||
| Progn l ->
|
||||
exec_list l ~dir ~env ~env_extra ~stdout_to ~tail
|
||||
exec_list l ~dir ~env ~env_extra ~stdout_to ~stderr_to
|
||||
| Echo str ->
|
||||
return
|
||||
(match stdout_to with
|
||||
| None -> print_string str; flush stdout
|
||||
| Some (_, oc) ->
|
||||
output_string oc str;
|
||||
if tail then close_out oc)
|
||||
| Some (_, oc) -> output_string oc str)
|
||||
| Cat fn ->
|
||||
with_file_in (Path.to_string fn) ~f:(fun ic ->
|
||||
let oc =
|
||||
match stdout_to with
|
||||
| None -> copy_channels ic stdout
|
||||
| Some (_, oc) ->
|
||||
copy_channels ic oc;
|
||||
if tail then close_out oc);
|
||||
| None -> stdout
|
||||
| Some (_, oc) -> oc
|
||||
in
|
||||
copy_channels ic oc);
|
||||
return ()
|
||||
| Create_file fn ->
|
||||
let fn = Path.to_string fn in
|
||||
|
@ -287,10 +314,10 @@ module Mini_shexp = struct
|
|||
match err with
|
||||
| Some err -> err.fail ()
|
||||
| None ->
|
||||
run ~dir ~env ~env_extra ~stdout_to ~tail path [arg; cmd]
|
||||
run ~dir ~env ~env_extra ~stdout_to ~stderr_to path [arg; cmd]
|
||||
end
|
||||
| Bash cmd ->
|
||||
run ~dir ~env ~env_extra ~stdout_to ~tail
|
||||
run ~dir ~env ~env_extra ~stdout_to ~stderr_to
|
||||
(Path.absolute "/bin/bash")
|
||||
["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
|
||||
| Update_file (fn, s) ->
|
||||
|
@ -301,16 +328,28 @@ module Mini_shexp = struct
|
|||
write_file fn s;
|
||||
return ()
|
||||
|
||||
and exec_list l ~dir ~env ~env_extra ~stdout_to ~tail =
|
||||
and redirect outputs fn t ~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
|
||||
let stdout_to, stderr_to =
|
||||
match outputs with
|
||||
| Stdout -> (out, stderr_to)
|
||||
| Stderr -> (stdout_to, out)
|
||||
| Outputs -> (out, out)
|
||||
in
|
||||
exec t ~dir ~env ~env_extra ~stdout_to ~stderr_to >>| fun () ->
|
||||
close_out oc
|
||||
|
||||
and exec_list l ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
match l with
|
||||
| [] ->
|
||||
if tail then Option.iter stdout_to ~f:(fun (_, oc) -> close_out oc);
|
||||
Future.return ()
|
||||
| [t] ->
|
||||
exec t ~dir ~env ~env_extra ~stdout_to ~tail
|
||||
exec t ~dir ~env ~env_extra ~stdout_to ~stderr_to
|
||||
| t :: rest ->
|
||||
exec t ~dir ~env ~env_extra ~stdout_to ~tail:false >>= fun () ->
|
||||
exec_list rest ~dir ~env ~env_extra ~stdout_to ~tail
|
||||
exec t ~dir ~env ~env_extra ~stdout_to ~stderr_to >>= fun () ->
|
||||
exec_list rest ~dir ~env ~env_extra ~stdout_to ~stderr_to
|
||||
end
|
||||
|
||||
type t =
|
||||
|
@ -354,7 +393,7 @@ let exec { action; dir; context } =
|
|||
| Some c -> c.env
|
||||
in
|
||||
Mini_shexp.exec action ~dir ~env ~env_extra:String_map.empty
|
||||
~stdout_to:None ~tail:true
|
||||
~stdout_to:None ~stderr_to:None
|
||||
|
||||
type for_hash = string option * Path.t * Mini_shexp.t
|
||||
|
||||
|
|
|
@ -8,11 +8,17 @@ type var_expansion =
|
|||
|
||||
module Mini_shexp : sig
|
||||
module Ast : sig
|
||||
type outputs =
|
||||
| Stdout
|
||||
| Stderr
|
||||
| Outputs (** Both Stdout and Stderr *)
|
||||
|
||||
type ('a, 'path) t =
|
||||
| Run of 'path * 'a list
|
||||
| Chdir of 'path * ('a, 'path) t
|
||||
| Setenv of 'a * 'a * ('a, 'path) t
|
||||
| With_stdout_to of 'path * ('a, 'path) t
|
||||
| Redirect of outputs * 'path * ('a, 'path) t
|
||||
| Ignore of outputs * ('a, 'path) t
|
||||
| Progn of ('a, 'path) t list
|
||||
| Echo of 'a
|
||||
| Create_file of 'path
|
||||
|
|
|
@ -157,7 +157,7 @@ let run ?(dir=Path.root) ?stdout_to ?context ?(extra_targets=[]) prog args =
|
|||
let action =
|
||||
match stdout_to with
|
||||
| None -> action
|
||||
| Some path -> With_stdout_to (path, action)
|
||||
| Some path -> Redirect (Stdout, path, action)
|
||||
in
|
||||
{ Action.
|
||||
dir
|
||||
|
|
|
@ -14,3 +14,5 @@ let local_install_lib_dir ~context ~package =
|
|||
Path.relative
|
||||
(Path.relative (local_install_dir ~context) "lib")
|
||||
package
|
||||
|
||||
let dev_null = Path.of_string (if Sys.win32 then "nul" else "/dev/null")
|
||||
|
|
|
@ -8,3 +8,5 @@ val local_install_dir : context:string -> Path.t
|
|||
val local_install_bin_dir : context:string -> Path.t
|
||||
val local_install_man_dir : context:string -> Path.t
|
||||
val local_install_lib_dir : context:string -> package:string -> Path.t
|
||||
|
||||
val dev_null : Path.t
|
||||
|
|
|
@ -152,7 +152,7 @@ let map_result
|
|||
| 0 -> Ok (f ())
|
||||
| n -> Error n
|
||||
|
||||
type stdout_to =
|
||||
type std_output_to =
|
||||
| Terminal
|
||||
| File of string
|
||||
| Opened_file of opened_file
|
||||
|
@ -171,7 +171,8 @@ type job =
|
|||
{ prog : string
|
||||
; args : string list
|
||||
; dir : string option
|
||||
; stdout_to : stdout_to
|
||||
; stdout_to : std_output_to
|
||||
; stderr_to : std_output_to
|
||||
; env : string array option
|
||||
; ivar : int Ivar.t
|
||||
; ok_codes : int list
|
||||
|
@ -179,7 +180,7 @@ type job =
|
|||
|
||||
let to_run : job Queue.t = Queue.create ()
|
||||
|
||||
let run_internal ?dir ?(stdout_to=Terminal) ?env fail_mode prog args =
|
||||
let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ?env fail_mode prog args =
|
||||
let dir =
|
||||
match dir with
|
||||
| Some "." -> None
|
||||
|
@ -190,13 +191,14 @@ let run_internal ?dir ?(stdout_to=Terminal) ?env fail_mode prog args =
|
|||
; args
|
||||
; dir
|
||||
; stdout_to
|
||||
; stderr_to
|
||||
; env
|
||||
; ivar
|
||||
; ok_codes = accepted_codes fail_mode
|
||||
} to_run)
|
||||
|
||||
let run ?dir ?stdout_to ?env fail_mode prog args =
|
||||
map_result fail_mode (run_internal ?dir ?stdout_to ?env fail_mode prog args)
|
||||
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)
|
||||
~f:ignore
|
||||
|
||||
module Temp = struct
|
||||
|
@ -284,7 +286,7 @@ module Scheduler = struct
|
|||
"-o" :: Ansi_color.(apply_string output_filename) fn :: colorize_args rest
|
||||
| x :: rest -> x :: colorize_args rest
|
||||
|
||||
let command_line { prog; args; dir; stdout_to; _ } =
|
||||
let command_line { prog; args; dir; stdout_to; stderr_to; _ } =
|
||||
let quote = quote_for_shell in
|
||||
let prog = colorize_prog (quote prog) in
|
||||
let s = String.concat (prog :: colorize_args (List.map args ~f:quote)) ~sep:" " in
|
||||
|
@ -293,15 +295,25 @@ module Scheduler = struct
|
|||
| None -> s
|
||||
| Some dir -> sprintf "(cd %s && %s)" dir s
|
||||
in
|
||||
match stdout_to, stderr_to with
|
||||
| (File fn1 | Opened_file { filename = fn1; _ }),
|
||||
(File fn2 | Opened_file { filename = fn2; _ }) when fn1 = fn2 ->
|
||||
sprintf "%s &> %s" s fn1
|
||||
| _ ->
|
||||
let s =
|
||||
match stdout_to with
|
||||
| Terminal -> s
|
||||
| File fn | Opened_file { filename = fn; _ } -> sprintf "%s > %s" s fn
|
||||
in
|
||||
match stderr_to with
|
||||
| Terminal -> s
|
||||
| File fn | Opened_file { filename = fn; _ } -> sprintf "%s 2> %s" s fn
|
||||
|
||||
type running_job =
|
||||
{ id : int
|
||||
; job : job
|
||||
; pid : int
|
||||
; output_filename : string
|
||||
; output_filename : string option
|
||||
; (* for logs, with ansi colors code always included in the string *)
|
||||
command_line : string
|
||||
; log : Log.t
|
||||
|
@ -312,14 +324,17 @@ module Scheduler = struct
|
|||
let process_done ?(exiting=false) job (status : Unix.process_status) =
|
||||
Hashtbl.remove running job.pid;
|
||||
let output =
|
||||
let s = read_file job.output_filename in
|
||||
match job.output_filename with
|
||||
| None -> ""
|
||||
| Some fn ->
|
||||
let s = read_file fn in
|
||||
Temp.destroy fn;
|
||||
let len = String.length s in
|
||||
if len > 0 && s.[len - 1] <> '\n' then
|
||||
s ^ "\n"
|
||||
else
|
||||
s
|
||||
in
|
||||
Temp.destroy job.output_filename;
|
||||
Log.command job.log
|
||||
~command_line:job.command_line
|
||||
~output:output
|
||||
|
@ -400,6 +415,24 @@ module Scheduler = struct
|
|||
wait_for_unfinished_jobs ();
|
||||
exec_at_exit_handlers ())
|
||||
|
||||
let get_std_output ~default = function
|
||||
| Terminal -> (default, None)
|
||||
| File fn ->
|
||||
let fd = Unix.openfile fn [O_WRONLY; O_CREAT; O_TRUNC] 0o666 in
|
||||
(fd, Some (Fd fd))
|
||||
| Opened_file { desc; tail; _ } ->
|
||||
let fd =
|
||||
match desc with
|
||||
| Fd fd -> fd
|
||||
| Channel oc -> flush oc; Unix.descr_of_out_channel oc
|
||||
in
|
||||
(fd, Option.some_if tail desc)
|
||||
|
||||
let close_std_output = function
|
||||
| None -> ()
|
||||
| Some (Fd fd) -> Unix.close fd
|
||||
| Some (Channel oc) -> close_out oc
|
||||
|
||||
let rec go_rec cwd log t =
|
||||
match (repr t).state with
|
||||
| Return v -> v
|
||||
|
@ -413,37 +446,30 @@ module Scheduler = struct
|
|||
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
|
||||
let output_filename = Temp.create "jbuilder" ".output" in
|
||||
let output_fd = Unix.openfile output_filename [O_WRONLY] 0 in
|
||||
let stdout, close_stdout =
|
||||
match job.stdout_to with
|
||||
| Terminal -> (output_fd, None)
|
||||
| File fn ->
|
||||
let fd = Unix.openfile fn [O_WRONLY; O_CREAT; O_TRUNC] 0o666 in
|
||||
(fd, Some (Fd fd))
|
||||
| Opened_file { desc; tail; _ } ->
|
||||
let fd =
|
||||
match desc with
|
||||
| Fd fd -> fd
|
||||
| Channel oc -> flush oc; Unix.descr_of_out_channel oc
|
||||
in
|
||||
(fd, Option.some_if tail desc)
|
||||
let output_filename, output_fd =
|
||||
match job.stdout_to, job.stderr_to with
|
||||
| Terminal, _ | _, Terminal ->
|
||||
let fn = Temp.create "jbuilder" ".output" in
|
||||
(Some fn, Unix.openfile fn [O_WRONLY] 0)
|
||||
| _ ->
|
||||
(None, Unix.stdin)
|
||||
in
|
||||
let stdout, close_stdout = get_std_output job.stdout_to ~default:output_fd in
|
||||
let stderr, close_stderr = get_std_output job.stderr_to ~default:output_fd in
|
||||
Option.iter job.dir ~f:(fun dir -> Sys.chdir dir);
|
||||
let pid =
|
||||
match job.env with
|
||||
| None ->
|
||||
Unix.create_process job.prog argv
|
||||
Unix.stdin stdout output_fd
|
||||
Unix.stdin stdout stderr
|
||||
| Some env ->
|
||||
Unix.create_process_env job.prog argv env
|
||||
Unix.stdin stdout output_fd
|
||||
Unix.stdin stdout stderr
|
||||
in
|
||||
Option.iter job.dir ~f:(fun _ -> Sys.chdir cwd);
|
||||
Unix.close output_fd;
|
||||
Option.iter close_stdout ~f:(function
|
||||
| Fd fd -> Unix.close fd
|
||||
| Channel oc -> close_out oc);
|
||||
if Option.is_some output_filename then Unix.close output_fd;
|
||||
close_std_output close_stdout;
|
||||
close_std_output close_stderr;
|
||||
Hashtbl.add running ~key:pid
|
||||
~data:{ id
|
||||
; job
|
||||
|
|
|
@ -24,7 +24,7 @@ type ('a, 'b) failure_mode =
|
|||
exists with one of these codes. *)
|
||||
|
||||
(** Where to redirect standard output *)
|
||||
type stdout_to =
|
||||
type std_output_to =
|
||||
| Terminal
|
||||
| File of string
|
||||
| Opened_file of opened_file
|
||||
|
@ -43,7 +43,8 @@ and opened_file_desc =
|
|||
(** [run ?dir ?stdout_to prog args] spawns a sub-process and wait for its termination *)
|
||||
val run
|
||||
: ?dir:string
|
||||
-> ?stdout_to:stdout_to
|
||||
-> ?stdout_to:std_output_to
|
||||
-> ?stderr_to:std_output_to
|
||||
-> ?env:string array
|
||||
-> (unit, 'a) failure_mode
|
||||
-> string
|
||||
|
|
|
@ -389,6 +389,7 @@ module Gen(P : Params) = struct
|
|||
; "ARCH_SIXTYFOUR" , string_of_bool ctx.arch_sixtyfour
|
||||
; "PORTABLE_INT63" , "true"
|
||||
; "MAKE" , make
|
||||
; "null" , Path.to_string Config.dev_null
|
||||
] |> String_map.of_alist
|
||||
|> function
|
||||
| Ok x -> x
|
||||
|
@ -829,8 +830,9 @@ module Gen(P : Params) = struct
|
|||
Build.path src
|
||||
>>>
|
||||
Action_interpret.run
|
||||
(With_stdout_to
|
||||
(target_var,
|
||||
(Redirect
|
||||
(Stdout,
|
||||
target_var,
|
||||
Chdir (root_var,
|
||||
action)))
|
||||
~dir
|
||||
|
|
|
@ -319,6 +319,14 @@ module Option = struct
|
|||
|
||||
let some_if cond x =
|
||||
if cond then Some x else None
|
||||
|
||||
let is_some = function
|
||||
| None -> false
|
||||
| Some _ -> true
|
||||
|
||||
let is_none = function
|
||||
| None -> true
|
||||
| Some _ -> false
|
||||
end
|
||||
|
||||
type ('a, 'b) eq = Eq : ('a, 'a) eq
|
||||
|
|
|
@ -0,0 +1,48 @@
|
|||
(rule
|
||||
((targets (stdout stderr))
|
||||
(action (with-stdout-to stdout
|
||||
(with-stderr-to stderr
|
||||
(progn
|
||||
(system "echo toto")
|
||||
(system "echo titi >&2")))))))
|
||||
|
||||
(rule
|
||||
((targets (both))
|
||||
(action (with-outputs-to both
|
||||
(progn
|
||||
(system "echo toto")
|
||||
(system "echo titi >&2"))))))
|
||||
|
||||
(rule
|
||||
((targets (stdout.expected))
|
||||
(action (with-stdout-to ${@} (echo "toto\n")))))
|
||||
|
||||
(rule
|
||||
((targets (stderr.expected))
|
||||
(action (with-stdout-to ${@} (echo "titi\n")))))
|
||||
|
||||
(rule
|
||||
((targets (both.expected))
|
||||
(action (with-stdout-to ${@} (echo "toto\ntiti\n")))))
|
||||
|
||||
(alias
|
||||
((name runtest)
|
||||
(deps (stdout stdout.expected))
|
||||
(action (run diff -u stdout.expected stdout))))
|
||||
|
||||
(alias
|
||||
((name runtest)
|
||||
(deps (stderr stderr.expected))
|
||||
(action (run diff -u stderr.expected stderr))))
|
||||
|
||||
(alias
|
||||
((name runtest)
|
||||
(deps (both both.expected))
|
||||
(action (run diff -u both.expected both))))
|
||||
|
||||
(alias
|
||||
((name runtest)
|
||||
(action (ignore-stdout (echo "\
|
||||
==========================
|
||||
If you see this, something is wrong
|
||||
")))))
|
Loading…
Reference in New Issue