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

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:
Jérémie Dimino 2017-03-13 08:10:33 +00:00
parent 3e9b52ad0f
commit ba08f27678
13 changed files with 236 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
CHANGES.org
View File

@ -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
View File

@ -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

7
doc/manual.org
View File

@ -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

119
src/action.ml
View File

@ -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
| None -> Terminal
| Some (fn, oc) -> Opened_file { filename = fn; tail; desc = Channel oc }
in
let get_std_output : _ -> Future.std_output_to = function
| 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 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 ->
match stdout_to with
| None -> copy_channels ic stdout
| Some (_, oc) ->
copy_channels ic oc;
if tail then close_out oc);
let oc =
match stdout_to with
| 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
src/action.mli
View File

@ -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

2
src/build.ml
View File

@ -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

2
src/config.ml
View File

@ -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")

2
src/config.mli
View File

@ -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

102
src/future.ml
View File

@ -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 with
| Terminal -> s
| File fn | Opened_file { filename = fn; _ } -> sprintf "%s > %s" s fn
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
let len = String.length s in
if len > 0 && s.[len - 1] <> '\n' then
s ^ "\n"
else
s
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

5
src/future.mli
View File

@ -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

6
src/gen_rules.ml
View File

@ -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

8
src/import.ml
View File

@ -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

48
test/jbuild Normal file
View File

@ -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
")))))