Implemented selection of deeply nested tests

Author: kubajal

R/source.R

@@ -73,43 +73,59 @@ filter_desc <- function(exprs, desc = NULL, error_call = caller_env()) {
   if (is.null(desc)) {
     return(exprs)
   }
+  desc_levels <- if (is.list(desc)) {
+    desc
+  } else {
+    as.list(desc)
+  }
 
-  found <- FALSE
-  include <- rep(FALSE, length(exprs))
-
-  for (i in seq_along(exprs)) {
-    expr <- exprs[[i]]
-
-    if (!is_call(expr, c("test_that", "describe"), n = 2)) {
-      if (!found) {
-        include[[i]] <- TRUE
-      }
+  find_matching_expr <- function(exprs, queue) {
+    if (length(queue) == 0) {
+      exprs
     } else {
-      if (!is_string(expr[[2]])) {
-        next
-      }
-
-      test_desc <- as.character(expr[[2]])
-      if (test_desc != desc) {
-        next
-      }
-
-      if (found) {
+      found <- FALSE
+      include <- rep(FALSE, length(exprs))
+      desc <- queue[[1]]
+
+      for (i in seq_along(exprs)) {
+        expr <- exprs[[i]]
+
+        if (!is_call(expr, c("test_that", "describe", "it"), 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) {
         abort(
           "Found multiple tests with specified description",
           call = error_call
         )
+          }
+          include[[i]] <- TRUE
+          found <- TRUE
+          exprs[[i]][[3]] <- {
+            find_matching_expr(expr[[3]], queue[-1])
+          }
+        }
       }
-      include[[i]] <- TRUE
-      found <- TRUE
-    }
-  }
 
-  if (!found) {
-    abort("Failed to find test with specified description", call = error_call)
-  }
+      if (!found) {
+        abort("Failed to find test with specified description", call = error_call)
+      }
 
-  exprs[include]
+      exprs[include]
+    }
+  }
+  find_matching_expr(exprs, desc_levels)
 }
 
 #' @rdname source_file

tests/testthat/test-source.R

@@ -137,3 +137,70 @@ test_that("source_dir()", {
   )
   expect_equal(res[[1]](), "Hello World")
 })
+
+test_that("you can select deeply nested describe(...)", {
+  code <- exprs(
+    f(),
+    describe("level 0", {
+      g()
+      describe("level 1 A", {
+        h()
+        describe("level 2 A", {
+          i()
+          it("level 3 A", {
+            j()
+            expect_equal(1, 1)
+            k()
+          })
+          l()
+        })
+        m()
+        describe("level 2 B", {
+          n()
+          it("level 3 B", {
+            o()
+            expect_equal(1, 1)
+            p()
+          })
+          r()
+        })
+        s()
+        describe("level 2 C", {
+          expect_equal(1, 1)
+        })
+        t()
+      })
+      u()
+      describe("level 1 B", {})
+      v()
+    }),
+    x()
+  )
+
+  expected <- exprs(
+    f(),
+    describe("level 0", {
+      g()
+      describe("level 1 A", {
+        h()
+        m()
+        describe("level 2 B", {
+          n()
+          it("level 3 B", {
+            o()
+            expect_equal(1, 1)
+            p()
+          })
+          r()
+        })
+        s()
+        t()
+      })
+      u()
+      v()
+    }),
+    x()
+  )
+
+  expect_equal(filter_desc(code, c("level 0", "level 1 A", "level 2 B")), expected)
+})