r-lib · krlmlr · Feb 19, 2016 · Feb 5, 2016 · Feb 5, 2016 · Feb 5, 2016
diff --git a/NAMESPACE b/NAMESPACE
@@ -2,6 +2,11 @@
 
 S3method(as.character,expectation)
 S3method(as.data.frame,testthat_results)
+S3method(as.expectation,default)
+S3method(as.expectation,error)
+S3method(as.expectation,expectation)
+S3method(as.expectation,logical)
+S3method(as.expectation,skip)
 S3method(compare,POSIXt)
 S3method(compare,character)
 S3method(compare,default)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # testthat 0.11.0.9000
 
+* Refactored internal testing logic. Now all expectations are also conditions, and R's condition system is used to signal failures and successes (#360, @krlmlr).
+
+* `test_that()` returns a `logical` that indicates if all tests were successful (#360, @krlmlr).
+
 * `find_reporter()` (and also all high-level testing functions) support a vector of reporters. For more than one reporter, a `MultiReporter` is created (#307, @krlmlr).
 
 * `with_reporter()` is used internally and gains new argument `start_end_reporter = TRUE` (@krlmlr, 355).

diff --git a/R/expect-that.r b/R/expect-that.r
@@ -22,21 +22,13 @@ expect_that <- function(object, condition, info = NULL, label = NULL) {
   stopifnot(length(info) <= 1, length(label) <= 1)
 
   label <- label %||% find_expr("object")
-  results <- condition(object)
-  stopifnot(is.expectation(results))
+  exp <- condition(object)
+  stopifnot(is.expectation(exp))
 
-  results$srcref <- find_test_srcref()
+  exp <- update_expectation(exp, srcref = find_test_srcref(), info = info,
+                            label = label)
 
-  if (!is.null(label)) {
-    results$failure_msg <- paste0(label, " ", results$failure_msg)
-  }
-
-  if (!is.null(info)) {
-    results$failure_msg <- paste0(results$failure_msg, "\n", info)
-  }
-
-  get_reporter()$add_result(results)
-  invisible(results)
+  expect(exp)
 }
 
 # find the srcref of the test call, or NULL
@@ -79,9 +71,8 @@ find_test_srcref <- function() {
 #' test_that("this test fails", fail())
 #' }
 fail <- function(message = "Failure has been forced") {
-  results <- expectation(FALSE, message)
-  get_reporter()$add_result(results)
-  invisible()
+  exp <- expectation(FALSE, message)
+  expect(exp)
 }
 
 
@@ -94,9 +85,8 @@ fail <- function(message = "Failure has been forced") {
 #' test_that("this test fails", fail())
 #' }
 succeed <- function(message = "Success has been forced") {
-  results <- expectation(TRUE, message)
-  get_reporter()$add_result(results)
-  invisible()
+  exp <- expectation(TRUE, message)
+  expect(exp)
 }
 
 #' Negate an expectation

diff --git a/R/expectation.r b/R/expectation.r
@@ -10,19 +10,76 @@
 #' @keywords internal
 #' @export
 expectation <- function(passed, failure_msg, srcref = NULL) {
-  structure(
+  new_expectation(passed = passed, failure_msg = failure_msg,
+                  srcref = srcref)
+}
+
+new_expectation <- function(failure_msg, srcref, ...,
+                            passed = FALSE, error = FALSE, skipped = FALSE) {
+  if (passed) {
+    class = c("expectation", "condition")
+  } else {
+    class = c("expectation", "error", "condition")
+  }
+
+  exp <- structure(
     list(
       passed = passed,
-      error = FALSE,
-      skipped = FALSE,
-      failure_msg = failure_msg,
-      srcref = srcref
+      error = error,
+      skipped = skipped,
+      failure_msg = failure_msg
     ),
-    class = "expectation"
+    class = class
   )
+
+  update_expectation(exp, srcref)
+}
+
+update_expectation <- function(exp, srcref, info = NULL, label = NULL) {
+  exp$srcref <- srcref
+
+  if (!is.null(label)) {
+    exp$failure_msg <- paste0(label, " ", exp$failure_msg)
+  }
+
+  if (!is.null(info)) {
+    exp$failure_msg <- paste0(exp$failure_msg, "\n", info)
+  }
+
+  # TODO: Get rid of failure_msg in favor of message
+  exp$message <- exp$failure_msg
+
+  exp
 }
 
-expectation_error <- function(error, calls) {
+expectation_ok <- function(exp) {
+  isTRUE(exp$passed)
+}
+
+
+as.expectation <- function(x, ...) UseMethod("as.expectation", x)
+
+#' @export
+as.expectation.default <- function(x, ...) {
+  stop("Don't know how to convert '", paste(class(x), collapse = "', '"),
+       "' to expectation.", call. = FALSE)
+}
+
+#' @export
+as.expectation.expectation <- function(x, ...) x
+
+#' @export
+as.expectation.logical <- function(x, message, ...) {
+  expectation(passed = x, failure_msg = message, srcref = find_test_srcref())
+}
+
+#' @export
+as.expectation.error <- function(x, ...) {
+  error <- x$message
+  calls <- x$calls
+  # TODO: Collect srcref in test_code()
+  srcref <- x$srcref
+
   msg <- gsub("Error.*?: ", "", as.character(error))
 
   if (length(calls) > 0) {
@@ -35,29 +92,16 @@ expectation_error <- function(error, calls) {
     msg <- gsub("\n$", "", msg)
   }
 
-  structure(
-    list(
-      passed = FALSE,
-      error = TRUE,
-      skipped = FALSE,
-      failure_msg = msg
-    ),
-    class = "expectation"
-  )
+  new_expectation(msg, srcref, error = TRUE)
 }
 
-expectation_skipped <- function(error) {
+#' @export
+as.expectation.skip <- function(x, ...) {
+  error <- x$message
+  srcref <- x$srcref
   msg <- gsub("Error.*?: ", "", as.character(error))
 
-  structure(
-    list(
-      passed = FALSE,
-      error = FALSE,
-      skipped = TRUE,
-      failure_msg = msg
-    ),
-    class = "expectation"
-  )
+  new_expectation(msg, srcref, skipped = TRUE)
 }
 
 #' @export

diff --git a/R/expectations-silent.R b/R/expectations-silent.R
@@ -29,10 +29,3 @@ expect_silent <- function(expr) {
     paste0(label, " produced ", paste(outputs, collapse = ", "))
   )
 }
-
-expect <- function(passed, message) {
-  exp <- expectation(passed, message, srcref = find_test_srcref())
-  get_reporter()$add_result(exp)
-
-  invisible(exp)
-}
diff --git a/R/test-that.r b/R/test-that.r
@@ -28,7 +28,6 @@
 #' }
 test_that <- function(desc, code) {
   test_code(desc, substitute(code), env = parent.frame())
-  invisible()
 }
 
 
@@ -45,35 +44,61 @@ test_code <- function(description, code, env) {
   get_reporter()$start_test(description)
   on.exit(get_reporter()$end_test())
 
+  ok <- TRUE
   capture_calls <- function(e) {
     # Capture call stack, removing last two calls from end (added by
     # withCallingHandlers), and first frame + 7 calls from start (added by
     # tryCatch etc)
     e$calls <- utils::head(sys.calls()[-seq_len(frame + 7)], -2)
     signalCondition(e)
   }
+  handle_expectation <- function(exp) {
+    get_reporter()$add_result(exp)
+    ok <<- ok && expectation_ok(exp)
+    invokeRestart(findRestart("continue_test", exp))
+  }
+  report_condition <- function(e) {
+    ok <<- FALSE
+    get_reporter()$add_result(as.expectation(e))
+  }
+
   frame <- sys.nframe()
 
-  ok <- TRUE
   tryCatch(
     withCallingHandlers(
       eval(code, new_test_environment),
       error = capture_calls,
+      expectation = handle_expectation,
       message = function(c) invokeRestart("muffleMessage")
     ),
-    error = function(e) {
-      ok <- FALSE
-      report <- expectation_error(e$message, e$calls)
-      get_reporter()$add_result(report)
-    }, skip = function(e) {
-      report <- expectation_skipped(e$message)
-      get_reporter()$add_result(report)
-    }
+    error = report_condition,
+    skip = report_condition
   )
 
   invisible(ok)
 }
 
+
+expect <- function(exp, ...) {
+  exp <- as.expectation(exp, ...)
+
+  withRestarts(
+    raise_condition(exp),
+    continue_test = function(e) NULL
+  )
+
+  invisible(exp)
+}
+
+raise_condition <- function(exp) {
+  if (expectation_ok(exp)) {
+    signalCondition(exp)
+  } else {
+    stop(exp)
+  }
+}
+
+
 #' R package to make testing fun!
 #'
 #' Try the example below. Have a look at the references and learn more

diff --git a/tests/testthat/test-bare.r b/tests/testthat/test-bare.r
@@ -12,3 +12,6 @@ expect_gte(3, 3)
 expect_less_than(2, 3)
 expect_lt(2, 3)
 expect_lte(2, 2)
+
+expect_error(expect_false(FALSE), NA)
+expect_error(expect_false(TRUE))
diff --git a/tests/testthat/test-test-that.r b/tests/testthat/test-test-that.r
@@ -134,3 +134,25 @@ test_that("line numbers are found and given to reporters", {
   "
   expect_equal(.test_and_fetch_lines(code), 3)
 })
+
+test_that("return value from test_that", {
+  with_reporter("", success <- test_that("success", {}))
+  expect_true(success)
+  with_reporter("", success <- test_that("success", succeed()))
+  expect_true(success)
+  with_reporter("", success <- test_that("success", expect(TRUE, "Yes!")))
+  expect_true(success)
+
+  with_reporter("", error <- test_that("error", barf))
+  expect_false(error)
+
+  with_reporter("", failure <- test_that("failure", expect_true(FALSE)))
+  expect_false(failure)
+  with_reporter("", failure <- test_that("failure", fail()))
+  expect_false(failure)
+  with_reporter("", success <- test_that("failure", expect(FALSE, "No!")))
+  expect_false(failure)
+
+  with_reporter("", skip <- test_that("skip", skip("skipping")))
+  expect_false(skip)
+})