test_package now uses the summary report with a stop at the end if er…

…rors

NEWS

@@ -20,6 +20,8 @@ Changes in version 0.3 ---------------------------------------------------------
 
 * test_package makes it easier to run all test in an installed package.
   Code run in this manner has access to non-exported functions and objects.
+  If any errors or failures occur, test_package will throw an error, making
+  it suitable for use with R CMD check.
 
 Changes in version 0.2 -----------------------------------------------------------------
 

R/colour-text.r

@@ -19,7 +19,7 @@ colourise <- function(text, fg = "black", bg = NULL) {
   term <- Sys.getenv()["TERM"]
   colour_terms <- c("xterm-color","xterm-256color", "screen", "screen-256color")
 
-  if (!any(term %in% colour_terms, na.rm = TRUE)) {
+  if (!interactive() || !any(term %in% colour_terms, na.rm = TRUE)) {
     return(text)
   }
 

R/expectations.r

@@ -149,7 +149,7 @@ expect_equal <- function(actual, expected) {
 #' @export  is_equivalent_to expect_equivalent
 #' @examples
 #' a <- b <- 1:3
-#' labels(b) <- letters[1:3]
+#' names(b) <- letters[1:3]
 #' expect_that(a, is_equivalent_to(b, label = b))
 #' expect_equivalent(a, b)
 is_equivalent_to <- function(expected, label = NULL) {

R/reporter-minimal.r

@@ -15,6 +15,7 @@ MinimalReporter$do({
     if (result$passed) {
       cat(colourise(".", fg = "light green"))
     } else {
+      self$failed <- TRUE
       if (result$error) {
         cat(colourise("F", fg = "red"))
       } else {

R/reporter-summary.r

@@ -33,6 +33,7 @@ SummaryReporter$do({
     if (result$passed) {
       cat(colourise(".", fg = "light green"))
     } else {
+      self$failed <- TRUE
       self$n <- self$n + 1
 
       if (self$n > length(labels)) {

R/reporter-zzz.r

@@ -54,5 +54,5 @@ find_reporter <- function(reporter) {
     stop("Can not find test reporter ", reporter, call. = FALSE)
   }
 
-  get(name)
+  get(name)$clone()
 }

R/reporter.r

@@ -10,8 +10,11 @@ NULL
 Reporter$do({
   self$context <- ""
   self$test <- NULL
+  self$failed <- FALSE
 
-  self$start_reporter <- function() {}
+  self$start_reporter <- function() {
+    self$failed <- FALSE
+  }
   self$start_context <- function(desc) {
     self$context <- desc
   }

R/test-files.r

@@ -16,7 +16,7 @@ test_dir <- function(path, reporter = "summary", env = NULL) {
   }
 
   source_dir(path, "^helper.*\\.[rR]$", env = env)
-  with_reporter(reporter$clone(), {
+  with_reporter(reporter, {
     source_dir(path, "^test.*\\.[rR]$", env = env)    
   })
 }
@@ -32,7 +32,7 @@ test_dir <- function(path, reporter = "summary", env = NULL) {
 #' @param chdir change working directory to path?
 #' @keywords internal
 #' @export
-#' @usage source_dir(path, pattern="\\\\.[rR]$", chdir=TRUE)
+#' @usage source_dir(path, pattern="\\\\.[rR]$", env = NULL, chdir=TRUE)
 source_dir <- function(path, pattern = "\\.[rR]$", env = NULL, chdir = TRUE) {
   files <- sort(dir(path, pattern, full.names = TRUE))
   if (is.null(env)) {
@@ -49,6 +49,6 @@ source_dir <- function(path, pattern = "\\.[rR]$", env = NULL, chdir = TRUE) {
 #' @export
 test_file <- function(path, reporter = "summary") {    
   reporter <- find_reporter(reporter)
-  with_reporter(reporter$clone(), 
-    sys.source(path, new.env(parent = globalenv(), chdir = TRUE)))
+  with_reporter(reporter, 
+    sys.source(path, new.env(parent = globalenv()), chdir = TRUE))
 }

R/test-package.r

@@ -4,12 +4,19 @@
 #' so that tests can access non-exported functions and variables.
 #'
 #' @param package package name
+#' @param reporter reporter to use
 #' @export
 #' @examples
-#' test_package("testthat")
-test_package <- function(package) {
+#' \dontrun{test_package("testthat")}
+test_package <- function(package, reporter = "summary") {
   test_path <- system.file("tests", package = package)
+  reporter <- find_reporter(reporter)
 
   env <- new.env(parent = getNamespace(package))
-  test_dir(test_path, StopReporter, env)
+  test_dir(test_path, reporter = reporter, env)
+
+  if (reporter$failed) {
+    stop("Test failures", call. = FALSE)
+  }
+  invisible()
 }

TODO

@@ -3,8 +3,6 @@
   * switch into temporary directory
   * capture output to screen
 
-* Option stop on error param for reporters?  Would then work more naturally with R CMD check
-
 * New expectations:
   * gives_warning
   * shows_message

inst/tests/test-reporter.r

@@ -4,8 +4,8 @@ test_that("can locate reporter from name", {
   expect_that(find_reporter(MinimalReporter),
     is_identical_to(MinimalReporter))
 
-  expect_that(find_reporter("minimal"), is_identical_to(MinimalReporter))
-  expect_that(find_reporter("summary"), is_identical_to(SummaryReporter))
+  expect_that(find_reporter("minimal"), equals(MinimalReporter))
+  expect_that(find_reporter("summary"), equals(SummaryReporter))
 
   expect_that(find_reporter("blah"), 
     throws_error("Can not find test reporter blah"))

man/is_equivalent_to.Rd

@@ -16,6 +16,6 @@ override default (deparsed expected expression) when doing tests in a
 loop.}
 }
 \examples{a <- b <- 1:3
-labels(b) <- letters[1:3]
+names(b) <- letters[1:3]
 expect_that(a, is_equivalent_to(b, label = b))
 expect_equivalent(a, b)}

man/source_dir.Rd

@@ -1,7 +1,7 @@
 \name{source_dir}
 \alias{source_dir}
 \title{Load all source files in a directory.}
-\usage{source_dir(path, pattern="\\\\.[rR]$", chdir=TRUE)}
+\usage{source_dir(path, pattern="\\\\.[rR]$", env = NULL, chdir=TRUE)}
 
 \description{
   Load all source files in a directory.

man/test_package.Rd

@@ -1,7 +1,7 @@
 \name{test_package}
 \alias{test_package}
 \title{Run all tests in an installed package...}
-\usage{test_package(package)}
+\usage{test_package(package, reporter="summary")}
 
 \description{
   Run all tests in an installed package
@@ -14,5 +14,6 @@
 }
 \arguments{
   \item{package}{package name}
+  \item{reporter}{reporter to use}
 }
-\examples{test_package("testthat")}
+\examples{\dontrun{test_package("testthat")}}