tests/testthat/test-run.R

In processx: Execute and Control System Processes

test_that("run can run", {
  px <- get_tool("px")
  expect_error(
    {
      run(px, c("sleep", "0"))
    },
    NA
  )
  gc()
})

test_that("timeout works", {
  px <- get_tool("px")
  tic <- Sys.time()
  x <- run(px, c("sleep", "5"), timeout = 0.00001, error_on_status = FALSE)
  toc <- Sys.time()

  expect_true(toc - tic < as.difftime(3, units = "secs"))
  expect_true(x$timeout)
  gc()
})

test_that("timeout throws right error", {
  px <- get_tool("px")
  e <- tryCatch(
    run(px, c("sleep", "5"), timeout = 0.00001, error_on_status = TRUE),
    error = function(e) e
  )

  expect_true("system_command_timeout_error" %in% class(e))
  gc()
})

test_that("callbacks work", {
  px <- get_tool("px")
  ## This typically freezes on Unix, if there is a malloc/free race
  ## condition in the SIGCHLD handler.
  for (i in 1:30) {
    out <- NULL
    run(
      px,
      rbind("outln", 1:20),
      stdout_line_callback = function(x, ...) out <<- c(out, x)
    )
    expect_equal(out, as.character(1:20))
    gc()
  }

  for (i in 1:30) {
    out <- NULL
    run(
      px,
      rbind("errln", 1:20),
      stderr_line_callback = function(x, ...) out <<- c(out, x),
      error_on_status = FALSE
    )
    expect_equal(out, as.character(1:20))
    gc()
  }
})

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)
  if (is_windows()) {
    expect_equal(x$stdout, "foo\r\nbar\r\n")
  } else {
    expect_equal(x$stdout, "foo\nbar\n")
  }
  gc()
})

test_that("working directory does not exist", {
  skip_if_no_srcrefs()
  px <- get_tool("px")
  expect_snapshot(
    error = TRUE,
    run(px, wd = tempfile()),
    transform = transform_px,
    variant = sysname()
  )
  gc()
})

test_that("stderr_to_stdout", {
  px <- get_tool("px")

  out <- run(
    px,
    c("out", "o1", "err", "e1", "out", "o2", "err", "e2", "outln", ""),
    stderr_to_stdout = TRUE
  )

  expect_equal(out$status, 0L)
  expect_equal(
    out$stdout,
    paste0("o1e1o2e2", if (is_windows()) "\r", "\n")
  )
  expect_equal(out$stderr, NULL)
  expect_false(out$timeout)
})

test_that("condition on interrupt", {
  skip_if_no_ps()
  skip_on_cran()
  if (is_windows() && Sys.getenv("_R_CHECK_PACKAGE_NAME_", "") != "") {
    skip("Fails in Windows R CMD check")
  }

  px <- get_tool("px")
  cnd <- tryCatch(
    interrupt_me(run(px, c("errln", "oops", "errflush", "sleep", 3)), 0.5),
    error = function(c) c,
    interrupt = function(c) c
  )

  expect_s3_class(cnd, "system_command_interrupt")
  expect_equal(str_trim(cnd$stderr), "oops")
})

test_that("stdin", {
  tmp <- tempfile()
  on.exit(unlink(tmp), add = TRUE)

  txt <- "foobar\nthis is the input\n"
  cat(txt, file = tmp)
  px <- get_tool("px")
  res <- run(px, c("cat", "<stdin>"), stdin = tmp)

  expect_equal(
    strsplit(res$stdout, "\r?\n")[[1]],
    c("foobar", "this is the input")
  )
})

test_that("drop stdout", {
  px <- get_tool("px")
  res <- run(px, c("out", "boo", "err", "bah"), stdout = NULL)
  expect_null(res$stdout)
  expect_equal(res$stderr, "bah")
})

test_that("drop stderr", {
  px <- get_tool("px")
  res <- run(px, c("out", "boo", "err", "bah"), stderr = NULL)
  expect_equal(res$stdout, "boo")
  expect_null(res$stderr)
})

test_that("drop std*", {
  px <- get_tool("px")
  res <- run(px, c("out", "boo", "err", "bah"), stdout = NULL, stderr = NULL)
  expect_null(res$stdout)
  expect_null(res$stderr)
})

test_that("redirect stout", {
  tmp1 <- tempfile()
  tmp2 <- tempfile()
  on.exit(unlink(c(tmp1, tmp2)), add = TRUE)

  px <- get_tool("px")
  res <- run(
    px,
    c("outln", "boo", "errln", "bah"),
    stdout = tmp1,
    stderr = tmp2
  )
  expect_null(res$stdout)
  expect_null(res$stderr)
  expect_equal(readLines(tmp1), "boo")
  expect_equal(readLines(tmp2), "bah")
})