Support selection of nested subtests (#2077)

Fixes #2077

Co-authored-by: Hadley Wickham <h.wickham@gmail.com>

Author: kubajal

NEWS.md

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