From e5814911df1ba82574d93e7888b81f58b4f70a86 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 8 Aug 2025 10:21:31 -0400 Subject: [PATCH 1/5] Reliable nested subtests A few problems here: * `describe()` forgot to `substitute()` code. * `StopReporter` was called at the end of every (sub)test instead of just once. This also reqiured changes to `local_interactive_reporter()` * `StopReporter()` doesn't need the call in its error * In `test_code()` needs to accumulate expectations across its children Fixes #2063. Fixes #2188. --- NEWS.md | 1 + R/describe.R | 5 +++-- R/local.R | 1 + R/reporter-stop.R | 11 +++++------ R/test-that.R | 26 +++++++++++++++----------- R/testthat-package.R | 3 ++- tests/testthat/_snaps/reporter-stop.md | 3 +-- tests/testthat/test-snapshot-manage.R | 2 +- tests/testthat/test-test-that.R | 19 +++++++++++++++++-- 9 files changed, 46 insertions(+), 25 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6f56bac41..dc4eb533e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # testthat (development version) +* `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). * 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). diff --git a/R/describe.R b/R/describe.R index d2feb94cd..5a3300062 100644 --- a/R/describe.R +++ b/R/describe.R @@ -60,7 +60,8 @@ describe <- function(description, code) { local_description_push(description) - test_code(code, parent.frame(), skip_on_empty = FALSE) + code <- substitute(code) + test_code(code, parent.frame()) } #' @export @@ -69,5 +70,5 @@ it <- function(description, code = NULL) { local_description_push(description) code <- substitute(code) - test_code(code, env = parent.frame(), skip_on_empty = FALSE) + test_code(code, parent.frame()) } diff --git a/R/local.R b/R/local.R index eaa2a6411..0d1613c95 100644 --- a/R/local.R +++ b/R/local.R @@ -200,6 +200,7 @@ local_interactive_reporter <- function(.env = parent.frame()) { # Use StopReporter reporter <- StopReporter$new() old <- set_reporter(reporter) + withr::defer(reporter$end_reporter(), envir = .env) withr::defer(reporter$stop_if_needed(), envir = .env) withr::defer(set_reporter(old), envir = .env) diff --git a/R/reporter-stop.R b/R/reporter-stop.R index bf73bdc54..4c9f2a67b 100644 --- a/R/reporter-stop.R +++ b/R/reporter-stop.R @@ -45,9 +45,12 @@ StopReporter <- R6::R6Class( self$n_fail <- self$n_fail + 1 } self$issues$push(result) + + self$local_user_output() + self$cat_line(issue_summary(result, rule = TRUE), "\n") }, - end_test = function(context, test) { + end_reporter = function(context, test) { self$local_user_output() if (self$issues$size() == 0) { @@ -55,16 +58,12 @@ StopReporter <- R6::R6Class( emoji <- praise_emoji() self$cat_line(colourise("Test passed", "success"), " ", emoji) } - } else { - issues <- self$issues$as_list() - messages <- map_chr(issues, issue_summary, rule = TRUE) - self$cat_line(messages, "\n") } }, stop_if_needed = function() { if (self$stop_reporter && self$n_fail > 0) { - cli::cli_abort("Test failed.") + cli::cli_abort("Test failed.", call = NULL) } } ) diff --git a/R/test-that.R b/R/test-that.R index a08782dec..984ec44b0 100644 --- a/R/test-that.R +++ b/R/test-that.R @@ -46,7 +46,7 @@ test_that <- function(desc, code) { } } - test_code(code, env = parent.frame()) + test_code(code, parent.frame()) } # Access error fields with `[[` rather than `$` because the @@ -64,6 +64,14 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) { withr::defer(reporter$end_test(context = reporter$.context, test = test)) } + # Want to skip if the test (and its subtests) have no expectations + # if (the$top_level_test) { + # the$test_expectations <- 0 + # the$top_level_test <- FALSE + # withr::defer(the$top_level_test <- TRUE) + # } + starting_expectations <- the$test_expectations + ok <- TRUE # @param debug_end How many frames should be skipped to find the @@ -88,13 +96,8 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) { expressions_opt <- getOption("expressions") expressions_opt_new <- min(expressions_opt + 500L, 500000L) - # If no handlers are called we skip: BDD (`describe()`) tests are often - # nested and the top level might not contain any expectations, so we need - # some way to disable - handled <- !skip_on_empty - handle_error <- function(e) { - handled <<- TRUE + the$test_expectations <- the$test_expectations + 1L # Increase option(expressions) to handle errors here if possible, even in # case of a stack overflow. This is important for the DebugReporter. @@ -109,11 +112,11 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) { invokeRestart("end_test") } handle_fatal <- function(e) { - handled <<- TRUE + the$test_expectations <- the$test_expectations + 1L register_expectation(e, 0) } handle_expectation <- function(e) { - handled <<- TRUE + the$test_expectations <- the$test_expectations + 1L register_expectation(e, 7) # Don't bubble up to any other handlers invokeRestart("continue_test") @@ -143,7 +146,7 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) { } } handle_skip <- function(e) { - handled <<- TRUE + the$test_expectations <- the$test_expectations + 1L debug_end <- if (inherits(e, "skip_empty")) -1 else 2 register_expectation(e, debug_end) @@ -168,7 +171,8 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) { withCallingHandlers( { eval(code, test_env) - if (!handled && !is.null(test)) { + has_expectations <- the$test_expectations > starting_expectations + if (!has_expectations && skip_on_empty) { skip_empty() } }, diff --git a/R/testthat-package.R b/R/testthat-package.R index c9fc25f67..c4b737af3 100644 --- a/R/testthat-package.R +++ b/R/testthat-package.R @@ -19,7 +19,8 @@ NULL the <- new.env(parent = emptyenv()) -the$description <- character() +the$top_level_test <- TRUE +the$test_expectations <- 0 # The following block is used by usethis to automatically manage # roxygen namespace tags. Modify with care! diff --git a/tests/testthat/_snaps/reporter-stop.md b/tests/testthat/_snaps/reporter-stop.md index 24210c492..79a6d4681 100644 --- a/tests/testthat/_snaps/reporter-stop.md +++ b/tests/testthat/_snaps/reporter-stop.md @@ -1,6 +1,5 @@ # produces useful output - Test passed -- Failure ('reporters/tests.R:12:3'): Failure:1 ------------------------------- FALSE (`actual`) is not equal to TRUE (`expected`). @@ -53,6 +52,6 @@ Code r$stop_if_needed() Condition - Error in `r$stop_if_needed()`: + Error: ! Test failed. diff --git a/tests/testthat/test-snapshot-manage.R b/tests/testthat/test-snapshot-manage.R index 7269c4d13..1e352e960 100644 --- a/tests/testthat/test-snapshot-manage.R +++ b/tests/testthat/test-snapshot-manage.R @@ -36,7 +36,7 @@ test_that("can work with variants", { test_that("snapshot_reject deletes .new files", { path <- local_snapshot_dir(c("a.md", "a.new.md", "b.md", "b.new.md")) - + expect_snapshot(snapshot_reject(path = path)) expect_equal(dir(file.path(path, "_snaps")), c("a.md", "b.md")) }) diff --git a/tests/testthat/test-test-that.R b/tests/testthat/test-test-that.R index 486d51e72..8818da87f 100644 --- a/tests/testthat/test-test-that.R +++ b/tests/testthat/test-test-that.R @@ -121,9 +121,24 @@ test_that("return value from test_that", { }) ) expect_false(skip) - # No tests = automatically generated skip - with_reporter("", skip <- test_that("success", {})) +}) + +test_that("empty test skips automatically", { + expectations <- capture_expectations(skip <- test_that("success", {})) expect_false(skip) + expect_s3_class(expectations[[1]], "expectation_skip") +}) + +test_that("nested tests skipped correctly", { + expectations <- capture_expectations({ + describe("outer", { + it("1") + it("2", expect_true(TRUE)) + }) + }) + expect_length(expectations, 2) + expect_s3_class(expectations[[1]], "expectation_skip") + expect_s3_class(expectations[[2]], "expectation_success") }) test_that("can signal warnings and messages without restart", { From 61653d5c3f7ed7c96e7635d877fe4cdf2f10e38b Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 8 Aug 2025 13:16:24 -0400 Subject: [PATCH 2/5] Do reset test count; update comments --- R/test-that.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/test-that.R b/R/test-that.R index 984ec44b0..6957a02d8 100644 --- a/R/test-that.R +++ b/R/test-that.R @@ -64,12 +64,13 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) { withr::defer(reporter$end_test(context = reporter$.context, test = test)) } - # Want to skip if the test (and its subtests) have no expectations - # if (the$top_level_test) { - # the$test_expectations <- 0 - # the$top_level_test <- FALSE - # withr::defer(the$top_level_test <- TRUE) - # } + if (the$top_level_test) { + # Not strictly necessary but nice to reset the count + the$test_expectations <- 0 + the$top_level_test <- FALSE + withr::defer(the$top_level_test <- TRUE) + } + # Used to skip if the test _and_ its subtests have no expectations starting_expectations <- the$test_expectations ok <- TRUE From 19c00c1a41d33d370454157d464248cc5aaf6df5 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 8 Aug 2025 13:17:03 -0400 Subject: [PATCH 3/5] Tweak variable name --- R/test-that.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/test-that.R b/R/test-that.R index 6957a02d8..cffa095cf 100644 --- a/R/test-that.R +++ b/R/test-that.R @@ -172,8 +172,8 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) { withCallingHandlers( { eval(code, test_env) - has_expectations <- the$test_expectations > starting_expectations - if (!has_expectations && skip_on_empty) { + new_expectations <- the$test_expectations > starting_expectations + if (!new_expectations && skip_on_empty) { skip_empty() } }, From 911b83755a1db6f5d30f28adb3d7f4bd7a05cf21 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 8 Aug 2025 13:23:02 -0400 Subject: [PATCH 4/5] More alignment --- NEWS.md | 1 + R/test-that.R | 9 --------- man/source_file.Rd | 4 +++- tests/testthat/test-describe.R | 12 +++++++++--- tests/testthat/test-test-that.R | 6 ------ 5 files changed, 13 insertions(+), 19 deletions(-) diff --git a/NEWS.md b/NEWS.md index b0fc31501..41aba9f5f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # testthat (development version) +* `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). diff --git a/R/test-that.R b/R/test-that.R index cffa095cf..1308976ff 100644 --- a/R/test-that.R +++ b/R/test-that.R @@ -37,15 +37,6 @@ test_that <- function(desc, code) { local_description_push(desc) code <- substitute(code) - if (edition_get() >= 3) { - if (!is_call(code, "{")) { - cli::cli_warn( - "The {.arg code} argument to {.fn test_that} must be a braced expression to get accurate file-line information for failures.", - class = "testthat_braces_warning" - ) - } - } - test_code(code, parent.frame()) } diff --git a/man/source_file.Rd b/man/source_file.Rd index 04a212f0a..8f88de9a5 100644 --- a/man/source_file.Rd +++ b/man/source_file.Rd @@ -38,7 +38,9 @@ source_test_teardown(path = "tests/testthat", env = test_env()) \item{chdir}{Change working directory to \code{dirname(path)}?} -\item{desc}{If not-\code{NULL}, will run only test with this \code{desc}ription.} +\item{desc}{A character vector used to filter tests. This is used to +(recursively) filter the content of the file, so that only the non-test +code up to and including the match test is run.} \item{wrap}{Automatically wrap all code within \code{\link[=test_that]{test_that()}}? This ensures that all expectations are reported, even if outside a test block.} diff --git a/tests/testthat/test-describe.R b/tests/testthat/test-describe.R index 53875c7b3..beb8e9c71 100644 --- a/tests/testthat/test-describe.R +++ b/tests/testthat/test-describe.R @@ -11,12 +11,18 @@ describe("describe", { }) }) }) +}) - it("can have not yet implemented specs", { - describe("Millennium Prize Problems", { - it("can be shown that P != NP") +test_that("unimplemented specs generate skips", { + expectations <- capture_expectations({ + it("can have not yet implemented specs", { + describe("Millennium Prize Problems", { + it("can be shown that P != NP") + }) }) }) + expect_length(expectations, 1) + expect_s3_class(expectations[[1]], "expectation_skip") }) someExternalVariable <- 1 diff --git a/tests/testthat/test-test-that.R b/tests/testthat/test-test-that.R index 8818da87f..5e4a355ad 100644 --- a/tests/testthat/test-test-that.R +++ b/tests/testthat/test-test-that.R @@ -148,12 +148,6 @@ test_that("can signal warnings and messages without restart", { expect_null(signalCondition(warning_cnd("foo"))) }) -test_that("braces required in testthat 3e", { - local_edition(3) - expect_warning( - test_that("", expect_true(TRUE)) - ) -}) test_that("no braces required in testthat 2e", { local_edition(2) From 2613c93992c34dfef05c5433428dd6e1a4777624 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 8 Aug 2025 13:30:20 -0400 Subject: [PATCH 5/5] Oops --- R/testthat-package.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/testthat-package.R b/R/testthat-package.R index c4b737af3..799da070b 100644 --- a/R/testthat-package.R +++ b/R/testthat-package.R @@ -19,6 +19,7 @@ NULL the <- new.env(parent = emptyenv()) +the$description <- character() the$top_level_test <- TRUE the$test_expectations <- 0