Specify working directory

Closes #63

R/initialize.R

@@ -8,6 +8,7 @@
 #' @param stdout Standard output, FALSE to ignore, TRUE for temp file.
 #' @param stderr Standard error, FALSE to ignore, TRUE for temp file.
 #' @param cleanup Kill on GC?
+#' @param wd working directory (or NULL)
 #' @param echo_cmd Echo command before starting it?
 #' @param supervise Should the process be supervised?
 #' @param encoding Assumed stdout and stderr encoding.
@@ -17,7 +18,7 @@
 #' @importFrom utils head tail
 
 process_initialize <- function(self, private, command, args,
-                               stdout, stderr, cleanup,
+                               stdout, stderr, cleanup, wd,
                                echo_cmd, supervise, windows_verbatim_args,
                                windows_hide_window, encoding, post_process) {
 
@@ -28,6 +29,7 @@ process_initialize <- function(self, private, command, args,
   assert_that(is_string_or_null(stdout))
   assert_that(is_string_or_null(stderr))
   assert_that(is_flag(cleanup))
+  assert_that(is_string_or_null(wd))
   assert_that(is_flag(echo_cmd))
   assert_that(is_flag(windows_verbatim_args))
   assert_that(is_flag(windows_hide_window))
@@ -37,6 +39,7 @@ process_initialize <- function(self, private, command, args,
   private$command <- command
   private$args <- args
   private$cleanup <- cleanup
+  private$wd <- wd
   private$pstdout <- stdout
   private$pstderr <- stderr
   private$echo_cmd <- echo_cmd
@@ -52,7 +55,7 @@ process_initialize <- function(self, private, command, args,
     c_processx_exec,
     command, c(command, args), stdout, stderr,
     windows_verbatim_args, windows_hide_window,
-    private, cleanup, encoding
+    private, cleanup, wd, encoding
   )
   private$starttime <- Sys.time()
 

R/process.R

@@ -14,7 +14,7 @@ NULL
 #' ```
 #' p <- process$new(command = NULL, args,
 #'                  stdout = NULL, stderr = NULL, cleanup = TRUE,
-#'                  echo_cmd = FALSE, supervise = FALSE,
+#'                  wd = NULL, echo_cmd = FALSE, supervise = FALSE,
 #'                  windows_verbatim_args = FALSE,
 #'                  windows_hide_window = FALSE,
 #'                  encoding = "", post_process = NULL)
@@ -65,6 +65,8 @@ NULL
 #'     `"|"`: create a connection for it.
 #' * `cleanup`: Whether to kill the process (and its children)
 #'     if the `process` object is garbage collected.
+#' * `wd`: working directory of the process. It must exist. If `NULL`, then
+#'     the current working directory is used.
 #' * `echo_cmd`: Whether to print the command to the screen before
 #'     running it.
 #' * `supervise`: Whether to register the process with a supervisor.
@@ -268,11 +270,11 @@ process <- R6Class(
   public = list(
 
     initialize = function(command = NULL, args = character(),
-      stdout = NULL, stderr = NULL, cleanup = TRUE,
+      stdout = NULL, stderr = NULL, cleanup = TRUE, wd = NULL,
       echo_cmd = FALSE, supervise = FALSE, windows_verbatim_args = FALSE,
       windows_hide_window = FALSE, encoding = "",  post_process = NULL)
       process_initialize(self, private, command, args,
-                         stdout, stderr, cleanup, echo_cmd, supervise,
+                         stdout, stderr, cleanup, wd, echo_cmd, supervise,
                          windows_verbatim_args, windows_hide_window,
                          encoding, post_process),
 
@@ -376,6 +378,7 @@ process <- R6Class(
     pstdout = NULL,       # the original stdout argument
     pstderr = NULL,       # the original stderr argument
     cleanfiles = NULL,    # which temp stdout/stderr file(s) to clean up
+    wd = NULL,            # working directory (or NULL for current)
     starttime = NULL,     # timestamp of start
     echo_cmd = NULL,      # whether to echo the command
     windows_verbatim_args = NULL,
@@ -436,6 +439,7 @@ process_restart <- function(self, private) {
     private$pstdout,
     private$pstderr,
     private$cleanup,
+    private$wd,
     private$echo_cmd,
     private$supervised,
     private$windows_verbatim_args,

R/run.R

@@ -30,6 +30,8 @@
 #'   `system_command_status_error` and `system_command_timeout_error`,
 #'   respectively, and both errors have class `system_command_error` as
 #'   well.
+#' @param wd Working directory of the process. If `NULL`, the current
+#'   working directory is used.
 #' @param echo_cmd Whether to print the command to run to the screen.
 #' @param echo Whether to print the standard output and error
 #'   to the screen. Note that the order of the standard output and error
@@ -90,8 +92,8 @@
 #' }
 
 run <- function(
-  command = NULL, args = character(),
-  error_on_status = TRUE, echo_cmd = FALSE, echo = FALSE, spinner = FALSE,
+  command = NULL, args = character(), error_on_status = TRUE, wd = NULL,
+  echo_cmd = FALSE, echo = FALSE, spinner = FALSE,
   timeout = Inf, stdout_line_callback = NULL, stdout_callback = NULL,
   stderr_line_callback = NULL, stderr_callback = NULL,
   windows_verbatim_args = FALSE, windows_hide_window = FALSE,
@@ -113,7 +115,7 @@ run <- function(
 
   ## Run the process
   pr <- process$new(
-    command, args, echo_cmd = echo_cmd,
+    command, args, echo_cmd = echo_cmd, wd = wd,
     windows_verbatim_args = windows_verbatim_args,
     windows_hide_window = windows_hide_window,
     stdout = "|", stderr = "|", encoding = encoding

src/init.c

@@ -10,7 +10,7 @@ SEXP processx__killem_all();
 SEXP run_testthat_tests();
 
 static const R_CallMethodDef callMethods[]  = {
-  { "processx_exec",               (DL_FUNC) &processx_exec,               9 },
+  { "processx_exec",               (DL_FUNC) &processx_exec,              10 },
   { "processx_wait",               (DL_FUNC) &processx_wait,               2 },
   { "processx_is_alive",           (DL_FUNC) &processx_is_alive,           1 },
   { "processx_get_exit_status",    (DL_FUNC) &processx_get_exit_status,    1 },

src/processx.h

@@ -34,7 +34,7 @@ extern "C" {
 SEXP processx_exec(SEXP command, SEXP args, SEXP std_out, SEXP std_err,
 		   SEXP windows_verbatim_args,
 		   SEXP windows_hide_window, SEXP private_, SEXP cleanup,
-		   SEXP encoding);
+		   SEXP wd, SEXP encoding);
 SEXP processx_wait(SEXP status, SEXP timeout);
 SEXP processx_is_alive(SEXP status);
 SEXP processx_get_exit_status(SEXP status);
@@ -78,6 +78,7 @@ SEXP processx_write_named_pipe(SEXP pipe_ext, SEXP text);
 typedef struct {
   int windows_verbatim_args;
   int windows_hide;
+  const char *wd;
 } processx_options_t;
 
 #ifdef __cplusplus

src/unix/processx.c

@@ -121,6 +121,11 @@ static void processx__child_init(processx_handle_t* handle, int pipes[3][2],
     if (-1 == close(i) && i > 200) break;
   }
 
+  if (options->wd != NULL && chdir(options->wd)) {
+    processx__write_int(error_fd, - errno);
+    raise(SIGKILL);
+  }
+
   execvp(command, args);
   processx__write_int(error_fd, - errno);
   raise(SIGKILL);
@@ -248,7 +253,7 @@ void processx__make_socketpair(int pipe[2]) {
 SEXP processx_exec(SEXP command, SEXP args, SEXP std_out, SEXP std_err,
 		   SEXP windows_verbatim_args,
 		   SEXP windows_hide_window, SEXP private, SEXP cleanup,
-		   SEXP encoding) {
+		   SEXP wd, SEXP encoding) {
 
   char *ccommand = processx__tmp_string(command, 0);
   char **cargs = processx__tmp_character(args);
@@ -267,6 +272,8 @@ SEXP processx_exec(SEXP command, SEXP args, SEXP std_out, SEXP std_err,
   processx_handle_t *handle = NULL;
   SEXP result;
 
+  options.wd = isNull(wd) ? 0 : CHAR(STRING_ELT(wd, 0));
+
   if (pipe(signal_pipe)) { goto cleanup; }
   processx__cloexec_fcntl(signal_pipe[0], 1);
   processx__cloexec_fcntl(signal_pipe[1], 1);

src/win/processx.c

@@ -622,11 +622,12 @@ void processx__handle_destroy(processx_handle_t *handle) {
 
 SEXP processx_exec(SEXP command, SEXP args, SEXP std_out, SEXP std_err,
 		   SEXP windows_verbatim_args, SEXP windows_hide,
-		   SEXP private, SEXP cleanup, SEXP encoding) {
+		   SEXP private, SEXP cleanup, SEXP wd, SEXP encoding) {
 
   const char *cstd_out = isNull(std_out) ? 0 : CHAR(STRING_ELT(std_out, 0));
   const char *cstd_err = isNull(std_err) ? 0 : CHAR(STRING_ELT(std_err, 0));
   const char *cencoding = CHAR(STRING_ELT(encoding, 0));
+  const char *ccwd = isNull(wd) ? 0 : CHAR(STRING_ELT(wd, 0));
 
   int err = 0;
   WCHAR *path;
@@ -655,8 +656,15 @@ SEXP processx_exec(SEXP command, SEXP args, SEXP std_out, SEXP std_err,
       &arguments);
   if (err) { PROCESSX_ERROR("making program args", err); }
 
-  /* Inherit cwd */
-  {
+  if (ccwd) {
+    /* Explicit cwd */
+    err = processx__utf8_to_utf16_alloc(ccwd, &cwd);
+    if (err) {
+      PROCESSX_ERROR("convert current directory encoding", GetLastError());
+    }
+
+  } else {
+    /* Inherit cwd */
     DWORD cwd_len, r;
 
     cwd_len = GetCurrentDirectoryW(0, NULL);

tests/testthat/test-process.R

@@ -63,3 +63,19 @@ test_that("post processing", {
   p$get_result()
   expect_equal(xx, 1)
 })
+
+test_that("working directory", {
+  px  <- get_tool("px")
+  dir.create(tmp <- tempfile())
+  on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
+  cat("foo\nbar\n", file = file.path(tmp, "file"))
+
+  p <- process$new(px, c("cat", "file"), wd = tmp, stdout = "|")
+  p$wait()
+  expect_equal(p$read_all_output_lines(), c("foo", "bar"))
+})
+
+test_that("working directory does not exist", {
+  px <- get_tool("px")
+  expect_error(process$new(px, wd = tempfile()))
+})

tests/testthat/test-run.R

@@ -55,3 +55,18 @@ test_that("callbacks work", {
     expect_equal(out, as.character(1:20))
   }
 })
+
+test_that("working directory", {
+  px <- get_tool("px")
+  dir.create(tmp <- tempfile())
+  on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
+  cat("foo\nbar\n", file = file.path(tmp, "file"))
+
+  x <- run(px, c("cat", "file"), wd = tmp)
+  expect_equal(x$stdout, "foo\nbar\n")
+})
+
+test_that("working directory does not exist", {
+  px <- get_tool("px")
+  expect_error(run(px, wd = tempfile()))
+})