From 882e3b2ad3964f25348d7ee7cacceb0ea9ae9a99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20A=2E=20Bartnik?= Date: Sun, 12 Aug 2018 21:21:32 -0700 Subject: [PATCH] Add process_exists() (#62) * add process_exists * fix race in signal testing * update NEWS * do not check the exit code in signal testing in Windows --- NAMESPACE | 1 + NEWS.md | 2 + R/subprocess.R | 81 +++++++++++++++++++------------ man/process_exists.Rd | 17 +++++++ src/config-os.h | 4 +- src/rapi.cc | 33 +++++++++---- src/rapi.h | 2 + src/registration.cpp | 1 + src/sub-linux.cc | 7 +++ src/sub-windows.cc | 53 ++++++++++++-------- src/subprocess.h | 38 +++++++++------ tests/testthat/helper-processes.R | 20 ++------ tests/testthat/signal-trap.sh | 2 + tests/testthat/test-signals.R | 38 ++++++++++----- tests/testthat/test-subprocess.R | 12 ++--- 15 files changed, 198 insertions(+), 113 deletions(-) create mode 100644 man/process_exists.Rd diff --git a/NAMESPACE b/NAMESPACE index ab592ce..58ff93a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,6 +32,7 @@ export(TIMEOUT_IMMEDIATE) export(TIMEOUT_INFINITE) export(is_process_handle) export(process_close_input) +export(process_exists) export(process_kill) export(process_read) export(process_return_code) diff --git a/NEWS.md b/NEWS.md index ed88b28..831462d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,8 @@ * replace `select()` with `poll()` +* new API: `process_exists()` + # subprocess 0.8.2 * fixes in test cases for `testthat` 2.0 diff --git a/R/subprocess.R b/R/subprocess.R index 6e3760b..6fdb755 100644 --- a/R/subprocess.R +++ b/R/subprocess.R @@ -3,12 +3,12 @@ NULL #' Start a new child process. -#' +#' #' @description #' In Linux, the usual combination of `fork()` and `exec()` #' is used to spawn a new child process. Standard streams are redirected #' over regular unnamed `pipe`s. -#' +#' #' In Windows a new process is spawned with `CreateProcess()` and #' streams are redirected over unnamed pipes obtained with #' `CreatePipe()`. However, because non-blocking (*overlapped* @@ -16,24 +16,24 @@ NULL #' two reader threads are created for each new child process. These #' threads never touch memory allocated by R and thus they will not #' interfere with R interpreter's memory management (garbage collection). -#' -#' +#' +#' #' @details #' `command` is always prepended to `arguments` so that the #' child process can correcty recognize the name of its executable #' via its `argv` vector. This is done automatically by #' `spawn_process`. -#' +#' #' `environment` can be passed as a `character` vector whose #' elements take the form `"NAME=VALUE"`, a named `character` #' vector or a named `list`. -#' +#' #' `workdir` is the path to the directory where the new process is #' ought to be started. `NULL` and `""` mean that working #' directory is inherited from the parent. -#' +#' #' @section Termination: -#' +#' #' The `termination_mode` specifies what should happen when #' `process_terminate()` or `process_kill()` is called on a #' subprocess. If it is set to `TERMINATION_GROUP`, then the @@ -41,13 +41,13 @@ NULL #' (sub-processes). If termination mode is set to #' `TERMINATION_CHILD_ONLY`, only the child process spawned #' directly from the R session receives the signal. -#' +#' #' In Windows this is implemented with the job API, namely #' `CreateJobObject()`, `AssignProcessToJobObject()` and #' `TerminateJobObject()`. In Linux, the child calls `setsid()` #' after `fork()` but before `execve()`, and `kill()` is #' called with the negate process id. -#' +#' #' @param command Path to the executable. #' @param arguments Optional arguments for the program. #' @param environment Optional environment. @@ -58,10 +58,10 @@ NULL #' @return `spawn_process()` returns an object of the #' *process handle* class. #' @rdname spawn_process -#' +#' #' @format `TERMINATION_GROUP` and `TERMINATION_CHILD_ONLY` #' are single `character` values. -#' +#' #' @export spawn_process <- function (command, arguments = character(), environment = character(), workdir = "", termination_mode = TERMINATION_GROUP) @@ -76,7 +76,7 @@ spawn_process <- function (command, arguments = character(), environment = chara } environment <- paste(names(environment), as.character(environment), sep = '=') } - + if(!(is.null(workdir) || identical(workdir, ""))){ workdir <- normalizePath(workdir, mustWork = TRUE) } @@ -92,7 +92,7 @@ spawn_process <- function (command, arguments = character(), environment = chara #' @param x Object to be printed or tested. #' @param ... Other parameters passed to the `print` method. -#' +#' #' @export #' @rdname spawn_process print.process_handle <- function (x, ...) @@ -101,14 +101,14 @@ print.process_handle <- function (x, ...) cat('command : ', x$command, ' ', paste(x$arguments, collapse = ' '), '\n', sep = '') cat('system id : ', as.integer(x$c_handle), '\n', sep = '') cat('state : ', process_state(x), '\n', sep = '') - + invisible(x) } #' @description `is_process_handle()` verifies that an object is a #' valid *process handle* as returned by `spawn_process()`. -#' +#' #' @export #' @rdname spawn_process is_process_handle <- function (x) @@ -118,37 +118,37 @@ is_process_handle <- function (x) #' Terminating a Child Process. -#' +#' #' @description -#' +#' #' These functions give access to the state of the child process and to #' its exit status (return code). -#' +#' #' The `timeout` parameter can take one of three values: #' \itemize{ #' \item `0` which means no timeout #' \item `-1` which means "wait until there is data to read" #' \item a positive integer, which is the actual timeout in milliseconds #' } -#' +#' #' @details `process_wait()` checks the state of the child process #' by invoking the system call `waitpid()` or #' `WaitForSingleObject()`. -#' +#' #' @param handle Process handle obtained from `spawn_process`. #' @param timeout Optional timeout in milliseconds. -#' +#' #' @return `process_wait()` returns an `integer` exit code #' of the child process or `NA` if the child process has not exited #' yet. The same value can be accessed by `process_return_code()`. -#' +#' #' @name terminating #' @rdname terminating #' @export -#' +#' #' @seealso [spawn_process()], [process_read()] #' [signals()] -#' +#' process_wait <- function (handle, timeout = TIMEOUT_INFINITE) { stopifnot(is_process_handle(handle)) @@ -160,10 +160,10 @@ process_wait <- function (handle, timeout = TIMEOUT_INFINITE) #' `process_wait()` with no timeout and returns one of these #' values: `"not-started"`. `"running"`, `"exited"`, #' `"terminated"`. -#' +#' #' @rdname terminating #' @export -#' +#' process_state <- function (handle) { stopifnot(is_process_handle(handle)) @@ -174,10 +174,10 @@ process_state <- function (handle) #' @details `process_return_code()` gives access to the value #' returned also by `process_wait()`. It does not invoke #' `process_wait()` behind the scenes. -#' +#' #' @rdname terminating #' @export -#' +#' process_return_code <- function (handle) { stopifnot(is_process_handle(handle)) @@ -185,6 +185,23 @@ process_return_code <- function (handle) } +#' Check if process with a given id exists. +#' +#' @param x A process handle returned by [spawn_process] or a OS-level process id. +#' @return `TRUE` if process exists, `FALSE` otherwise. +#' +#' @export +#' +process_exists <- function (x) +{ + if (is_process_handle(x)) { + x <- x$c_handle + } + + isTRUE(.Call("C_process_exists", as.integer(x))) +} + + #' @description `TIMEOUT_INFINITE` denotes an "infinite" timeout #' (that is, wait until response is available) when waiting for an #' operation to complete. @@ -197,7 +214,7 @@ TIMEOUT_INFINITE <- -1L #' @description `TIMEOUT_IMMEDIATE` denotes an "immediate" timeout #' (in other words, no timeout) when waiting for an operation to #' complete. -#' +#' #' @rdname terminating #' @export TIMEOUT_IMMEDIATE <- 0L @@ -206,7 +223,7 @@ TIMEOUT_IMMEDIATE <- 0L #' @description `TERMINATION_GROUP`: `process_terminate(handle)` #' and `process_kill(handle)` deliver the signal to the child #' process pointed to by `handle` and all of its descendants. -#' +#' #' @rdname spawn_process #' @export TERMINATION_GROUP <- "group" @@ -216,7 +233,7 @@ TERMINATION_GROUP <- "group" #' `process_terminate(handle)` and `process_kill(handle)` #' deliver the signal only to the child process pointed to by #' `handle` but to none of its descendants. -#' +#' #' @rdname spawn_process #' @export TERMINATION_CHILD_ONLY <- "child_only" diff --git a/man/process_exists.Rd b/man/process_exists.Rd new file mode 100644 index 0000000..4ad6483 --- /dev/null +++ b/man/process_exists.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/subprocess.R +\name{process_exists} +\alias{process_exists} +\title{Check if process with a given id exists.} +\usage{ +process_exists(x) +} +\arguments{ +\item{x}{A process handle returned by \link{spawn_process} or a OS-level process id.} +} +\value{ +\code{TRUE} if process exists, \code{FALSE} otherwise. +} +\description{ +Check if process with a given id exists. +} diff --git a/src/config-os.h b/src/config-os.h index d8dfba9..6eaa338 100644 --- a/src/config-os.h +++ b/src/config-os.h @@ -18,7 +18,7 @@ #ifdef SUBPROCESS_WINDOWS #define EXPORT __declspec( dllexport ) #else -#define EXPORT +#define EXPORT #endif @@ -55,6 +55,7 @@ #undef length typedef HANDLE process_handle_type; +typedef DWORD pid_type; typedef HANDLE pipe_handle_type; constexpr pipe_handle_type HANDLE_CLOSED = nullptr; @@ -63,6 +64,7 @@ constexpr pipe_handle_type HANDLE_CLOSED = nullptr; #include typedef pid_t process_handle_type; +typedef pid_t pid_type; typedef int pipe_handle_type; constexpr pipe_handle_type HANDLE_CLOSED = -1; diff --git a/src/rapi.cc b/src/rapi.cc index 989559b..669826d 100644 --- a/src/rapi.cc +++ b/src/rapi.cc @@ -120,7 +120,7 @@ SEXP C_process_spawn (SEXP _command, SEXP _arguments, SEXP _environment, SEXP _w char ** arguments = to_C_array(_arguments); char ** environment = to_C_array(_environment); - + /* if environment if empty, simply ignore it */ if (!environment || !*environment) { // allocated with Calloc() but Free() is still needed @@ -222,7 +222,7 @@ SEXP C_process_read (SEXP _handle, SEXP _pipe, SEXP _timeout) /* determine which pipe */ const char * pipe = translateChar(STRING_ELT(_pipe, 0)); pipe_type which_pipe; - + if (!strncmp(pipe, "stdout", 6)) which_pipe = PIPE_STDOUT; else if (!strncmp(pipe, "stderr", 6)) @@ -232,8 +232,8 @@ SEXP C_process_read (SEXP _handle, SEXP _pipe, SEXP _timeout) else { Rf_error("unrecognized `pipe` value"); } - - try_run(&process_handle_t::read, handle, which_pipe, timeout); + + try_run(&process_handle_t::read, handle, which_pipe, timeout); /* produce the result - a list of one or two elements */ SEXP ans, nms; @@ -259,7 +259,7 @@ SEXP C_process_close_input (SEXP _handle) { process_handle_t * handle = extract_process_handle(_handle); try_run(&process_handle_t::close_input, handle); - return allocate_TRUE(); + return allocate_TRUE(); } @@ -272,7 +272,7 @@ SEXP C_process_write (SEXP _handle, SEXP _message) } const char * message = translateChar(STRING_ELT(_message, 0)); - size_t ret = try_run(&process_handle_t::write, handle, message, strlen(message)); + size_t ret = try_run(&process_handle_t::write, handle, message, strlen(message)); return allocate_single_int((int)ret); } @@ -370,6 +370,19 @@ SEXP C_process_send_signal (SEXP _handle, SEXP _signal) } +SEXP C_process_exists (SEXP _pid) +{ + if (!is_single_integer(_pid)) { + Rf_error("`pid` must be a single integer value"); + } + + int pid = INTEGER_DATA(_pid)[0]; + bool ret = subprocess::process_exists(static_cast(pid)); + + return allocate_single_bool(ret); +} + + SEXP C_known_signals () { SEXP ans; @@ -415,7 +428,7 @@ SEXP C_known_signals () #endif setAttrib(ans, R_NamesSymbol, ansnames); - + /* ans, ansnames */ UNPROTECT(2); return ans; @@ -435,16 +448,16 @@ SEXP C_signal (SEXP _signal, SEXP _handler) if (!is_nonempty_string(_handler)) { error("`handler` needs to be a single character value"); } - + const char * handler = translateChar(STRING_ELT(_handler, 0)); if (!strncmp(handler, "ignore", 6) && !strncmp(handler, "default", 7)) { error("`handler` can be either \"ignore\" or \"default\""); } - + int sgn = INTEGER_DATA(_signal)[0]; typedef void (*sighandler_t)(int); sighandler_t hnd = (strncmp(handler, "ignore", 6) ? SIG_DFL : SIG_IGN); - + if (signal(sgn, hnd) == SIG_ERR) { Rf_error("error while calling signal()"); } diff --git a/src/rapi.h b/src/rapi.h index 5ade40b..408fa47 100644 --- a/src/rapi.h +++ b/src/rapi.h @@ -36,6 +36,8 @@ EXPORT SEXP C_process_kill(SEXP _handle); EXPORT SEXP C_process_send_signal(SEXP _handle, SEXP _signal); +EXPORT SEXP C_process_exists(SEXP _pid); + EXPORT SEXP C_known_signals(); EXPORT SEXP C_signal (SEXP _signal, SEXP _handler); diff --git a/src/registration.cpp b/src/registration.cpp index 6d7bef8..9021d03 100644 --- a/src/registration.cpp +++ b/src/registration.cpp @@ -20,6 +20,7 @@ static const R_CallMethodDef callMethods[] = { { "C_process_terminate", (DL_FUNC) &C_process_terminate, 1 }, { "C_process_kill", (DL_FUNC) &C_process_kill, 1 }, { "C_process_send_signal", (DL_FUNC) &C_process_send_signal, 2 }, + { "C_process_exists", (DL_FUNC) &C_process_exists, 1 }, { "C_known_signals", (DL_FUNC) &C_known_signals, 0 }, { "C_signal", (DL_FUNC) &C_signal, 2 }, { NULL, NULL, 0 } diff --git a/src/sub-linux.cc b/src/sub-linux.cc index d2a2506..40c04f5 100644 --- a/src/sub-linux.cc +++ b/src/sub-linux.cc @@ -530,6 +530,13 @@ void process_handle_t::kill() termination_signal(*this, SIGKILL, TIMEOUT_INFINITE); } +/* --- process_exists ----------------------------------------------- */ + +bool process_exists (const pid_type & _pid) +{ + return ::kill(_pid, 0) == 0; +} + } /* namespace subprocess */ diff --git a/src/sub-windows.cc b/src/sub-windows.cc index 1b555ac..b097a96 100644 --- a/src/sub-windows.cc +++ b/src/sub-windows.cc @@ -38,7 +38,7 @@ string strerror (int _code, const string & _message) buffer.data(), (DWORD)buffer.size() - 1, NULL); std::stringstream message; - message << _message << ": " + message << _message << ": " << ((ret > 0) ? buffer.data() : "system error message could not be fetched"); return message.str().substr(0, message.str().find_last_not_of("\r\n\t")); @@ -147,7 +147,7 @@ struct StartupInfo { pipe_holder in(sa), out(sa), err(sa); - // Ensure the write handle to the pipe for STDIN is not inherited. + // Ensure the write handle to the pipe for STDIN is not inherited. if (!::SetHandleInformation(in.write, HANDLE_FLAG_INHERIT, 0)) { throw subprocess_exception(GetLastError(), "could not set handle information"); } @@ -186,7 +186,7 @@ struct StartupInfo { * still don't understand how to do it propertly, and there seems * to be a great deal of confusion among people online how to do * it correctly). - * + * * _creation_flags |= CREATE_NEW_CONSOLE; */ } @@ -219,14 +219,14 @@ struct StartupInfo { FILE_ATTRIBUTE_NORMAL, // normal file NULL); // no attr. template - if (output == INVALID_HANDLE_VALUE) { + if (output == INVALID_HANDLE_VALUE) { return -1; } DuplicateHandle(output, &_process->pipe_stdout); DuplicateHandle(output, &_process->pipe_stderr); DuplicateHandle(output, error.address()); - + _si->cb = sizeof(STARTUPINFO); _si->hStdError = error; _si->hStdOutput = output; @@ -240,7 +240,7 @@ struct StartupInfo { * The actual startup info object. */ STARTUPINFO info; - + }; @@ -251,7 +251,7 @@ static HANDLE CreateAndAssignChildToJob (HANDLE _process) if (!job_handle) { throw subprocess_exception(::GetLastError(), "group termination: could not create a new job"); } - + JOBOBJECT_EXTENDED_LIMIT_INFORMATION info; ::memset(&info, 0, sizeof(JOBOBJECT_EXTENDED_LIMIT_INFORMATION)); @@ -333,7 +333,7 @@ void process_handle_t::spawn (const char * _command, char *const _arguments[], /* if termination mode is "group" add process to the job; see here * for more details: * https://msdn.microsoft.com/en-us/library/windows/desktop/ms684161(v=vs.85).aspx - * + * * "After a process is associated with a job, by default any child * processes it creates using CreateProcess are also associated * with the job." @@ -403,14 +403,14 @@ size_t process_handle_t::read (pipe_type _pipe, int _timeout) { stdout_.clear(); stderr_.clear(); - + ULONGLONG start = GetTickCount64(); int timediff, sleep_time = 100; /* by default sleep 0.1 seconds */ - + if (_timeout >= 0) { sleep_time = _timeout / 10; } - + do { size_t rc1 = 0, rc2 = 0; if (_pipe & PIPE_STDOUT) rc1 = stdout_.read(pipe_stdout); @@ -420,11 +420,11 @@ size_t process_handle_t::read (pipe_type _pipe, int _timeout) if (rc1 > 0 || rc2 > 0 || sleep_time == 0) { return std::max(rc1, rc2); } - + // sleep_time is now guaranteed to be positive Sleep(sleep_time); timediff = (int)(GetTickCount64() - start); - + } while (_timeout < 0 || timediff < _timeout); // out of time @@ -458,18 +458,18 @@ void process_handle_t::wait (int _timeout) _timeout = INFINITE; DWORD rc = ::WaitForSingleObject(child_handle, _timeout); - + // if already exited if (rc == WAIT_OBJECT_0) { DWORD status; if (::GetExitCodeProcess(child_handle, &status) == FALSE) { throw subprocess_exception(::GetLastError(), "could not read child exit code"); } - + if (status == STILL_ACTIVE) { return; } - + return_code = (int)status; state = EXITED; } @@ -566,6 +566,21 @@ void process_handle_t::send_signal (int _signal) } +bool process_exists (const pid_type & _pid) { + /* + * https://stackoverflow.com/questions/12900036/benefit-of-using-waitforsingleobject-when-checking-process-id + * + * When a process completes, it stops running but it doesn't go out of + * existence until the last handle to it is closed. The first solution + * distinguishes between those two states (still running or done running). + */ + HANDLE h = OpenProcess(SYNCHRONIZE, FALSE, _pid); + DWORD ret = WaitForSingleObject(h, 0); + CloseHandle(h); + return (ret == WAIT_TIMEOUT); +} + + /** * You have to Free() the buffer returned from this function * yourself - or let R do it, since we allocate it with Calloc(). @@ -634,15 +649,15 @@ int WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int n const char * command = "x"; char * args[] = { "x", NULL }; char * env[] = { NULL }; - + process_handle_t handle; if (spawn_process(&handle, command, args, env) < 0) { fprintf(stderr, "error in spawn_process\n"); exit(EXIT_FAILURE); } - + teardown_process(&handle); - + return 0; } #endif /* WINDOWS_TEST */ diff --git a/src/subprocess.h b/src/subprocess.h index 754233d..37ecbad 100644 --- a/src/subprocess.h +++ b/src/subprocess.h @@ -79,26 +79,26 @@ struct subprocess_exception : runtime_error { /** * Buffer for a single output stream. - * + * * This buffer comes with additional logic of handling a number of * bytes left from the previous read that did not constitute a * correct multi-byte character. */ struct pipe_writer { - + static constexpr size_t buffer_size = 1024; - + struct leftover { leftover () : len(0) { } size_t len; char data[4]; - + static_assert(sizeof(pipe_writer::leftover::data) < buffer_size, "buffer too small for multi-byte char support"); }; - + typedef vector container_type; - + container_type contents; leftover left; @@ -118,13 +118,13 @@ struct pipe_writer { #ifdef SUBPROCESS_WINDOWS DWORD dwAvail = 0, nBytesRead; - + // if returns FALSE and error is "broken pipe", pipe is gone if (!::PeekNamedPipe(_pipe, NULL, 0, NULL, &dwAvail, NULL)) { if (::GetLastError() == ERROR_BROKEN_PIPE) return 0; throw subprocess_exception(::GetLastError(), "could not peek into pipe"); } - + if (dwAvail == 0) return 0; @@ -142,25 +142,33 @@ struct pipe_writer { return static_cast(rc); #endif /* SUBPROCESS_WINDOWS */ } - - + + /** * Read from pipe. - * + * * Will accommodate for previous leftover and will keep a single * byte to store 0 at the end of the input data. That guarantees * that R string can be correctly constructed from buffer's data * (R expects a ZERO at the end). - * + * * @param _fd Input pipe handle. * @param _mbcslocale Is this multi-byte character set? If so, verify * string integrity after a successful read. - */ + */ size_t read (pipe_handle_type _fd, bool _mbcslocale = false); }; /* pipe_writer */ +/** + * Check if process with given pid exists. + * + * @param _pid Process id. + */ +bool process_exists (const pid_type & _pid); + + /** * Process handle. @@ -193,12 +201,12 @@ struct process_handle_t { /* how should the process be terminated */ termination_mode_type termination_mode; - + /* stdout & stderr handling */ pipe_writer stdout_, stderr_; process_handle_t (); - + ~process_handle_t () throw () { try { diff --git a/tests/testthat/helper-processes.R b/tests/testthat/helper-processes.R index da6973e..a50a6e6 100644 --- a/tests/testthat/helper-processes.R +++ b/tests/testthat/helper-processes.R @@ -32,23 +32,7 @@ R_child <- function(args = '--slave', ...) # --- OS interface ----------------------------------------------------- -process_exists <- function (handle) -{ - pid <- ifelse(is_process_handle(handle), as.character(handle$c_handle), handle) - - if (is_windows()) { - output <- system2("tasklist", paste0('/FI "PID eq ', pid, '"'), stdout = TRUE, stderr = TRUE) - return(length(grep(pid, output, fixed = TRUE)) > 0) - } - else { - flag <- ifelse(is_mac() || is_solaris(), "-p", "--pid") - rc <- system2("ps", c(flag, pid), stdout = NULL, stderr = NULL) - return(rc == 0) - } -} - - -# wait_until_* +# wait_until_* # # Wait infinitey - on CRAN tests will timeout, locally we can always # tell that something is wrong. This is because some systems are simply @@ -78,6 +62,8 @@ wait_until_exits <- function (handle) terminate_gracefully <- function (handle, message = "q('no')\n") { + if (!process_exists(handle)) return(TRUE) + if (!is.null(message)) { process_write(handle, message) } diff --git a/tests/testthat/signal-trap.sh b/tests/testthat/signal-trap.sh index a26b85c..d3608e2 100644 --- a/tests/testthat/signal-trap.sh +++ b/tests/testthat/signal-trap.sh @@ -18,5 +18,7 @@ trap_with_name SIGHUP SIGINT SIGQUIT SIGILL SIGABRT SIGFPE\ SIGUSR2 SIGCHLD SIGCONT SIGSTOP SIGTSTP SIGTTIN\ SIGTTOU +echo "ready" + # wait until ready to exit read diff --git a/tests/testthat/test-signals.R b/tests/testthat/test-signals.R index abcda48..2f69216 100644 --- a/tests/testthat/test-signals.R +++ b/tests/testthat/test-signals.R @@ -9,12 +9,18 @@ test_that("sending signal in Linux/MacOS/Solaris", { bash_path <- "/bin/bash" expect_true(file.exists(bash_path)) - + + on.exit(terminate_gracefully(handle), add = TRUE) handle <- spawn_process(bash_path, c("-e", script_path)) expect_true(process_exists(handle)) - + + # this is necessary to give bash time to set up the signal trap; + # otherwise it is a race + output <- process_read(handle, PIPE_STDOUT, TIMEOUT_INFINITE) + expect_equal(output, "ready") + # exclude signals to kill or stop the child - skip <- c(SIGHUP, SIGKILL, SIGCHLD, SIGSTOP, if (is_solaris()) SIGQUIT) + skip <- c(SIGHUP, SIGKILL, SIGCHLD, SIGSTOP, if (is_solaris()) SIGQUIT) for (signal in setdiff(signals, skip)) { process_send_signal(handle, signal) @@ -29,20 +35,27 @@ test_that("sending signal in Windows", { skip_if_not(is_windows()) spawn <- function () { - spawn_process(R_binary(), c("--slave", "-e", "tryCatch(Sys.sleep(60))")) + spawn_process(Sys.which("cmd"), c("/C", '"sleep 60"')) } + + # according to: + # https://msdn.microsoft.com/en-us/library/cc704588.aspx + # + # 0xC0000001 = STATUS_UNSUCCESSFUL + # 0xC000013A = STATUS_CONTROL_C_EXIT + # + # However, exit code doesn't seem to be consistent between deployments + # (AppVeyor vs. CRAN's win-builder vs. a local Windows system) and + # return codes vary: 0, 1, -1073741510L. For that reason we do not + # check the exit code in the test below. + # Ctrl+C handle <- spawn() expect_true(wait_until_appears(handle)) - + process_send_signal(handle, CTRL_C_EVENT) - - # according to: - # https://msdn.microsoft.com/en-us/library/cc704588.aspx - # - # 0xC0000001 = STATUS_UNSUCCESSFUL - expect_equal(process_wait(handle, TIMEOUT_INFINITE), 1) + expect_silent(process_wait(handle, TIMEOUT_INFINITE)) expect_false(process_exists(handle)) # CTRL+Break @@ -50,8 +63,7 @@ test_that("sending signal in Windows", { expect_true(wait_until_appears(handle)) process_send_signal(handle, CTRL_BREAK_EVENT) - - expect_equal(process_wait(handle, TIMEOUT_INFINITE), 1) + expect_silent(process_wait(handle, TIMEOUT_INFINITE)) expect_false(process_exists(handle)) }) diff --git a/tests/testthat/test-subprocess.R b/tests/testthat/test-subprocess.R index 8118187..e4ca647 100644 --- a/tests/testthat/test-subprocess.R +++ b/tests/testthat/test-subprocess.R @@ -15,9 +15,9 @@ test_that("a subprocess can be spawned and killed", { ptr <- attr(handle$c_handle, 'handle_ptr') expect_equal(class(ptr), 'externalptr') - + expect_true(process_exists(handle)) - + # we need to clean-up 'manually' process_write(handle, "cat(tempdir())\n") path <- process_read(handle, PIPE_STDOUT, TIMEOUT_INFINITE) @@ -37,13 +37,13 @@ test_that("waiting for a child to exit", { process_wait(handle, TIMEOUT_IMMEDIATE) expect_equal(process_state(handle), "running") - + # we need to clean-up 'manually' process_write(handle, "cat(tempdir())\n") path <- process_read(handle, PIPE_STDOUT, TIMEOUT_INFINITE) expect_true(dir.exists(path)) on.exit(unlink(path, TRUE, TRUE), add = TRUE) - + process_kill(handle) expect_equal(process_wait(handle, TIMEOUT_INFINITE), killed_exit_code) @@ -60,7 +60,7 @@ test_that("error when no executable", { test_that("can expand paths", { normalizePathMock <- mock('/full/path/to/local/executable') dotCallMock <- mock(1) - + stub(spawn_process, 'normalizePath', normalizePathMock) stub(spawn_process, '.Call', dotCallMock) handle <- spawn_process("~/local/executable") @@ -73,7 +73,7 @@ test_that("can expand paths", { test_that("handle can be printed", { on.exit(terminate_gracefully(handle)) handle <- R_child() - + path <- gsub("\\\\", "\\\\\\\\", normalizePath(R_binary())) expect_output(print(handle), paste0("Process Handle\n",