Merge branch 'main' into argument-checking

Author: hadley

.claude/settings.local.json

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

CLAUDE.md

@@ -8,15 +8,15 @@ 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::test()` - Run all tests
+- `devtools::test_file("tests/testthat/test-filename.R")` - Run tests in a specific file
+- `devtools::load_all()` - Load package for development
 - `devtools::document()` - Generate documentation
 - `devtools::check()` - Run R CMD check
 - `devtools::install()` - Install package locally

NEWS.md

@@ -1,6 +1,9 @@
 # testthat (development version)
 
 * `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).

R/reporter-junit.R

@@ -108,6 +108,11 @@ JunitReporter <- R6::R6Class(
       time <- self$elapsed_time()
       self$suite_time <- self$suite_time + time
 
+      # If no context was started (e.g., warnings outside tests), create a default one
+      if (is.null(self$suite)) {
+        self$start_context(context %||% "(unknown)")
+      }
+
       # XML node for test case
       name <- test %||% "(unnamed)"
       testcase <- xml2::xml_add_child(
@@ -120,7 +125,7 @@ JunitReporter <- R6::R6Class(
 
       first_line <- function(x) {
         loc <- expectation_location(x, " (", ")")
-        paste0(strsplit(x$message, split = "\n")[[1]][1], loc)
+        paste0(strsplit(cli::ansi_strip(x$message), split = "\n")[[1]][1], loc)
       }
 
       # add an extra XML child node if not a success
@@ -147,6 +152,9 @@ JunitReporter <- R6::R6Class(
       } else if (expectation_skip(result)) {
         xml2::xml_add_child(testcase, "skipped", message = first_line(result))
         self$skipped <- self$skipped + 1
+      } else if (expectation_warning(result)) {
+        warning_node <- xml2::xml_add_child(testcase, "system-out")
+        xml2::xml_text(warning_node) <- cli::ansi_strip(format(result))
       }
     },
 

R/try-again.R

@@ -1,48 +1,38 @@
-#' Try evaluating an expressing multiple times until it succeeds.
+#' Try evaluating an expressing multiple times until it succeeds
 #'
-#' @param times Maximum number of attempts.
-#' @param code Code to evaluate
-#' @keywords internal
+#' If you have a flaky test, you can use `try_again()` to run it a few times
+#' until it succeeds. In most cases, you are better fixing the underlying
+#' cause of the flakeyness, but sometimes that's not possible.
+#'
+#' @param times Number of times to retry.
+#' @param code Code to evaluate.
 #' @export
 #' @examples
-#' third_try <- local({
-#'   i <- 3
-#'   function() {
-#'     i <<- i - 1
-#'     if (i > 0) fail(paste0("i is ", i))
-#'   }
-#' })
-#' try_again(3, third_try())
+#' usually_return_1 <- function(i) {
+#'   if (runif(1) < 0.1) 0 else 1
+#' }
+#'
+#' \dontrun{
+#' # 10% chance of failure:
+#' expect_equal(usually_return_1(), 1)
+#'
+#' # 1% chance of failure:
+#' try_again(3, expect_equal(usually_return_1(), 1))
+#' }
 try_again <- function(times, code) {
-  while (times > 0) {
-    e <- tryCatch(
-      withCallingHandlers(
-        {
-          code
-          NULL
-        },
-        warning = function(e) {
-          if (
-            identical(e$message, "restarting interrupted promise evaluation")
-          ) {
-            tryInvokeRestart("muffleWarning")
-          }
-        }
-      ),
-      expectation_failure = function(e) {
-        e
-      },
-      error = function(e) {
-        e
-      }
-    )
+  check_number_whole(times, min = 1)
 
-    if (is.null(e)) {
-      return(invisible(TRUE))
-    }
+  code <- enquo(code)
 
-    times <- times - 1L
+  i <- 1
+  while (i <= times) {
+    tryCatch(
+      return(eval(get_expr(code), get_env(code))),
+      expectation_failure = function(cnd) NULL
+    )
+    cli::cli_inform(c(i = "Expectation failed; trying again ({i})..."))
+    i <- i + 1
   }
 
-  exp_signal(e)
+  eval(get_expr(code), get_env(code))
 }

_pkgdown.yml

@@ -41,6 +41,10 @@ reference:
   - expect_invisible
   - expect_output
   - expect_silent
+
+- subtitle: Helpers
+  contents:
+  - try_again
   - local_reproducible_output
 
 - title: Snapshot testing

man/try_again.Rd

@@ -45,7 +45,12 @@
         </testcase>
       </testsuite>
       <testsuite name="Warnings" timestamp="1999:12:31 23:59:59" hostname="nodename" tests="2" skipped="1" failures="0" errors="0" time="0">
-        <testcase time="0" classname="Warnings" name="warnings_get_backtraces"/>
+        <testcase time="0" classname="Warnings" name="warnings_get_backtraces">
+          <system-out>def
+    Backtrace:
+        x
+     1. \-f()</system-out>
+        </testcase>
         <testcase time="0" classname="Warnings" name="warnings_get_backtraces">
           <skipped message="Reason: empty test ('reporters/tests.R:44:1')"/>
         </testcase>

tests/testthat/_snaps/reporter-junit.md

@@ -0,0 +1,21 @@
+# tries multiple times
+
+    Code
+      result <- try_again(3, third_try())
+    Message
+      i Expectation failed; trying again (1)...
+      i Expectation failed; trying again (2)...
+
+---
+
+    Code
+      try_again(1, third_try())
+    Message
+      i Expectation failed; trying again (1)...
+    Condition
+      Error:
+      ! `i` (`actual`) is not equal to 0 (`expected`).
+      
+        `actual`: 1.0
+      `expected`: 0.0
+

tests/testthat/_snaps/try-again.md

@@ -7,3 +7,37 @@ test_that("permit Java-style class names", {
   class <- "package_name_or_domain.ClassName"
   expect_equal(classnameOK(class), class)
 })
+
+test_that("ANSI escapes are stripped from all user text in XML", {
+  skip_if_not_installed("xml2")
+
+  tmp <- withr::local_tempfile(fileext = ".xml")
+  reporter <- JunitReporterMock$new(file = tmp)
+  reporter$start_reporter()
+
+  text_with_ansi <- "\033[33mFirst line\033[0m\nSecond line"
+  reporter$start_context("c")
+  reporter$start_test("c", "t")
+  reporter$add_result("c", "t", new_expectation("error", text_with_ansi))
+  reporter$add_result("c", "t", new_expectation("failure", text_with_ansi))
+  reporter$add_result("c", "t", new_expectation("skip", text_with_ansi))
+  reporter$end_test()
+  reporter$end_context()
+  reporter$end_reporter()
+
+  expect_no_error(xml2::read_xml(tmp))
+})
+
+test_that("warnings outside context don't cause xml_add_child errors", {
+  skip_if_not_installed("xml2")
+
+  tmp <- withr::local_tempfile(fileext = ".xml")
+  reporter <- JunitReporterMock$new(file = tmp)
+  reporter$start_reporter()
+
+  # This would previously fail with "no applicable method for 'xml_add_child'"
+  expect_no_error({
+    reporter$add_result(NULL, "test", new_expectation("warning", "test"))
+  })
+  reporter$end_reporter()
+})