From d1ed428b9c1e4fb086b29f6539835f8ecb2d6284 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= <csardi.gabor@gmail.com>
Date: Mon, 16 May 2016 19:37:41 +0100
Subject: [PATCH] Add unit tests

---
 R/eval.R                    |  2 +-
 R/script.R                  |  4 +--
 tests/testthat.R            |  2 ++
 tests/testthat/test-error.R | 51 +++++++++++++++++++++++++++++++++++++
 tests/testthat/test-eval.R  | 36 ++++++++++++++++++++++++++
 tests/testthat/test-utils.R |  9 +++++++
 tests/testthat/test.R       |  8 ------
 7 files changed, 101 insertions(+), 11 deletions(-)
 create mode 100644 tests/testthat/test-error.R
 create mode 100644 tests/testthat/test-eval.R
 create mode 100644 tests/testthat/test-utils.R
 delete mode 100644 tests/testthat/test.R

diff --git a/R/eval.R b/R/eval.R
index f5cf7bff..b9532ecd 100644
--- a/R/eval.R
+++ b/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
   }
 }
 
diff --git a/R/script.R b/R/script.R
index da62e28d..ec83229e 100644
--- a/R/script.R
+++ b/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)
diff --git a/tests/testthat.R b/tests/testthat.R
index 75a67445..d0b48df3 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,4 +1,6 @@
 library(testthat)
 library(callr)
 
+Sys.unsetenv("R_TESTS")
+
 test_check("callr")
diff --git a/tests/testthat/test-error.R b/tests/testthat/test-error.R
new file mode 100644
index 00000000..10ec81b1
--- /dev/null
+++ b/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)
+})
diff --git a/tests/testthat/test-eval.R b/tests/testthat/test-eval.R
new file mode 100644
index 00000000..312e9895
--- /dev/null
+++ b/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)))
+})
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
new file mode 100644
index 00000000..bb3d1d56
--- /dev/null
+++ b/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()
+  )
+})
diff --git a/tests/testthat/test.R b/tests/testthat/test.R
deleted file mode 100644
index d854acb3..00000000
--- a/tests/testthat/test.R
+++ /dev/null
@@ -1,8 +0,0 @@
-
-context("callr")
-
-test_that("callr works", {
-
-  expect_true(TRUE)
-
-})