Merge commit '420f25dd7e34d309d2e21ef8d0d578f9d28e4c8e'

Author: hadley

CLAUDE.md

@@ -18,10 +18,13 @@ General advice:
 - `devtools::test_file("tests/testthat/test-filename.R")` - Run tests in a specific file
 - DO NOT USE `devtools::test_active_file()`
 - `devtools::load_all()` - Load package for development
-- `devtools::document()` - Generate documentation
 - `devtools::check()` - Run R CMD check
 - `devtools::install()` - Install package locally
 
+### Documentation
+
+- Always run `devtools::document()` after changing any roxygen2 docs.
+
 ## Core Architecture
 
 ### Main Components

NAMESPACE

@@ -45,6 +45,7 @@ export(ProgressReporter)
 export(RStudioReporter)
 export(Reporter)
 export(SilentReporter)
+export(SlowReporter)
 export(StopReporter)
 export(SummaryReporter)
 export(TapReporter)
@@ -191,6 +192,7 @@ export(skip_on_os)
 export(skip_on_travis)
 export(skip_unless_r)
 export(snapshot_accept)
+export(snapshot_reject)
 export(snapshot_review)
 export(source_dir)
 export(source_file)

NEWS.md

@@ -1,17 +1,35 @@
 # testthat (development version)
 
 * `test_dir()`, `test_file()`, `test_package()`, `test_check()`, `test_local()`, `source_file()` gain a `shuffle` argument uses `sample()` to randomly reorder the top-level expressions in each test file (#1942). This random reordering surfaces dependencies between tests and code outside of any test, as well as dependencies between tests. This helps you find and eliminate unintentional dependencies.
+* `snapshot_accept(test)` now works when the test file name contains `.` (#1669).
+* `local_mock()` and `with_mock()` have been deprecated because they are no longer permitted in R 4.5.
+* `snapshot_review()` now passes `...` on to `shiny::runApp()` (#1928).
+* `expect_named()` now gives more informative errors (#2091).
+* `expect_*()` functions consistently and rigorously check their inputs (#1754). 
+* `test_that()` no longer warns about the absence of `{}` since it no longer seems to be necessary.
+* `test_that()`, `describe()`, and `it()` can now be arbitrarily nested. Each component will skip only if it and its subtests don't contain any expectations. The interactive stop reporter has been fixed so it doesn't duplicate failures. (#2063, #2188).
+* Test filtering now works with `it()`, and the `desc` argument can take a character vector in order to recursively filter subtests (i.e. `it()` nested inside of `describe()`) (#2118).
+* New `snapshot_reject()` rejects all modified snapshots by deleting the `.new` variants (#1923).
+* New `SlowReporter` makes it easier to find the slowest tests in your package. The easiest way to run it is with `devtools::test(reporter = "slow")` (#1466).
+* Power `expect_mapequal()` with `waldo::compare(list_as_map = TRUE)` (#1521).
+* On CRAN, `test_that()` now automatically skips if a package is not installed (#1585). Practically, this means that you no longer need to check that suggested packages are installed. (We don't do this in the tidyverse because we think it has limited payoff, but other styles advise differently.)
+* `expect_snapshot()` no longer skips on CRAN, as that skips the rest of the test. Instead it just returns, neither succeeding nor failing (#1585).
+* Interrupting a test now prints the test name. This makes it easier to tell where a very slow test might be hanging (#1464)
+* Parallel testthat now does not ignore test files with syntax errors (#1360).
+* `expect_lt()`, `expect_gt()`, and friends have a refined display that is more likely to display the correct number of digits and shows you the actual values compared.
+* `describe()`, `it()`, and `test_that()` now have a shared stack of descriptions so that if you nest any inside of each other, any resulting failures will show you the full path.
+* `describe()` now correctly scopes `skip()` (#2007).
 * `ParallelProgressReporter` now respect `max_failures` (#1162).
 * The last snapshot is no longer lost if the snapshot file is missing the final newline (#2092). It's easy to accidentally remove this because there are two trailing new lines in snapshot files and many editors will automatically remove if you touch the file.
 * New `expect_r6_class()` (#2030).
-* `expect_*()` functions consistently and rigorously check their inputs (#1754). 
+* `expect_*()` functions consistently and rigorously check their inputs (#1754).
 * `JunitReporter()` no longer fails with `"no applicable method for xml_add_child"` for warnings outside of tests (#1913). Additionally, warnings now save their backtraces.
 * `JunitReporter()` strips ANSI escapes in more placese (#1852, #2032).
 * `try_again()` is now publicised. The first argument is now the number of retries, not tries (#2050).
 * `vignette("custom-expectations)` has been overhauled to make it much clearer how to create high-quality expectations (#2113, #2132, #2072).
 * `expect_snapshot()` and friends will now fail when creating a new snapshot on CI. This is usually a signal that you've forgotten to run it locally before committing (#1461).
 * `expect_snapshot_value()` can now handle expressions that generate `-` (#1678) or zero length atomic vectors (#2042).
-* `expect_matches()` failures should be a little easier to read (#2135).
+* `expect_matches()` failures should be a little easier to read (#2135, #2181).
 * New `local_on_cran(TRUE)` allows you to simulate how your tests will run on CRAN (#2112).
 * `expect_no_*()` now executes the entire code block, rather than stopping at the first message or warning (#1991).
 * `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 (#)

R/describe.R

@@ -26,6 +26,7 @@
 #'
 #' @param description description of the feature
 #' @param code test code containing the specs
+#' @keywords internal
 #' @export
 #' @examples
 #' describe("matrix()", {
@@ -56,43 +57,18 @@
 #'     it("can handle division by 0") #not yet implemented
 #'   })
 #' })
-
 describe <- function(description, code) {
-  check_string(description, allow_empty = FALSE)
-  describe_description <- description
-
-  # prepares a new environment for each it-block
-  describe_environment <- new.env(parent = parent.frame())
-  describe_environment$it <- function(description, code = NULL) {
-    check_string(description, allow_empty = FALSE)
-    code <- substitute(code)
+  local_description_push(description)
 
-    description <- paste0(describe_description, ": ", description)
-    describe_it(description, code, describe_environment)
-  }
-
-  eval(substitute(code), describe_environment)
-  invisible()
-}
-
-describe_it <- function(description, code, env = parent.frame()) {
-  reporter <- get_reporter() %||% local_interactive_reporter()
-  local_test_context()
-
-  test_code(
-    description,
-    code,
-    env = env,
-    reporter = reporter,
-    skip_on_empty = FALSE
-  )
+  code <- substitute(code)
+  test_code(code, parent.frame())
 }
 
 #' @export
 #' @rdname describe
 it <- function(description, code = NULL) {
-  check_string(description, allow_empty = FALSE)
+  local_description_push(description)
 
   code <- substitute(code)
-  describe_it(description, code, env = parent.frame())
+  test_code(code, parent.frame())
 }

R/edition.R

@@ -27,8 +27,8 @@ edition_deprecate <- function(in_edition, what, instead = NULL) {
     return()
   }
 
-  warn(c(
-    paste0("`", what, "` was deprecated in ", edition_name(in_edition), "."),
+  cli::cli_warn(c(
+    "{.code {what}} was deprecated in {edition_name(in_edition)}.",
     i = instead
   ))
 }
@@ -40,7 +40,7 @@ edition_require <- function(in_edition, what) {
     return()
   }
 
-  stop(paste0("`", what, "` requires ", edition_name(in_edition), "."))
+  cli::cli_abort("{.code {what}} requires {edition_name(in_edition)}.")
 }
 
 edition_name <- function(x) {

R/expect-comparison.R

@@ -1,4 +1,4 @@
-#' Does code return a number greater/less than the expected value?
+#' Do you expect a number bigger or smaller than this?
 #'
 #' @inheritParams expect_equal
 #' @param object,expected A value to compare and its expected bound.
@@ -31,21 +31,34 @@ expect_compare_ <- function(
   msg <- c(
     "<" = "not strictly less than",
     "<=" = "not less than",
-    ">" = "not strictly more than",
-    ">=" = "not more than"
+    ">" = "not strictly greater than",
+    ">=" = "not greater than"
   )[[operator]]
 
+  negated_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
+
   cmp <- op(act$val, exp$val)
   if (length(cmp) != 1 || !is.logical(cmp)) {
-    abort("Result of comparison must be a single logical value")
+    cli::cli_abort(
+      "Result of comparison must be a single logical value.",
+      call = trace_env
+    )
   }
   if (!isTRUE(cmp)) {
+    digits <- max(
+      digits(act$val),
+      digits(exp$val),
+      min_digits(act$val, exp$val)
+    )
     msg <- sprintf(
-      "%s is %s %s. Difference: %.3g",
+      "%s is %s %s.\n%s - %s = %s %s 0",
       act$lab,
       msg,
       exp$lab,
-      act$val - exp$val
+      num_exact(act$val, digits),
+      num_exact(exp$val, digits),
+      num_exact(act$val - exp$val, digits),
+      negated_op
     )
     return(fail(msg, trace_env = trace_env))
   }
@@ -99,13 +112,49 @@ expect_gte <- function(object, expected, label = NULL, expected.label = NULL) {
 #' @param ... All arguments passed on to `expect_lt()`/`expect_gt()`.
 #' @keywords internal
 expect_less_than <- function(...) {
-  warning("Deprecated: please use `expect_lt()` instead", call. = FALSE)
+  cli::cli_warn("Deprecated: please use {.fn expect_lt} instead.")
   expect_lt(...)
 }
 
 #' @rdname expect_less_than
 #' @export
 expect_more_than <- function(...) {
-  warning("Deprecated: please use `expect_gt()` instead", call. = FALSE)
+  cli::cli_warn("Deprecated: please use {.fn expect_gt} instead.")
   expect_gt(...)
 }
+
+
+# Helpers -----------------------------------------------------------------
+
+num_exact <- function(x, digits = 6) {
+  sprintf(paste0("%0.", digits, "f"), x)
+}
+
+min_digits <- function(x, y, tolerance = testthat_tolerance()) {
+  if (is.integer(x) && is.integer(y)) {
+    return(0L)
+  }
+
+  attributes(x) <- NULL
+  attributes(y) <- NULL
+
+  n <- digits(abs(x - y))
+  if (!is.null(tolerance)) {
+    n <- min(n, digits(tolerance))
+  }
+
+  as.integer(n) + 1L
+}
+
+digits <- function(x) {
+  x <- x[!is.na(x) & x != 0]
+  if (length(x) == 0) {
+    return(0)
+  }
+  scale <- -log10(min(x))
+  if (scale <= 0) {
+    0L
+  } else {
+    ceiling(round(scale, digits = 2))
+  }
+}

R/expect-condition.R

@@ -1,4 +1,4 @@
-#' Does code throw an error, warning, message, or other condition?
+#' Do you expect an error, warning, message, or other condition?
 #'
 #' @description
 #' `expect_error()`, `expect_warning()`, `expect_message()`, and
@@ -169,7 +169,7 @@ expect_warning <- function(
 
   if (edition_get() >= 3) {
     if (!missing(all)) {
-      warn("The `all` argument is deprecated")
+      cli::cli_warn("The {.arg all} argument is deprecated.")
     }
 
     expect_condition_matching_(

R/expect-constant.R

@@ -1,4 +1,4 @@
-#' Does code return `TRUE` or `FALSE`?
+#' Do you expect `TRUE` or `FALSE`?
 #'
 #' @description
 #' These are fall-back expectations that you can use when none of the other
@@ -42,7 +42,7 @@ expect_false <- function(object, info = NULL, label = NULL) {
   expect_waldo_equal_("equal", act, exp, info = info, ignore_attr = TRUE)
 }
 
-#' Does code return `NULL`?
+#' Do you expect `NULL`?
 #'
 #' This is a special case because `NULL` is a singleton so it's possible
 #' check for it either with `expect_equal(x, NULL)` or `expect_type(x, "NULL")`.

R/expect-equality.R

@@ -1,4 +1,4 @@
-#' Does code return the expected value?
+#' Do you expect this value?
 #'
 #' @description
 #' These functions provide two levels of strictness when comparing a
@@ -126,7 +126,8 @@ expect_waldo_equal_ <- function(
   exp,
   info = NULL,
   ...,
-  trace_env = caller_env()
+  trace_env = caller_env(),
+  error_prefix = NULL
 ) {
   comp <- waldo_compare(
     act$val,
@@ -145,6 +146,7 @@ expect_waldo_equal_ <- function(
       "`expected`",
       paste0(comp, collapse = "\n\n")
     )
+    msg <- paste0(error_prefix, msg)
     return(fail(msg, info = info, trace_env = trace_env))
   }
   pass(act$val)

R/expect-inheritance.R

@@ -1,5 +1,4 @@
-#' Does code return an object inheriting from the expected base type, S3 class,
-#' or S4 class?
+#' Do you expect an S3/S4/R6/S7 object that inherits from this class?
 #'
 #' @description
 #' See <https://adv-r.hadley.nz/oo.html> for an overview of R's OO systems, and
@@ -207,7 +206,7 @@ expect_s7_class <- function(object, class) {
   pass(act$val)
 }
 
-#' Does an object inherit from a given class?
+#' Do you expect to inherit from this class?
 #'
 #' @description
 #' `r lifecycle::badge("superseded")`