Implement expect_no_warnings() and friends (#1690)

Fixes #1679

Author: hadley

NAMESPACE

@@ -102,7 +102,11 @@ export(expect_match)
 export(expect_message)
 export(expect_more_than)
 export(expect_named)
+export(expect_no_condition)
+export(expect_no_error)
 export(expect_no_match)
+export(expect_no_message)
+export(expect_no_warning)
 export(expect_null)
 export(expect_output)
 export(expect_output_file)

NEWS.md

@@ -1,5 +1,9 @@
 # testthat (development version)
 
+* New experimental `expect_no_error()`, `expect_no_warning()`, 
+  `expect_no_message()`, and `expect_no_condition()` for asserting
+  the code runs without an error, warning, message, or condition (#1679).
+
 * Fixed a warning in R >=4.2.0 on Windows that occurred when using the C++
   testing infrastructure that testthat provides (#1672).
 

R/expect-condition.R

@@ -42,7 +42,14 @@
 #'     error message.
 #'   * If `NULL`, the default, asserts that there should be an error,
 #'     but doesn't test for a specific value.
-#'   * If `NA`, asserts that there should be no errors.
+#'   * If `NA`, asserts that there should be no errors, but we now recommend
+#'     using [expect_no_error()] and friends instead.
+#'
+#'   Note that you should only use `message` with errors/warnings/messages
+#'   that you generate. Avoid tests that rely on the specific text generated by
+#'   another package since this can easily change. If you do need to test text
+#'   generated by another package, either protect the test with `skip_on_cran()`
+#'   or use `expect_snapshot()`.
 #' @inheritDotParams expect_match -object -regexp -info -label -all
 #' @param class Instead of supplying a regular expression, you can also supply
 #'   a class name. This is useful for "classed" conditions.
@@ -51,6 +58,9 @@
 #' @param all *DEPRECATED* If you need to test multiple warnings/messages
 #'   you now need to use multiple calls to `expect_message()`/
 #'   `expect_warning()`
+#' @seealso [expect_no_error()], `expect_no_warning()`,
+#'   `expect_no_message()`, and `expect_no_condition()` to assert
+#'   that code runs without errors/warnings/messages/conditions.
 #' @return If `regexp = NA`, the value of the first argument; otherwise
 #'   the captured condition.
 #' @examples

R/expect-no-condition.R

@@ -0,0 +1,127 @@
+#' Does code run without error, warning, message, or other condition?
+#'
+#' @description
+#' `r lifecycle::badge("experimental")`
+#'
+#' These expectations are the opposite of [expect_error()],
+#' `expect_warning()`, `expect_message()`, and `expect_condition()`. They
+#' assert the absence of an error, warning, or message, respectively.
+#'
+#' @inheritParams expect_error
+#' @param message,class The default, `message = NULL, class = NULL`,
+#'   will fail if there is any error/warning/message/condition.
+#'
+#'   If many cases, particularly when testing warnings and message, you will
+#'   want to be more specific about the condition you are hoping **not** to see,
+#'   i.e. the condition that motivated you to write the test.  Similar to
+#'   `expect_error()` and friends, you can specify the `message` (a regular
+#'   expression that the message of the condition must match) and/or the
+#'   `class` (a class the condition must inherit from). This ensures that
+#'   the message/warnings you don't want never recur, while allowing new
+#'   messages/warnings to bubble up for you to deal with.
+#'
+#'   Note that you should only use `message` with errors/warnings/messages
+#'   that you generate, or that base R generates (which tend to be stable).
+#'   Avoid tests that rely on the specific text generated by another package
+#'   since this can easily change. If you do need to test text generated by
+#'   another package, either protect the test with `skip_on_cran()` or
+#'   use `expect_snapshot()`.
+#' @inheritParams rlang::args_dots_empty
+#' @export
+#' @examples
+#' expect_no_warning(1 + 1)
+#'
+#' foo <- function(x) {
+#'   warning("This is a problem!")
+#' }
+#'
+#' # warning doesn't match so bubbles up:
+#' expect_no_warning(foo(), message = "bananas")
+#'
+#' # warning does match so causes a failure:
+#' try(expect_no_warning(foo(), message = "problem"))
+expect_no_error <- function(object,
+                                 ...,
+                                 message = NULL,
+                                 class = NULL) {
+  check_dots_empty()
+  expect_no_("error", {{ object }}, ..., regexp = message, class = class)
+}
+
+
+#' @export
+#' @rdname expect_no_error
+expect_no_warning <- function(object,
+                                   ...,
+                                   message = NULL,
+                                   class = NULL
+                                   ) {
+  check_dots_empty()
+  expect_no_("warning", {{ object }}, ..., regexp = message, class = class)
+}
+
+#' @export
+#' @rdname expect_no_error
+expect_no_message <- function(object,
+                                   ...,
+                                   message = NULL,
+                                   class = NULL
+                                   ) {
+  check_dots_empty()
+  expect_no_("messsage", {{ object }}, ..., regexp = message, class = class)
+}
+
+#' @export
+#' @rdname expect_no_error
+expect_no_condition <- function(object,
+                                     ...,
+                                     message = NULL,
+                                     class = NULL
+                                     ) {
+  check_dots_empty()
+  expect_no_("condition", {{ object }}, ..., regexp = message, class = class)
+}
+
+
+expect_no_ <- function(base_class,
+                            object,
+                            regexp = NULL,
+                            class = NULL,
+                            ...,
+                            error_call = caller_env()) {
+
+  check_dots_used(action = warn, call = error_call)
+  matcher <- cnd_matcher(class %||% base_class, regexp, ...)
+
+  capture <- function(code) {
+    try_fetch(
+      code,
+      !!base_class := function(cnd) {
+        if (!matcher(cnd)) {
+          return(zap())
+        }
+
+        expected <- paste0(
+          "Expected ", quo_label(enquo(object)), " to run without any ", base_class, "s",
+          if (!is.null(class)) paste0(" of class '", class, "'"),
+          if (!is.null(regexp)) paste0(" matching pattern '", regexp, "'"),
+          "."
+        )
+        actual <- paste0(
+          "Actually got a <", class(cnd)[[1]], ">:\n",
+          indent_lines(rlang::cnd_message(cnd, prefix = TRUE))
+        )
+        message <- format_error_bullets(c(expected, i = actual))
+        fail(message, trace_env = error_call)
+      }
+    )
+  }
+
+  act <- quasi_capture(enquo(object), NULL, capture)
+  succeed()
+  invisible(act$val)
+}
+
+indent_lines <- function(x) {
+  paste0("  ", gsub("\n", "\n  ", x))
+}

_pkgdown.yml

@@ -34,6 +34,7 @@ reference:
 - subtitle: Side-effects
   contents:
   - expect_error
+  - expect_no_error
   - expect_invisible
   - expect_output
   - expect_silent

man/expect_error.Rd

@@ -0,0 +1,35 @@
+# matched conditions give informative message
+
+    Code
+      expect_no_warning(foo())
+    Condition
+      Error:
+      ! Expected `foo()` to run without any warnings.
+      i Actually got a <test>:
+        Warning:
+        This is a problem!
+    Code
+      expect_no_warning(foo(), message = "problem")
+    Condition
+      Error:
+      ! Expected `foo()` to run without any warnings matching pattern 'problem'.
+      i Actually got a <test>:
+        Warning:
+        This is a problem!
+    Code
+      expect_no_warning(foo(), class = "test")
+    Condition
+      Error:
+      ! Expected `foo()` to run without any warnings of class 'test'.
+      i Actually got a <test>:
+        Warning:
+        This is a problem!
+    Code
+      expect_no_warning(foo(), message = "problem", class = "test")
+    Condition
+      Error:
+      ! Expected `foo()` to run without any warnings of class 'test' matching pattern 'problem'.
+      i Actually got a <test>:
+        Warning:
+        This is a problem!
+

man/expect_no_error.Rd

@@ -0,0 +1,26 @@
+test_that("unmatched conditions bubble up", {
+  expect_error(expect_no_error(abort("foo"), message = "bar"), "foo")
+  expect_warning(expect_no_warning(warn("foo"), message = "bar"), "foo")
+  expect_message(expect_no_message(inform("foo"), message = "bar"), "foo")
+  expect_condition(expect_no_condition(signal("foo", "x"), message = "bar"), "foo")
+})
+
+test_that("only matches conditions of specified type", {
+  foo <- function() {
+    warn("This is a problem!", class = "test")
+  }
+  expect_warning(expect_no_error(foo(), class = "test"), class = "test")
+})
+
+test_that("matched conditions give informative message", {
+  foo <- function() {
+    warn("This is a problem!", class = "test")
+  }
+
+  expect_snapshot(error = TRUE, {
+    expect_no_warning(foo())
+    expect_no_warning(foo(), message = "problem")
+    expect_no_warning(foo(), class = "test")
+    expect_no_warning(foo(), message = "problem", class = "test")
+  })
+})