Merge commit 'fa29578e09f9eeafc6b9822364e29b07c8bd7a8c'

Author: hadley

.claude/settings.local.json

@@ -1,8 +1,12 @@
 {
+  "$schema": "https://json.schemastore.org/claude-code-settings.json",
   "permissions": {
     "allow": [
-      "Bash(find:*)"
+      "Bash(find:*)",
+      "Bash(R:*)",
+      "Bash(rm:*)",
+      "Bash(air format:*)"
     ],
     "deny": []
   }
-}
+}

CLAUDE.md

@@ -8,19 +8,23 @@ testthat is R's most popular unit testing framework, used by thousands of CRAN p
 
 ## Key Development Commands
 
-### Testing
-- `devtools::test()` or `Ctrl/Cmd+Shift+T` in RStudio - Run all tests
-- `devtools::test_file("tests/testthat/test-filename.R")` - Run tests in a specific file
-- `testthat::test_local()` - Run tests for local source package
-- `testthat::test_package("testthat")` - Run tests for installed package
-- `R CMD check` - Full package check including tests
+General advice:
+* When running R from the console, always run it with `--quiet --vanilla`
+* Always run `air format .` after generating code
+
+### Development tools
 
-### Building and Installation
-- `devtools::load_all()` or `Ctrl/Cmd+Shift+L` - Load package for development
-- `devtools::document()` - Generate documentation
+- `devtools::test()` - Run all tests
+- `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::check()` - Run R CMD check
 - `devtools::install()` - Install package locally
 
+### Documentation
+
+- Always run `devtools::document()` after changing any roxygen2 docs.
+
 ## Core Architecture
 
 ### Main Components

DESCRIPTION

@@ -17,23 +17,23 @@ BugReports: https://github.com/r-lib/testthat/issues
 Depends:
     R (>= 4.1.0)
 Imports:
-    brio (>= 1.1.3),
-    callr (>= 3.7.3),
-    cli (>= 3.6.1),
-    desc (>= 1.4.2),
-    evaluate (>= 1.0.1),
-    jsonlite (>= 1.8.7),
-    lifecycle (>= 1.0.3),
+    brio (>= 1.1.5),
+    callr (>= 3.7.6),
+    cli (>= 3.6.5),
+    desc (>= 1.4.3),
+    evaluate (>= 1.0.4),
+    jsonlite (>= 2.0.0),
+    lifecycle (>= 1.0.4),
     magrittr (>= 2.0.3),
     methods,
-    pkgload (>= 1.3.2.1),
+    pkgload (>= 1.4.0),
     praise (>= 1.0.0),
-    processx (>= 3.8.2),
-    ps (>= 1.7.5),
-    R6 (>= 2.5.1),
-    rlang (>= 1.1.1),
+    processx (>= 3.8.6),
+    ps (>= 1.9.1),
+    R6 (>= 2.6.1),
+    rlang (>= 1.1.6),
     utils,
-    waldo (>= 0.6.0),
+    waldo (>= 0.6.2),
     withr (>= 3.0.2)
 Suggests:
     covr,

NAMESPACE

@@ -45,6 +45,7 @@ export(ProgressReporter)
 export(RStudioReporter)
 export(Reporter)
 export(SilentReporter)
+export(SlowReporter)
 export(StopReporter)
 export(SummaryReporter)
 export(TapReporter)
@@ -114,6 +115,7 @@ export(expect_no_warning)
 export(expect_null)
 export(expect_output)
 export(expect_output_file)
+export(expect_r6_class)
 export(expect_reference)
 export(expect_s3_class)
 export(expect_s4_class)
@@ -228,5 +230,6 @@ import(rlang)
 importFrom(R6,R6Class)
 importFrom(brio,readLines)
 importFrom(brio,writeLines)
+importFrom(lifecycle,deprecated)
 importFrom(magrittr,"%>%")
 useDynLib(testthat, .registration = TRUE)

NEWS.md

@@ -1,5 +1,25 @@
 # testthat (development version)
 
