Add unit tests

R/eval.R

@@ -185,7 +185,7 @@ get_result <- function(res) {
     debugger(clean_stack(err[[3]]))
 
   } else {
-    stop("Unknown callr error strategy: ", err[[1]])
+    stop("Unknown callr error strategy: ", err[[1]]) # nocov
   }
 }
 

R/script.R

@@ -37,7 +37,7 @@ make_vanilla_script <- function(expr_file, res, error) {
   ## the function is called from an empty global environment.
   script <- substitute(
     {
-      withCallingHandlers(
+      withCallingHandlers(              # nocov start
         {
           saveRDS(
             do.call(
@@ -49,7 +49,7 @@ make_vanilla_script <- function(expr_file, res, error) {
           )
         },
         error = function(e) { `__error__`; stop(e) }
-      )
+      )                                 # nocov end
     },
 
     list(`__error__` = err, `__expr_file__` = expr_file, `__res__` = res)

tests/testthat.R

@@ -1,4 +1,6 @@
 library(testthat)
 library(callr)
 
+Sys.unsetenv("R_TESTS")
+
 test_check("callr")

tests/testthat/test-error.R

@@ -0,0 +1,51 @@
+
+context("errors")
+
+test_that("error is propagated", {
+  expect_error(
+    r_eval(function() 1 + "A"),
+    "non-numeric argument to binary operator"
+  )
+})
+
+test_that("error object is passed", {
+  err <- NULL
+  tryCatch(
+    r_eval(function() 1 + "A"),
+    error = function(e) err <<- e
+  )
+  expect_true("call" %in% names(err))
+  expect_true(inherits(err, "error"))
+})
+
+test_that("error stack is passed", {
+  err <- NULL
+  tryCatch(
+    r_eval(
+      function() {
+        f <- function() g()
+        g <- function() 1 + "A"
+        f()
+      },
+      error = "stack"
+    ),
+    error = function(e) err <<- e
+  )
+
+  expect_true("call" %in% names(err))
+  expect_true(inherits(err, "error"))
+  expect_true(inherits(err, "callrError"))
+  expect_equal(length(err$stack), 3)
+})
+
+test_that("debugger is called", {
+
+  called <- FALSE
+
+  with_mock(
+    `utils::debugger` = function(...) called <<- TRUE,
+    r_eval(function() { 1 + "A" }, error = "debugger")
+  )
+
+  expect_true(called)
+})

tests/testthat/test-eval.R

@@ -0,0 +1,36 @@
+
+context("r_eval")
+
+test_that("basic r_eval", {
+  expect_equal(r_eval(function() 1 + 1), 2)
+  expect_equal(r_eval(function(x) 1 + x, list(5)), 6)
+})
+
+test_that("the same R version is called", {
+  expect_equal(r_eval(function() R.version), R.version)
+})
+
+test_that("standard output", {
+  tmp <- tempfile()
+  on.exit(unlink(tmp), add = TRUE)
+  r_eval(function() cat("hello\n"), stdout = tmp)
+  expect_equal(readLines(tmp), "hello")
+})
+
+test_that("standard error", {
+  tmp <- tempfile()
+  on.exit(unlink(tmp), add = TRUE)
+  r_eval(function() message("hello"), stderr = tmp)
+  expect_equal(readLines(tmp), "hello")
+})
+
+test_that("cmdargs argument", {
+  o1 <- tempfile()
+  o2 <- tempfile()
+  on.exit(unlink(c(o1, o2)), add = TRUE)
+
+  r_eval(ls, stdout = o1)
+  r_eval(ls, stdout = o2, cmdargs = character())
+
+  expect_true(length(readLines(o2)) > length(readLines(o1)))
+})

tests/testthat/test-utils.R

@@ -0,0 +1,9 @@
+
+context("utils")
+
+test_that("set_var with empty list", {
+  expect_equal(
+    with_envvar(c(), Sys.getenv()),
+    Sys.getenv()
+  )
+})