Refine describe() and it() (#2165)

Introducing a stack of test descriptions and moving reporter creation to `test_code()` allows `describe()` and `it()` to be much simpler and much more similar. I've also bulked out the testing a little more, since it was pretty basic previously.

Fixes #2007

Author: hadley

.claude/settings.local.json

@@ -9,4 +9,4 @@
     ],
     "deny": []
   }
-}
+}

NEWS.md

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

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/reporter-silent.R

@@ -28,3 +28,11 @@ SilentReporter <- R6::R6Class(
     }
   )
 )
+
+# Useful for testing test_that() and friends which otherwise swallow
+# all expectations by design
+capture_expectations <- function(code) {
+  reporter <- SilentReporter$new()
+  with_reporter(reporter, code)
+  reporter$expectations()
+}

R/reporter-zzz.R

@@ -36,6 +36,8 @@ get_reporter <- function() {
 #' @rdname reporter-accessors
 #' @export
 with_reporter <- function(reporter, code, start_end_reporter = TRUE) {
+  # Ensure we don't propagate the local description to the new reporter
+  local_description_set()
   reporter <- find_reporter(reporter)
 
   old <- set_reporter(reporter)

R/snapshot-reporter.R

@@ -35,9 +35,11 @@ SnapshotReporter <- R6::R6Class(
     },
 
     start_test = function(context, test) {
-      if (is.character(test)) {
-        self$test <- gsub("\n", "", test)
+      if (is.null(test)) {
+        return()
       }
+
+      self$test <- paste0(gsub("\n", "", test), collapse = " / ")
     },
 
     # Called by expectation

R/source.R

@@ -55,7 +55,6 @@ source_file <- function(
   withr::local_options(testthat_topenv = env, testthat_path = path)
   if (wrap) {
     invisible(test_code(
-      test = NULL,
       code = exprs,
       env = env,
       reporter = get_reporter() %||% StopReporter$new()

R/test-example.R

@@ -47,24 +47,23 @@ test_examples_installed <- function(package = testing_package()) {
 #' @export
 #' @rdname test_examples
 test_rd <- function(rd, title = attr(rd, "Rdfile")) {
-  test_example(rd, title)
+  test_example(rd, title %||% "example")
 }
 
 #' @export
 #' @rdname test_examples
 test_example <- function(path, title = path) {
+  local_description_push(title)
+
   ex_path <- withr::local_tempfile(pattern = "test_example-", fileext = ".R")
   tools::Rd2ex(path, ex_path)
   if (!file.exists(ex_path)) {
     return(invisible(FALSE))
   }
 
-  env <- new.env(parent = globalenv())
-
   ok <- test_code(
-    test = title,
     code = parse(ex_path, encoding = "UTF-8"),
-    env = env,
+    env = globalenv(),
     reporter = get_reporter() %||% StopReporter$new(),
     skip_on_empty = FALSE
   )

R/test-that.R

@@ -34,7 +34,7 @@
 #' })
 #' }
 test_that <- function(desc, code) {
-  check_string(desc)
+  local_description_push(desc)
 
   code <- substitute(code)
   if (edition_get() >= 3) {
@@ -46,23 +46,19 @@ test_that <- function(desc, code) {
     }
   }
 
-  # Must initialise interactive reporter before local_test_context()
-  reporter <- get_reporter() %||% local_interactive_reporter()
-  local_test_context()
-
-  test_code(
-    desc,
-    code,
-    env = parent.frame(),
-    reporter = reporter
-  )
+  test_code(code, env = parent.frame())
 }
 
 # Access error fields with `[[` rather than `$` because the
 # `$.Throwable` from the rJava package throws with unknown fields
-test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
+test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) {
+  # Must initialise interactive reporter before local_test_context()
+  reporter <- get_reporter() %||% local_interactive_reporter()
+  local_test_context()
+
   frame <- caller_env()
 
+  test <- test_description()
   if (!is.null(test)) {
     reporter$start_test(context = reporter$.context, test = test)
     withr::defer(reporter$end_test(context = reporter$.context, test = test))
@@ -192,3 +188,30 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
 
   invisible(ok)
 }
+
+
+# Maintain a stack of descriptions
+local_description_push <- function(description, frame = caller_env()) {
+  check_string(description, call = frame)
+  local_description_set(c(the$description, description), frame = frame)
+}
+local_description_set <- function(
+  description = character(),
+  frame = caller_env()
+) {
+  check_character(description, call = frame)
+
+  old <- the$description
+  the$description <- description
+  withr::defer(the$description <- old, frame)
+
+  invisible(old)
+}
+
+test_description <- function() {
+  if (length(the$description) == 0) {
+    NULL
+  } else {
+    paste(the$description, collapse = " / ")
+  }
+}

R/testthat-package.R

@@ -19,7 +19,7 @@
 NULL
 
 the <- new.env(parent = emptyenv())
-
+the$description <- character()
 
 # The following block is used by usethis to automatically manage
 # roxygen namespace tags. Modify with care!