Merge branch 'main' into subtests

Author: hadley

NEWS.md

@@ -1,6 +1,7 @@
 # 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).
+* 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).
 * Power `expect_mapequal()` with `waldo::compare(list_as_map = TRUE)` (#1521).

R/source.R

@@ -5,7 +5,9 @@
 #' @param path Path to files.
 #' @param pattern Regular expression used to filter files.
 #' @param env Environment in which to evaluate code.
-#' @param desc If not-`NULL`, will run only test with this `desc`ription.
+#' @param 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.
 #' @param chdir Change working directory to `dirname(path)`?
 #' @param wrap Automatically wrap all code within [test_that()]? This ensures
 #'   that all expectations are reported, even if outside a test block.
@@ -26,6 +28,7 @@ source_file <- function(
   if (!is.environment(env)) {
     stop_input_type(env, "an environment", call = error_call)
   }
+  check_character(desc, allow_null = TRUE)
 
   lines <- brio::read_lines(path)
   srcfile <- srcfilecopy(
@@ -73,50 +76,40 @@ source_file <- function(
   }
 }
 
-filter_desc <- function(exprs, desc = NULL, error_call = caller_env()) {
-  if (is.null(desc)) {
+filter_desc <- function(exprs, descs, error_call = caller_env()) {
+  if (length(descs) == 0) {
     return(exprs)
   }
+  desc <- descs[[1]]
 
-  found <- FALSE
-  include <- rep(FALSE, length(exprs))
+  subtest_idx <- which(unname(map_lgl(exprs, is_subtest)))
 
-  for (i in seq_along(exprs)) {
-    expr <- exprs[[i]]
-
-    if (!is_call(expr, c("test_that", "describe"), n = 2)) {
-      if (!found) {
-        include[[i]] <- TRUE
-      }
-    } else {
-      if (!is_string(expr[[2]])) {
-        next
-      }
-
-      test_desc <- as.character(expr[[2]])
-      if (test_desc != desc) {
-        next
-      }
-
-      if (found) {
-        cli::cli_abort(
-          "Found multiple tests with specified description.",
-          call = error_call
-        )
-      }
-      include[[i]] <- TRUE
-      found <- TRUE
-    }
-  }
-
-  if (!found) {
+  matching_idx <- keep(subtest_idx, \(idx) exprs[[idx]][[2]] == desc)
+  if (length(matching_idx) == 0) {
     cli::cli_abort(
-      "Failed to find test with specified description.",
+      "Failed to find test with description {.str {desc}}.",
+      call = error_call
+    )
+  } else if (length(matching_idx) > 1) {
+    cli::cli_abort(
+      "Found multiple tests with description {.str {desc}}.",
       call = error_call
     )
   }
 
-  exprs[include]
+  # Want all code up to and including the matching test, except for subtests
+  keep_idx <- setdiff(seq2(1, matching_idx), setdiff(subtest_idx, matching_idx))
+  # Recursively inspect the components of the subtest
+  exprs[[matching_idx]][[3]] <- filter_desc(
+    exprs[[matching_idx]][[3]],
+    descs[-1],
+    error_call = error_call
+  )
+  exprs[keep_idx]
+}
+
+is_subtest <- function(expr) {
+  is_call(expr, c("test_that", "describe", "it"), n = 2) && is_string(expr[[2]])
 }
 
 #' @rdname source_file

tests/testthat/_snaps/source.md

@@ -26,14 +26,6 @@
       Error:
       ! `env` must be an environment, not the string "x".
 
-# can find only matching test
-
-    Code
-      filter_desc(code, "baz")
-    Condition
-      Error:
-      ! Failed to find test with specified description.
-
 # preserve srcrefs
 
     Code
@@ -43,11 +35,16 @@
             # this is a comment
           }))
 
-# errors if duplicate labels
+# errors if zero or duplicate labels
 
     Code
       filter_desc(code, "baz")
     Condition
       Error:
-      ! Found multiple tests with specified description.
+      ! Found multiple tests with description "baz".
+    Code
+      filter_desc(code, "missing")
+    Condition
+      Error:
+      ! Failed to find test with description "missing".
 

tests/testthat/test-source.R

@@ -82,20 +82,54 @@ test_that("checks its inputs", {
   })
 })
 
+# filter_desc -------------------------------------------------------------
 
-# filter_label -------------------------------------------------------------
+test_that("works with all tests types", {
+  code <- exprs(
+    test_that("foo", {}),
+    describe("bar", {}),
+    it("baz", {})
+  )
+  expect_equal(filter_desc(code, "foo"), code[1])
+  expect_equal(filter_desc(code, "bar"), code[2])
+  expect_equal(filter_desc(code, "baz"), code[3])
+})
 
-test_that("can find only matching test", {
+test_that("only returns code before subtest", {
   code <- exprs(
     f(),
-    test_that("foo", {}),
+    describe("foo", {}),
     g(),
-    describe("bar", {}),
     h()
   )
   expect_equal(filter_desc(code, "foo"), code[c(1, 2)])
-  expect_equal(filter_desc(code, "bar"), code[c(1, 3, 4)])
-  expect_snapshot(filter_desc(code, "baz"), error = TRUE)
+})
+
+test_that("can select recursively", {
+  code <- exprs(
+    x <- 1,
+    describe("a", {
+      y <- 1
+      describe("b", {
+        z <- 1
+      })
+      y <- 2
+    }),
+    x <- 2
+  )
+
+  expect_equal(
+    filter_desc(code, c("a", "b")),
+    exprs(
+      x <- 1,
+      describe("a", {
+        y <- 1
+        describe("b", {
+          z <- 1
+        })
+      })
+    )
+  )
 })
 
 test_that("preserve srcrefs", {
@@ -110,16 +144,18 @@ test_that("preserve srcrefs", {
   expect_snapshot(filter_desc(code, "foo"))
 })
 
-
-test_that("errors if duplicate labels", {
+test_that("errors if zero or duplicate labels", {
   code <- exprs(
     f(),
     test_that("baz", {}),
     test_that("baz", {}),
     g()
   )
 
-  expect_snapshot(filter_desc(code, "baz"), error = TRUE)
+  expect_snapshot(error = TRUE, {
+    filter_desc(code, "baz")
+    filter_desc(code, "missing")
+  })
 })
 
 test_that("source_dir()", {