Reliable nested subtests (#2193)

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
* Dropped `test_code()` braces check since it no longer seems needed and makes all the functions exactly the same.

Fixes #2063. Fixes #2188.

Author: hadley

NEWS.md

@@ -1,5 +1,7 @@
 # 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).
 * 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).

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())
 }

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)
 

R/reporter-stop.R

@@ -45,26 +45,25 @@ 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) {
         if (self$praise && self$n_success > 0) {
           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)
       }
     }
   )

R/test-that.R

@@ -37,16 +37,7 @@ 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, env = parent.frame())
+  test_code(code, parent.frame())
 }
 
 # Access error fields with `[[` rather than `$` because the
@@ -64,6 +55,15 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) {
     withr::defer(reporter$end_test(context = reporter$.context, test = test))
   }
 
+  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
 
   # @param debug_end How many frames should be skipped to find the
@@ -88,13 +88,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 +104,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 +138,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 +163,8 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) {
       withCallingHandlers(
         {
           eval(code, test_env)
-          if (!handled && !is.null(test)) {
+          new_expectations <- the$test_expectations > starting_expectations
+          if (!new_expectations && skip_on_empty) {
             skip_empty()
           }
         },

R/testthat-package.R

@@ -20,6 +20,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!

man/source_file.Rd

@@ -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.
 

tests/testthat/_snaps/reporter-stop.md

@@ -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

tests/testthat/test-describe.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"))
 })