+* 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).
+* `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).
 * 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/auto-test.R

@@ -1,24 +1,18 @@
 #' Watches code and tests for changes, rerunning tests as appropriate.
 #'
+#' @description
+#' `r lifecycle::badge("superseded")`
+#'
 #' The idea behind `auto_test()` is that you just leave it running while
 #' you develop your code.  Every time you save a file it will be automatically
 #' tested and you can easily see if your changes have caused any test
-#'  failures.
+#' failures.
 #'
 #' The current strategy for rerunning tests is as follows:
 #'
 #' - if any code has changed, then those files are reloaded and all tests
 #'   rerun
 #' - otherwise, each new or modified test is run
-#'
-#' In the future, `auto_test()` might implement one of the following more
-#' intelligent alternatives:
-#'
-#' - Use codetools to build up dependency tree and then rerun tests only
-#'   when a dependency changes.
-#' - Mimic ruby's autotest and rerun only failing tests until they pass,
-#'   and then rerun all tests.
-#
 #' @seealso [auto_test_package()]
 #' @export
 #' @param code_path path to directory containing code
@@ -27,7 +21,7 @@
 #' @param env environment in which to execute test suite.
 #' @param hash Passed on to [watch()]. When FALSE, uses less accurate
 #'   modification time stamps, but those are faster for large files.
-#' @keywords debugging
+#' @keywords internal
 auto_test <- function(
   code_path,
   test_path,
@@ -67,15 +61,12 @@ auto_test <- function(
   watch(c(code_path, test_path), watcher, hash = hash)
 }
 
-#' Watches a package for changes, rerunning tests as appropriate.
-#'
 #' @param pkg path to package
 #' @export
 #' @param reporter test reporter to use
 #' @param hash Passed on to [watch()].  When FALSE, uses less accurate
 #'   modification time stamps, but those are faster for large files.
-#' @keywords debugging
-#' @seealso [auto_test()] for details on how method works
+#' @rdname auto_test
 auto_test_package <- function(
   pkg = ".",
   reporter = default_reporter(),

R/compare.R

@@ -16,8 +16,8 @@ compare <- function(x, y, ...) {
 }
 
 comparison <- function(equal = TRUE, message = "Equal") {
-  stopifnot(is.logical(equal), length(equal) == 1)
-  stopifnot(is.character(message))
+  check_bool(equal)
+  check_character(message)
 
   structure(
     list(

R/deprec-condition.R

@@ -129,7 +129,7 @@ capture_warnings <- function(code, ignore_deprecation = FALSE) {
 }
 
 get_messages <- function(x) {
-  vapply(x, cnd_message, FUN.VALUE = character(1))
+  map_chr(x, cnd_message)
 }
 
 #' Is an error informative?

R/describe.R

@@ -56,43 +56,17 @@
 #'     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)
-
-    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()
+  local_description_push(description)
 
-  test_code(
-    description,
-    code,
-    env = env,
-    reporter = reporter,
-    skip_on_empty = FALSE
-  )
+  test_code(code, parent.frame(), skip_on_empty = FALSE)
 }
 
 #' @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, env = parent.frame(), skip_on_empty = FALSE)
 }

R/expect-comparison.R

@@ -31,21 +31,31 @@ 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")
   }
   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))
   }
@@ -54,35 +64,35 @@ expect_compare_ <- function(
 #' @export
 #' @rdname comparison-expectations
 expect_lt <- function(object, expected, label = NULL, expected.label = NULL) {
-  act <- quasi_label(enquo(object), label, arg = "object")
-  exp <- quasi_label(enquo(expected), expected.label, arg = "expected")
+  act <- quasi_label(enquo(object), label)
+  exp <- quasi_label(enquo(expected), expected.label)
 
   expect_compare_("<", act, exp)
 }
 
 #' @export
 #' @rdname comparison-expectations
 expect_lte <- function(object, expected, label = NULL, expected.label = NULL) {
-  act <- quasi_label(enquo(object), label, arg = "object")
-  exp <- quasi_label(enquo(expected), expected.label, arg = "expected")
+  act <- quasi_label(enquo(object), label)
+  exp <- quasi_label(enquo(expected), expected.label)
 
   expect_compare_("<=", act, exp)
 }
 
 #' @export
 #' @rdname comparison-expectations
 expect_gt <- function(object, expected, label = NULL, expected.label = NULL) {
-  act <- quasi_label(enquo(object), label, arg = "object")
-  exp <- quasi_label(enquo(expected), expected.label, arg = "expected")
+  act <- quasi_label(enquo(object), label)
+  exp <- quasi_label(enquo(expected), expected.label)
 
   expect_compare_(">", act, exp)
 }
 
 #' @export
 #' @rdname comparison-expectations
 expect_gte <- function(object, expected, label = NULL, expected.label = NULL) {
-  act <- quasi_label(enquo(object), label, arg = "object")
-  exp <- quasi_label(enquo(expected), expected.label, arg = "expected")
+  act <- quasi_label(enquo(object), label)
+  exp <- quasi_label(enquo(expected), expected.label)
 
   expect_compare_(">=", act, exp)
 }
@@ -109,3 +119,39 @@ expect_more_than <- function(...) {
   warning("Deprecated: please use `expect_gt()` instead", call. = FALSE)
   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))
+  }
+}