Improve self-testing capabilities

`expect_success()` and `expect_failure()` are now stricter, testing the full set of assumptions (i.e. exactly one success/failure and zero failures/successes). This means that `expect_no_successes()` and `expect_no_failures()` can be deprecated.

Fixes #2110

Author: hadley

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `expect_no_failures()` and `expect_no_succeses()` are now deprecated as `expect_success()` now test for no failures and `expect_failure()` tests for no successes (#)
 * `local_edition()` now gives a useful error for bad values (#1547).
 * testthat now requires R 4.1.
 * `expect_s4_class()` now supports unquoting (@stibu81, #2064).

R/expect-self-test.R

@@ -1,30 +1,39 @@
-capture_failure <- new_capture("expectation_failure")
-capture_success <- function(expr) {
+capture_success_failure <- function(expr) {
   cnd <- NULL
 
-  withCallingHandlers(
-    expr,
-    expectation_failure = function(cnd) {
-      invokeRestart("continue_test")
-    },
-    expectation_success = function(cnd) {
-      cnd <<- cnd
-    }
+  n_success <- 0
+  n_failure <- 0
+
+  last_failure <- NULL
+
+  withRestarts(
+    withCallingHandlers(
+      expr,
+      expectation_failure = function(cnd) {
+        last_failure <<- cnd
+        n_failure <<- n_failure + 1
+        # Finish the test without bubbling up
+        invokeRestart("failed")
+      },
+      expectation_success = function(cnd) {
+        n_success <<- n_success + 1
+        # Don't bubble up to any other handlers
+        invokeRestart("continue_test")
+      }
+    ),
+    failed = function() {}
   )
-  cnd
-}
 
-new_capture("expectation_success")
+  list(n_success = n_success, n_failure = n_failure, last_failure = last_failure)
+}
 
 #' Tools for testing expectations
 #'
 #' @description
-#' * `expect_success()` and `expect_failure()` check that there's at least
-#'   one success or failure respectively.
-#' * `expect_snapshot_failure()` records the failure message so that you can
-#'   manually check that it is informative.
-#' * `expect_no_success()` and `expect_no_failure()` check that are no
-#'   successes or failures.
+#' `expect_success()` checks that there's exactly one success and no failures;
+#' `expect_failure()` checks that there's exactly one failure and no successes.
+#' `expect_snapshot_failure()` records the failure message so that you can
+#' manually check that it is informative.
 #'
 #' Use `show_failure()` in examples to print the failure message without
 #' throwing an error.
@@ -34,41 +43,40 @@ new_capture("expectation_success")
 #' @param ... Other arguments passed on to [expect_match()].
 #' @export
 expect_success <- function(expr) {
-  exp <- capture_success(expr)
+  status <- capture_success_failure(expr)
 
-  if (is.null(exp)) {
-    fail("Expectation did not succeed")
-  } else {
+  if (status$n_success == 1 && status$n_failure == 0) {
     succeed()
+  } else if (status$n_success == 0) {
+    fail("Expectation did not succeed")
+  } else if (status$n_success > 1) {
+    fail(sprintf("Expectation succeeded %i times, instead of once", status$n_success))
+  } else if (status$n_failure > 0) {
+    fail(sprintf("Expectation failed %i times, instead of zero", status$n_failure))
   }
-  invisible(NULL)
-}
 
-#' @export
-#' @rdname expect_success
-expect_no_success <- function(expr) {
-  exp <- capture_success(expr)
-
-  if (!is.null(exp)) {
-    fail("Expectation succeeded")
-  } else {
-    succeed()
-  }
   invisible(NULL)
 }
 
 #' @export
 #' @rdname expect_success
 expect_failure <- function(expr, message = NULL, ...) {
-  exp <- capture_failure(expr)
+  status <- capture_success_failure(expr)
 
-  if (is.null(exp)) {
+  if (status$n_failure == 1 && status$n_success == 0) {
+    if (!is.null(message)) {
+      return(expect_match(status$last_failure$message, message, ...))
+    }
+  } else if (status$n_failure == 0) {
     fail("Expectation did not fail")
-  } else if (!is.null(message)) {
-    expect_match(exp$message, message, ...)
-  } else {
-    succeed()
+  } else if (status$n_failure > 1) {
+    # This should be impossible, but including for completeness
+    fail("Expectation failed more than once")
+  } else if (status$n_success != 0) {
+    fail(sprintf("Expectation succeeded %i times, instead of never", status$n_success))
   }
+
+  succeed()
   invisible(NULL)
 }
 
@@ -78,12 +86,36 @@ expect_snapshot_failure <- function(expr) {
   expect_snapshot_error(expr, "expectation_failure")
 }
 
+#' Test for absence of success or failure
+#' 
+#' @description
+#' `r lifecycle::badge("deprecated")`
+#' 
+#' These functions are deprecated because [expect_success()] and 
+#' [expect_failure()] now test for exactly one success or no failures, and
+#' exactly one failure and no successes.
+#' 
+#' @keywords internal
 #' @export
-#' @rdname expect_success
+expect_no_success <- function(expr) {
+  lifecycle::deprecate_warn("3.3.0", "expect_no_success()", "expect_failure()")
+  status <- capture_success_failure(expr)
+
+  if (status$n_success > 0) {
+    fail("Expectation succeeded")
+  } else {
+    succeed()
+  }
+  invisible(NULL)
+}
+
+#' @export
+#' @rdname expect_no_success
 expect_no_failure <- function(expr) {
-  exp <- capture_failure(expr)
+  lifecycle::deprecate_warn("3.3.0", "expect_no_failure()", "expect_success()")
+  status <- capture_success_failure(expr)
 
-  if (!is.null(exp)) {
+  if (status$n_failure > 0) {
     fail("Expectation failed")
   } else {
     succeed()

R/try-again.R

@@ -42,5 +42,5 @@ try_again <- function(times, code) {
     times <- times - 1L
   }
 
-  stop(e)
+  exp_signal(e)
 }

man/expect_no_success.Rd

@@ -0,0 +1,23 @@
+# errors in expect_success bubble up
+
+    Code
+      expect_success(abort("error"))
+    Condition
+      Error:
+      ! error
+
+# expect_no are deprecated
+
+    Code
+      expect_no_failure(succeed())
+    Condition
+      Warning:
+      `expect_no_failure()` was deprecated in testthat 3.3.0.
+      i Please use `expect_success()` instead.
+    Code
+      expect_no_success(fail())
+    Condition
+      Warning:
+      `expect_no_success()` was deprecated in testthat 3.3.0.
+      i Please use `expect_failure()` instead.
+

man/expect_success.Rd

@@ -12,12 +12,9 @@ test_that("uses specified width", {
 
 test_that("creates file on first run", {
   file <- withr::local_tempfile()
-  expect_success(
-    expect_warning(
-      expect_known_output(cat("ok!\n"), file),
-      "Creating reference"
-    )
-  )
+  expect_known_output(cat("ok!\n"), file) |> 
+    expect_success() |> 
+    expect_warning("Creating reference")
 
   expect_true(file.exists(file))
 })
@@ -77,12 +74,9 @@ test_that("correctly matches to a file", {
 })
 
 test_that("first run is successful", {
-  expect_success(
-    expect_warning(
-      expect_known_value(2, "two.rds"),
-      "Creating reference"
-    )
-  )
+  expect_known_value(2, "two.rds") |> 
+    expect_success() |> 
+    expect_warning("Creating reference")
   unlink("two.rds")
 })
 
@@ -131,12 +125,9 @@ test_that("version 3 is possible", {
 # expect_known_hash -------------------------------------------------------
 
 test_that("empty hash succeeds with warning", {
-  expect_success(
-    expect_warning(
-      expect_known_hash(1:10),
-      "No recorded hash"
-    )
-  )
+  expect_known_hash(1:10) |> 
+    expect_success() |> 
+    expect_warning("No recorded hash")
 })
 
 test_that("only succeeds if hash is correct", {

tests/testthat/_snaps/expect-self-test.md

@@ -22,7 +22,7 @@ test_that("expect_no_* pass with pure code", {
 })
 
 test_that("expect_no_* don't emit success when they fail", {
-  expect_no_success(expect_no_error(stop("!")))
+  expect_failure(expect_no_error(stop("!")))
 })
 
 test_that("capture correct trace_env (#1994)", {