Add code to test test_that calls.

DESCRIPTION

@@ -24,6 +24,7 @@ Collate:
     'library.r'
     'reporter.r'
     'reporter-minimal.r'
+    'reporter-silent.r'
     'reporter-stop.r'
     'reporter-summary.r'
     'reporter-tap.r'

NAMESPACE

@@ -1,8 +1,10 @@
+S3method(as.character,expectation)
 S3method(compare,character)
 S3method(compare,default)
 S3method(format,expectation)
 S3method(print,expectation)
 export(MinimalReporter)
+export(SilentReporter)
 export(StopReporter)
 export(SummaryReporter)
 export(TapReporter)
@@ -50,6 +52,7 @@ export(throws_error)
 export(watch)
 exportClasses(MinimalReporter)
 exportClasses(Reporter)
+exportClasses(SilentReporter)
 exportClasses(StopReporter)
 exportClasses(SummaryReporter)
 exportClasses(TapReporter)

NEWS

@@ -34,6 +34,11 @@ Version 0.7.1.99
   `expect_that(f(), not(throws_error()))` asserts that `f()` does not
   throw an error.
 
+* Make `dir_state` less race-y. Contributed by Craig Citro. (#80)
+
+* Add a new reporter so that `testthat` can test calls to `test_that`.
+  Contributed by Craig Citro. (#83)
+
 Version 0.7.1
 ------------------------------------------------------------------------------
 

R/expectation.r

@@ -40,6 +40,9 @@ format.expectation <- function(x, ...) {
   }
 }
 
+#' @S3method as.character expectation
+as.character.expectation <- function(x, ...) format(x)
+
 negate <- function(expt) {
   stopifnot(is.expectation(expt))
 

R/reporter-silent.r

@@ -0,0 +1,35 @@
+#' @include reporter.r
+NULL
+
+#' Test reporter: gather all errors silently.
+#'
+#' This reporter quietly runs all tests, simply gathering the results
+#' for later use. This is helpful for programmatically inspecting errors
+#' after a test run.
+#'
+#' @export
+#' @exportClass SilentReporter
+#' @aliases SilentReporter-class
+#' @keywords debugging
+#' @param ... Arguments used to initialise class
+SilentReporter <- setRefClass("SilentReporter", contains = "Reporter",
+  fields = c("failures"),
+  methods = list(
+    initialize = function(...) {
+      failures <<- list()
+      callSuper(...)
+    },
+    start_test = function(desc) {
+      test <<- desc
+    },
+
+    end_test = function() {
+      test <<- NULL
+    },
+
+    add_result = function(result) {
+      if (result$passed) return()
+      failures[[test]] <<- new_failure
+    }
+  )
+)

R/reporter-stop.r

@@ -33,7 +33,7 @@ StopReporter <- setRefClass("StopReporter", contains = "Reporter",
       test <<- NULL
       if (length(failures) == 0) return()
 
-      messages <- vapply(failures, "[[", "", "message")
+      messages <- vapply(failures, as.character, character(1))
       if (length(messages) > 1) {
         messages <- paste0("* ", messages, collapse = "\n")
       }

R/watcher.r

@@ -40,6 +40,18 @@ watch <- function(path, callback, pattern = NULL, hash = TRUE) {
   }
 }
 
+#' Compute a digest of a filename, returning NA if the file doesn't
+#' exist.
+#'
+#' @param filename filename to compute digest on
+#' @return a digest of the file, or NA if it doesn't exist.
+#' @keywords internal
+safe_digest <- function(path) {
+  result <- NA_character_
+  try(result <- digest(path, file = TRUE), silent = TRUE)
+  result
+}
+
 #' Capture the state of a directory.
 #'
 #' @param path path to directory
@@ -50,8 +62,12 @@ watch <- function(path, callback, pattern = NULL, hash = TRUE) {
 dir_state <- function(path, pattern = NULL, hash = TRUE) {
   files <- dir(path, pattern, full.names = TRUE)
 
+  # It's possible for any of the files to be deleted between the dir()
+  # call above and the calls below; `file.info` handles this
+  # gracefully, but digest::digest doesn't -- so we wrap it. Both
+  # cases will return NA for files that have gone missing.
   if (hash) {
-    sapply(files, digest::digest, file = TRUE)
+    vapply(files, safe_digest, character(1))
   } else {
     setNames(file.info(files)$mtime, files)
   }

inst/tests/test-xxx.r

@@ -1,36 +1,60 @@
-if (interactive()) {
+# Test that test_that succeeds or fails as expected.
+test_test_that <- function(desc, expr, failure_expected = TRUE) {
+  reporter <- SilentReporter$new()
+  old_reporter <- set_reporter(reporter)
+  test_that(desc, expr)
+  set_reporter(old_reporter)
+  test_that(desc, {
+    if (failure_expected) {
+      info <- 'Test succeeded when failure expected'
+      expect_equal(length(reporter$failures), 1, info = info)
+    } else {
+      info <- sprintf(
+          'Test failed unexpectedly: %s',
+          as.character(reporter$failures[[desc]]))
+      expect_equal(length(reporter$failures), 0, info = info)
+    }
+  })
+}
 
-  context("Should fail")
+context("Testing test_that")
 
-  test_that("false is not true (should fail)", {
-    expect_that(FALSE, is_true())
-  })
+test_test_that("false is false", {
+  expect_that(FALSE, is_false())
+}, failure_expected = FALSE)
 
-  test_that("true is not false (should fail)", {
-    expect_that(TRUE, is_false())
-  })
+test_test_that("false is not true", {
+  expect_that(FALSE, is_true())
+})
 
-  test_that("fail fails (should fail)", {
-    fail()
-  })
+test_test_that("true is not false", {
+  expect_that(TRUE, is_false())
+})
 
-  test_that("random errors are caught (should err)", {
-    function_that_doesnt_exist()
-  })
+test_test_that("1 equals 1", {
+  expect_that(1, equals(1))
+}, failure_expected = FALSE)
 
-  f <- function() g()
-  g <- function() stop("I made a mistake", call. = FALSE)
+test_test_that("1 does not equal 2", {
+  expect_that(1, equals(2))
+})
 
-  test_that("errors are captured (should err)", {
-    f()
-  })
+test_test_that("fail fails", {
+  fail()
+})
 
-  test_that("errors when looking for warnings propagte (should err)", {
-    f <- function() stop("!")
-    expect_warning(f())
+test_test_that("random errors are caught", {
+  function_that_doesnt_exist()
+})
 
-  })
+f <- function() g()
+g <- function() stop("I made a mistake", call. = FALSE)
 
-  expect_that(1, equals(2))
+test_test_that("errors are captured", {
+  f()
+})
 
-}
+test_test_that("errors when looking for warnings propagte", {
+  f <- function() stop("!")
+  expect_warning(f())
+})

man/SilentReporter.Rd

@@ -0,0 +1,17 @@
+\name{SilentReporter}
+\alias{SilentReporter}
+\alias{SilentReporter-class}
+\title{Test reporter: gather all errors silently.}
+\usage{
+  SilentReporter(...)
+}
+\arguments{
+  \item{...}{Arguments used to initialise class}
+}
+\description{
+  This reporter quietly runs all tests, simply gathering
+  the results for later use. This is helpful for
+  programmatically inspecting errors after a test run.
+}
+\keyword{debugging}
+