Improve self-testing capabilities

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `expect_no_failures()` and `expect_no_successes()` are now deprecated as `expect_success()` now test for no failures and `expect_failure()` tests for no successes (#)
 * New `pass()` function to use in place of `succeed()` (#2113).
 * `expectation()` is now a combination of `new_expectation()` and `exp_signal()` (#2125).
 * `is_null()`/`matches()` deprecated in 2.0.0 (2017-12-19) and `is_true()`/`is_false()` deprecated in 2.1.0 (2019-04-23) have been removed (#2109).

R/expect-self-test.R

@@ -1,30 +1,43 @@
-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,42 +47,50 @@ 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)) {
+  if (status$n_success == 0) {
     fail("Expectation did not succeed")
-  } else {
-    succeed()
+  } else if (status$n_success > 1) {
+    fail(sprintf(
+      "Expectation succeeded %i times, instead of once",
+      status$n_success
+    ))
   }
-  invisible(NULL)
-}
-
-#' @export
-#' @rdname expect_success
-expect_no_success <- function(expr) {
-  exp <- capture_success(expr)
 
-  if (!is.null(exp)) {
-    fail("Expectation succeeded")
-  } else {
-    succeed()
+  if (status$n_failure > 0) {
+    fail(sprintf(
+      "Expectation failed %i times, instead of zero",
+      status$n_failure
+    ))
   }
-  invisible(NULL)
+
+  pass(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 == 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")
   }
-  invisible(NULL)
+
+  if (status$n_success != 0) {
+    fail(sprintf(
+      "Expectation succeeded %i times, instead of never",
+      status$n_success
+    ))
+  }
+
+  if (!is.null(message)) {
+    return(expect_match(status$last_failure$message, message, ...))
+  }
+  pass(NULL)
 }
 
 #' @export
@@ -78,12 +99,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

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

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

@@ -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.
+

tests/testthat/test-expect-condition.R

@@ -78,8 +78,17 @@ test_that("can capture Throwable conditions from rJava", {
 
 test_that("capture correct trace_env (#1994)", {
   # This should fail, not error
-  expect_failure(expect_error(stop("oops")) |> expect_warning())
-  expect_failure(expect_warning(expect_error(stop("oops"))))
+  status <- capture_success_failure({
+    stop("oops") |> expect_error() |> expect_warning()
+  })
+  expect_equal(status$n_success, 1) # from expect_error()
+  expect_equal(status$n_failure, 1) # from expect_warning()
+
+  status <- capture_success_failure({
+    stop("oops") %>% expect_error() %>% expect_warning()
+  })
+  expect_equal(status$n_success, 1) # from expect_error()
+  expect_equal(status$n_failure, 1) # from expect_warning()
 })
 
 # expect_warning() ----------------------------------------------------------

tests/testthat/test-expect-known.R

@@ -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))
 })
@@ -76,12 +73,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")
 })
 
@@ -130,12 +124,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/test-expect-no-condition.R

@@ -20,7 +20,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)", {