Merged origin/main into expect-s7-class

Author: hadley

NAMESPACE

@@ -106,8 +106,10 @@ export(expect_more_than)
 export(expect_named)
 export(expect_no_condition)
 export(expect_no_error)
+export(expect_no_failure)
 export(expect_no_match)
 export(expect_no_message)
+export(expect_no_success)
 export(expect_no_warning)
 export(expect_null)
 export(expect_output)
@@ -120,6 +122,7 @@ export(expect_setequal)
 export(expect_silent)
 export(expect_snapshot)
 export(expect_snapshot_error)
+export(expect_snapshot_failure)
 export(expect_snapshot_file)
 export(expect_snapshot_output)
 export(expect_snapshot_value)

NEWS.md

@@ -1,6 +1,9 @@
 # testthat (development version)
 
 * New `expect_s7_class()` for testing if an object is an S7 class (#1580).
+* `expect_error()` and friends now error if you supply `...` but not `pattern` (#1932).
+* New `expect_no_failure()`, `expect_no_success()` and `expect_snapshot_failure()` provide more options for testing expectations.
+* `expect_error()` and friends no longer give an uninformative error if they fail inside a magrittr pipe (#1994).
 * `expect_setequal()` correctly identifies what is missing where (#1962).
 * `expect_true()` and `expect_false()` give better errors if `actual` isn't a vector (#1996).
 * `expect_no_*()` expectations no longer incorrectly emit a passing test result if they in fact fail (#1997).

R/expect-condition.R

@@ -163,8 +163,7 @@ expect_warning <- function(object,
       ...,
       inherit = inherit,
       info = info,
-      label = label,
-      trace_env = caller_env()
+      label = label
     )
   } else {
     act <- quasi_capture(enquo(object), label, capture_warnings, ignore_deprecation = identical(regexp, NA))
@@ -196,8 +195,7 @@ expect_message <- function(object,
       ...,
       inherit = inherit,
       info = info,
-      label = label,
-      trace_env = caller_env()
+      label = label
     )
   } else {
     act <- quasi_capture(enquo(object), label, capture_messages)
@@ -225,8 +223,7 @@ expect_condition <- function(object,
       ...,
       inherit = inherit,
       info = info,
-      label = label,
-      trace_env = caller_env()
+      label = label
     )
   } else {
 
@@ -256,18 +253,14 @@ expect_condition_matching <- function(base_class,
                                       label = NULL,
                                       trace_env = caller_env(),
                                       error_call = caller_env()) {
-  check_dots_used(error = function(cnd) {
-    warn(conditionMessage(cnd), call = error_call)
-  })
-
   matcher <- cnd_matcher(
     base_class,
     class,
     regexp,
     ...,
     inherit = inherit,
     ignore_deprecation = base_class == "warning" && identical(regexp, NA),
-    error_call = trace_env
+    error_call = error_call
   )
 
   act <- quasi_capture(
@@ -301,6 +294,13 @@ cnd_matcher <- function(base_class,
   check_string(class, allow_null = TRUE, call = error_call)
   check_string(pattern, allow_null = TRUE, allow_na = TRUE, call = error_call)
 
+  if (is.null(pattern) && dots_n(...) > 0) {
+    cli::cli_abort(
+      "Can't specify {.arg ...} without {.arg pattern}.",
+      call = error_call
+    )
+  }
+
   function(cnd) {
     if (!inherit) {
       cnd$parent <- NULL
@@ -318,7 +318,17 @@ cnd_matcher <- function(base_class,
         return(FALSE)
       }
       if (!is.null(pattern) && !isNA(pattern)) {
-        grepl(pattern, conditionMessage(x), ...)
+        withCallingHandlers(
+          grepl(pattern, conditionMessage(x), ...),
+          error = function(e) {
+            cli::cli_abort(
+              "Failed to compare {base_class} to {.arg pattern}.",
+              parent = e,
+              call = error_call
+            )
+          }
+        )
+
       } else {
         TRUE
       }

R/expect-no-condition.R

@@ -82,10 +82,10 @@ expect_no_condition <- function(object,
 
 
 expect_no_ <- function(base_class,
-                            object,
-                            regexp = NULL,
-                            class = NULL,
-                            error_call = caller_env()) {
+                       object,
+                       regexp = NULL,
+                       class = NULL,
+                       trace_env = caller_env()) {
 
   matcher <- cnd_matcher(
     base_class,
@@ -116,7 +116,7 @@ expect_no_ <- function(base_class,
           indent_lines(rlang::cnd_message(cnd))
         )
         message <- format_error_bullets(c(expected, i = actual))
-        fail(message, trace_env = error_call)
+        fail(message, trace_env = trace_env)
       }
     )
   }

R/expect-self-test.R

@@ -1,23 +1,56 @@
+capture_failure <- new_capture("expectation_failure")
+capture_success <- function(expr) {
+  cnd <- NULL
+
+  withCallingHandlers(
+    expr,
+    expectation_failure = function(cnd) {
+      invokeRestart("continue_test")
+    },
+    expectation_success = function(cnd) {
+      cnd <<- cnd
+    }
+  )
+  cnd
+}
+
+new_capture("expectation_success")
+
 #' Tools for testing expectations
 #'
-#' Use these expectations to test other expectations.
+#' @description
+#' * `expect_sucess()` 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.
+#'
 #' Use `show_failure()` in examples to print the failure message without
 #' throwing an error.
 #'
-#' @param expr Expression that evaluates a single expectation.
+#' @param expr Code to evalute
 #' @param message Check that the failure message matches this regexp.
 #' @param ... Other arguments passed on to [expect_match()].
 #' @export
 expect_success <- function(expr) {
-  exp <- capture_expectation(expr)
+  exp <- capture_success(expr)
 
   if (is.null(exp)) {
-    fail("no expectation used.")
-  } else if (!expectation_success(exp)) {
-    fail(paste0(
-      "Expectation did not succeed:\n",
-      exp$message
-    ))
+    fail("Expectation did not succeed")
+  } else {
+    succeed()
+  }
+  invisible(NULL)
+}
+
+#' @export
+#' @rdname expect_success
+expect_no_success <- function(expr) {
+  exp <- capture_success(expr)
+
+  if (!is.null(exp)) {
+    fail("Expectation succeeded")
   } else {
     succeed()
   }
@@ -27,19 +60,31 @@ expect_success <- function(expr) {
 #' @export
 #' @rdname expect_success
 expect_failure <- function(expr, message = NULL, ...) {
-  exp <- capture_expectation(expr)
+  exp <- capture_failure(expr)
 
   if (is.null(exp)) {
-    fail("No expectation used")
-    return()
-  }
-  if (!expectation_failure(exp)) {
     fail("Expectation did not fail")
-    return()
+  } else if (!is.null(message)) {
+    expect_match(exp$message, message, ...)
+  } else {
+    succeed()
   }
+  invisible(NULL)
+}
 
-  if (!is.null(message)) {
-    expect_match(exp$message, message, ...)
+#' @export
+#' @rdname expect_success
+expect_snapshot_failure <- function(expr) {
+  expect_snapshot_error(expr, "expectation_failure")
+}
+
+#' @export
+#' @rdname expect_success
+expect_no_failure <- function(expr) {
+  exp <- capture_failure(expr)
+
+  if (!is.null(exp)) {
+    fail("Expectation failed")
   } else {
     succeed()
   }
@@ -67,10 +112,6 @@ show_failure <- function(expr) {
   invisible()
 }
 
-expect_snapshot_failure <- function(x) {
-  expect_snapshot_error(x, "expectation_failure")
-}
-
 expect_snapshot_reporter <- function(reporter, paths = test_path("reporters/tests.R")) {
   local_options(rlang_trace_format_srcrefs = FALSE)
   local_rng_version("3.3")

man/expect_success.Rd

@@ -29,14 +29,18 @@
 
     `f1()` did not throw a condition with class <bar>.
 
-# unused arguments generate a warning
+# unused arguments generate an error
 
     Code
       expect_condition(stop("Hi!"), foo = "bar")
     Condition
-      Warning in `expect_condition()`:
-      Arguments in `...` must be used.
-      x Problematic argument:
-      * foo = "bar"
-      i Did you misspell an argument name?
+      Error in `expect_condition()`:
+      ! Can't specify `...` without `pattern`.
+    Code
+      expect_condition(stop("Hi!"), "x", foo = "bar")
+    Condition
+      Error in `expect_condition()`:
+      ! Failed to compare condition to `pattern`.
+      Caused by error in `grepl()`:
+      ! unused argument (foo = "bar")
 

tests/testthat/_snaps/expect-condition.md

@@ -76,6 +76,12 @@ test_that("can capture Throwable conditions from rJava", {
   expect_error(throw("foo"), "foo", class = "Throwable")
 })
 
+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"))))
+})
+
 # expect_warning() ----------------------------------------------------------
 
 test_that("warnings are converted to errors when options('warn') >= 2", {
@@ -217,8 +223,11 @@ test_that("can match parent conditions (#1493)", {
   expect_error(expect_error(f(), "Parent message.", inherit = FALSE))
 })
 
-test_that("unused arguments generate a warning", {
-  expect_snapshot(expect_condition(stop("Hi!"), foo = "bar"))
+test_that("unused arguments generate an error", {
+  expect_snapshot(error = TRUE, {
+    expect_condition(stop("Hi!"), foo = "bar")
+    expect_condition(stop("Hi!"), "x", foo = "bar")
+  })
 })
 
 

tests/testthat/test-expect-condition.R

@@ -14,20 +14,13 @@ test_that("expect_no_* conditions behave as expected", {
 })
 
 test_that("expect_no_* don't emit success when they fail", {
+  expect_no_success(expect_no_error(stop("!")))
+})
 
-  catch_cnds <- function(code) {
-    cnds <- list()
-
-    withCallingHandlers(code, condition = function(cnd) {
-      cnds[[length(cnds) + 1]] <<- cnd
-      invokeRestart("continue_test")
-    })
-    cnds
-  }
-
-  cnds <- catch_cnds(expect_no_error(stop("!")))
-  expect_length(cnds, 1)
-  expect_s3_class(cnds[[1]], "expectation_failure")
+test_that("capture correct trace_env (#1994)", {
+  # This should fail, not error
+  expect_failure(expect_message({message("a"); warn("b")}) %>% expect_no_warning())
+  expect_failure(expect_no_message({message("a"); warn("b")}) %>% expect_warning())
 })
 
 test_that("unmatched conditions bubble up", {

tests/testthat/test-expect-no-condition.R

@@ -27,3 +27,19 @@ test_that("show_failure", {
   expect_null(show_failure(NULL))
   expect_output(show_failure(expect_true(FALSE)), "FALSE is not TRUE")
 })
+
+test_that("can test for presence and absense of failure", {
+  expect_success(expect_failure(fail()))
+  expect_success(expect_no_failure(succeed()))
+
+  expect_failure(expect_failure(succeed()))
+  expect_failure(expect_no_failure(fail()))
+})
+
+test_that("can test for presence and absense of success", {
+  expect_success(expect_success(succeed()))
+  expect_success(expect_no_success(fail()))
+
+  expect_failure(expect_success(fail()))
+  expect_failure(expect_no_success(succeed()))
+})