Merge commit '690fdb87ed8db5411ef80c0d041a188853cd7050'

Author: hadley

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: testthat
 Title: Unit Testing for R
-Version: 3.2.1.9000
+Version: 3.2.2.9000
 Authors@R: c(
     person("Hadley", "Wickham", , "[email protected]", role = c("aut", "cre")),
     person("Posit Software, PBC", role = c("cph", "fnd")),
@@ -34,7 +34,7 @@ Imports:
     R6 (>= 2.5.1),
     rlang (>= 1.1.1),
     utils,
-    waldo (>= 0.5.1),
+    waldo (>= 0.6.0),
     withr (>= 3.0.2)
 Suggests:
     covr,
@@ -43,6 +43,7 @@ Suggests:
     knitr,
     rmarkdown,
     rstudioapi,
+    S7,
     shiny,
     usethis,
     vctrs (>= 0.1.0),

NAMESPACE

@@ -106,19 +106,23 @@ 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)
 export(expect_output_file)
 export(expect_reference)
 export(expect_s3_class)
 export(expect_s4_class)
+export(expect_s7_class)
 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

@@ -33,6 +33,55 @@
 
 * `expect_setequal()` correctly identifies what is missing where (#1962).
 
+* `expect_snapshot()` now strips line breaks in test descriptions
+  (@LDSamson, #1900), and errors when called from a `test_that()` that has an
+  empty description (@kevinushey, #1980).
+
+* `expect_true()` and `expect_false()` give better errors if `actual` isn't a
+  vector (#1996).
+
+* `expect_visible()` and `expect_invisible()` have clearer failure messages
+   (#1966).
+* `local_reproducible_output()` (used in `test_that()` blocks) now sets
+   `LANGUAGE` to `"C"` instead of `"en"` to disable translations,
+   avoiding warnings on some platforms (#1925).
+
+* `skip_if_not_installed()` generates a clearer message that sorts better
+   (@MichaelChirico, #1959).
+
+* `with_mock()` and `local_mock()` have been unconditionally deprecated as
+  they will no longer work in future versions of R (#1999).
+* Fixed an issue where `expect_no_error(1)` was failing (#2037).
+
+* Fixed an issue where calling `skip()` outside of an active test could
+  cause an unexpected error (@kevinushey, #2039).
+
+# testthat 3.2.2
+
+## New expectations
+
+* `expect_s7_class()` tests if an object is an S7 class (#1580).
+
+* `expect_no_failure()`, `expect_no_success()` and `expect_snapshot_failure()`
+  provide more options for testing expectations.
+
+## Bug fixes and minor improvements
+
+* testthat now requires waldo 0.6.0 or later to access the latest features
+  (#1955).
+
+* `expect_condition()` and related functions now include the `class` of the
+  expected condition in the failure message, if provided (#1987).
+
+* `expect_error()` and friends now error if you supply `...` but not `pattern`
+  (#1932). They no longer give an uninformative error if they fail inside
+  a magrittr pipe (#1994).
+
+* `expect_no_*()` expectations no longer incorrectly emit a passing test result
+  if they in fact fail (#1997).
+
+* `expect_setequal()` correctly identifies what is missing where (#1962).
+
 * `expect_snapshot()` now strips line breaks in test descriptions
   (@LDSamson, #1900), and errors when called from a `test_that()` that has an
   empty description (@kevinushey, #1980).

R/describe.R

@@ -76,13 +76,14 @@ describe <- function(description, code) {
 }
 
 describe_it <- function(description, code, env = parent.frame()) {
+  reporter <- get_reporter() %||% local_interactive_reporter()
   local_test_context()
 
   test_code(
     description,
     code,
     env = env,
-    default_reporter = local_interactive_reporter(),
+    reporter = reporter,
     skip_on_empty = FALSE
   )
 }

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-constant.R

@@ -1,5 +1,6 @@
 #' Does code return `TRUE` or `FALSE`?
 #'
+#' @description
 #' These are fall-back expectations that you can use when none of the other
 #' more specific expectations apply. The disadvantage is that you may get
 #' a less informative error message.
@@ -30,18 +31,14 @@ NULL
 #' @rdname logical-expectations
 expect_true <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label, arg = "object")
-  act$val <- as.vector(act$val)
-
-  expect_waldo_constant(act, TRUE, info = info)
+  expect_waldo_constant(act, TRUE, info = info, ignore_attr = TRUE)
 }
 
 #' @export
 #' @rdname logical-expectations
 expect_false <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label, arg = "object")
-  act$val <- as.vector(act$val)
-
-  expect_waldo_constant(act, FALSE, info = info)
+  expect_waldo_constant(act, FALSE, info = info, ignore_attr = TRUE)
 }
 
 #' Does code return `NULL`?
@@ -66,11 +63,17 @@ expect_null <- function(object, info = NULL, label = NULL) {
 
 # helpers -----------------------------------------------------------------
 
-expect_waldo_constant <- function(act, constant, info) {
-  comp <- waldo_compare(act$val, constant, x_arg = "actual", y_arg = "expected")
+expect_waldo_constant <- function(act, constant, info, ...) {
+  comp <- waldo_compare(
+    act$val,
+    constant,
+    x_arg = "actual",
+    y_arg = "expected",
+    ...
+  )
 
   expect(
-    identical(act$val, constant),
+    length(comp) == 0,
     sprintf(
       "%s is not %s\n\n%s",
       act$lab, deparse(constant),

R/expect-inheritance.R

@@ -12,6 +12,8 @@
 #' * `expect_s4_class(x, class)` checks that `x` is an S4 object that
 #'   [is()] `class`.
 #' * `expect_s4_class(x, NA)` checks that `x` isn't an S4 object.
+#' * `expect_s7_class(x, Class)` checks that `x` is an S7 object that
+#'   [S7::S7_inherits()] from `Class`
 #'
 #' See [expect_vector()] for testing properties of objects created by vctrs.
 #'
@@ -92,6 +94,33 @@ expect_s3_class <- function(object, class, exact = FALSE) {
   invisible(act$val)
 }
 
+#' @export
+#' @rdname inheritance-expectations
+expect_s7_class <- function(object, class) {
+  check_installed("S7")
+  if (!inherits(class, "S7_class")) {
+    stop_input_type(class, "an S7 class object")
+  }
+
+  act <- quasi_label(enquo(object), arg = "object")
+
+  if (!S7::S7_inherits(object)) {
+    fail(sprintf("%s is not an S7 object", act$lab))
+  } else {
+    expect(
+      S7::S7_inherits(object, class),
+      sprintf(
+        "%s inherits from %s not <%s>.",
+        act$lab,
+        paste0("<", setdiff(base::class(object), "S7_object"), ">", collapse = "/"),
+        attr(class, "name", TRUE)
+      )
+    )
+  }
+
+  invisible(act$val)
+}
+
 #' @export
 #' @rdname inheritance-expectations
 expect_s4_class <- function(object, class) {

R/expect-invisible.R

@@ -26,7 +26,7 @@ expect_invisible <- function(call, label = NULL) {
 
   expect(
     identical(vis$visible, FALSE),
-    sprintf("%s does not return invisibly", lab)
+    sprintf("%s returns visibly, not invisibly.", lab)
   )
   invisible(vis$value)
 }
@@ -39,7 +39,7 @@ expect_visible <- function(call, label = NULL) {
 
   expect(
     identical(vis$visible, TRUE),
-    sprintf("%s does not invisibly", lab)
+    sprintf("%s returns invisibly, not visibly.", lab)
   )
   invisible(vis$value)
 }

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,
@@ -96,7 +96,12 @@ expect_no_ <- function(base_class,
 
   capture <- function(code) {
     try_fetch(
-      code,
+      {
+        code
+        # We can't call succeed() here because that generates a condition
+        # that causes `expect_no_condition()` to always fail
+        NULL
+      },
       !!base_class := function(cnd) {
         if (!matcher(cnd)) {
           return(zap())
@@ -113,13 +118,15 @@ 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)
       }
     )
   }
 
   act <- quasi_capture(enquo(object), NULL, capture)
-  succeed()
+  if (is.null(act$cap)) {
+    succeed()
+  }
   invisible(act$val)
 }