let assert_command
?(exit_code=Unix.WEXITED 0)
?(sinput=Stream.of_list [])
?(foutput=ignore)
?(use_stderr=true)
?(backtrace=true)
?chdir
?env
~ctxt
prg args =
OUnitTest.section_ctxt ctxt
(fun ctxt ->
let (fn_out, chn_out) = bracket_tmpfile ctxt in
let cmd_print fmt =
Format.pp_print_string fmt prg;
List.iter (Format.fprintf fmt "@ %s") args
in
let in_write =
Unix.dup (Unix.descr_of_out_channel chn_out)
in
let (out_read, out_write) =
Unix.pipe ()
in
let err =
if use_stderr then
in_write
else
Unix.stderr
in
let args =
Array.of_list (prg :: args)
in
let env =
let param = "OCAMLRUNPARAM" in
let analyse_and_fix env =
let arr = Array.copy env in
let fixed = ref false in
let new_var = ref "" in
for i = 0 to (Array.length arr) - 1 do
let really_starts, current_value =
OUnitUtils.start_substr ~prefix:(param^"=") arr.(i)
in
if really_starts then begin
if not (String.contains current_value 'b') then begin
arr.(i) <- param^"="^current_value^"b"
end;
new_var := arr.(i);
fixed := true
end
done;
if !fixed then
arr
else
Array.append arr [|param^"=b"|]
in
if backtrace then begin
match env with
| Some env ->
Some (analyse_and_fix env)
| None ->
Some (analyse_and_fix (Unix.environment ()))
end else begin
env
end
in
let command_chdir, in_chdir =
match chdir with
| Some dn ->
dn,
fun f ->
with_bracket ctxt (bracket_chdir dn)
(fun () _ -> f ())
| None ->
Sys.getcwd (), fun f -> f ()
in
let pid =
OUnitLogger.Test.logf ctxt.test_logger `Info "%s"
(buff_format_printf
(fun fmt ->
Format.fprintf fmt "Starting command '%t'." cmd_print));
OUnitLogger.Test.logf ctxt.test_logger `Info "Working directory: %S"
command_chdir;
OUnitLogger.Test.logf ctxt.test_logger `Info "Environment: ";
Array.iter
(fun v ->
OUnitLogger.Test.logf ctxt.test_logger `Info "%s" v)
(match env with
| Some e -> e
| None -> Unix.environment ());
Unix.set_close_on_exec out_write;
match env with
| Some e ->
in_chdir
(fun () ->
Unix.create_process_env prg args e out_read in_write err)
| None ->
in_chdir
(fun () ->
Unix.create_process prg args out_read in_write err)
in
let () =
Unix.close out_read;
Unix.close in_write
in
let () =
let buff = " " in
Stream.iter
(fun c ->
let _i : int =
buff.[0] <- c;
Unix.write out_write buff 0 1
in
())
sinput;
Unix.close out_write
in
let _, real_exit_code =
let rec wait_intr () =
try
Unix.waitpid [] pid
with Unix.Unix_error (Unix.EINTR, _, _) ->
wait_intr ()
in
wait_intr ()
in
begin
let chn = open_in fn_out in
let buff = String.make 4096 'X' in
let len = ref (-1) in
while !len <> 0 do
len := input chn buff 0 (String.length buff);
OUnitLogger.Test.raw_printf
ctxt.test_logger "%s" (String.sub buff 0 !len);
done;
close_in chn
end;
assert_equal
~msg:(buff_format_printf
(fun fmt ->
Format.fprintf fmt
"@[Exit status of command '%t'@]" cmd_print))
~printer:string_of_process_status
exit_code
real_exit_code;
begin
let chn = open_in fn_out in
try
foutput (Stream.of_channel chn)
with e ->
close_in chn;
raise e
end)