Updated source code from rlib/testthat/main (#5)

Give test_dir() a recursive option (r-lib#1605)

The recursive argument allows test files in nested directories.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: testthat
 Title: Unit Testing for R
-Version: 3.1.10.9000
+Version: 3.1.10.9001
 Authors@R: c(
     person("Hadley", "Wickham", , "[email protected]", role = c("aut", "cre")),
     person("Posit Software, PBC", role = c("cph", "fnd")),

NEWS.md

@@ -13,6 +13,8 @@
 
 * `expect_setequal()` correctly displays results when only one of actual and
   expected is missing values (#1835).
+
+* `test_dir()` gains a `recursive` argument which allows test files in nested directories (#1605).
 
 # testthat 3.1.10
 

R/test-files.R

@@ -26,6 +26,7 @@
 #' @param stop_on_failure If `TRUE`, throw an error if any tests fail.
 #' @param stop_on_warning If `TRUE`, throw an error if any tests generate
 #'   warnings.
+#' @param recursive If `TRUE` Test that will search for test files in the nested directories.
 #' @param load_package Strategy to use for load package code:
 #'   * "none", the default, doesn't load the package.
 #'   * "installed", uses [library()] to load an installed package.
@@ -52,6 +53,7 @@ test_dir <- function(path,
                      stop_on_warning = FALSE,
                      wrap = lifecycle::deprecated(),
                      package = NULL,
+                     recursive = FALSE,
                      load_package = c("none", "installed", "source")
                      ) {
 
@@ -63,7 +65,8 @@ test_dir <- function(path,
     filter = filter,
     ...,
     full.names = FALSE,
-    start_first = start_first
+    start_first = start_first,
+    recursive = recursive
   )
   if (length(test_paths) == 0) {
     abort("No test files found")
@@ -380,8 +383,8 @@ local_teardown_env <- function(frame = parent.frame()) {
 #' @return A character vector of paths
 #' @keywords internal
 #' @export
-find_test_scripts <- function(path, filter = NULL, invert = FALSE, ..., full.names = TRUE, start_first = NULL) {
-  files <- dir(path, "^test.*\\.[rR]$", full.names = full.names)
+find_test_scripts <- function(path, filter = NULL, invert = FALSE, ..., full.names = TRUE, start_first = NULL, recursive = FALSE) {
+  files <- dir(path, "^test.*\\.[rR]$", full.names = full.names, recursive = recursive)
   files <- filter_test_scripts(files, filter, invert, ...)
   order_test_scripts(files, start_first)
 }

tests/testthat/_snaps/test-files.md

@@ -19,3 +19,24 @@
     16   test-helper.R                                       helper test  1      0   FALSE FALSE       0      1
     17     test-skip.R                                        Skips skip  1      0    TRUE FALSE       0      0
 
+# runs all tests in nested directories and records output
+
+                                file context                                      test nb failed skipped error warning passed
+    1    nested_folder/test-errors.R                                            simple  0      0   FALSE  TRUE       0      0
+    2    nested_folder/test-errors.R                                 after one success  1      0   FALSE  TRUE       0      1
+    3    nested_folder/test-errors.R                                 after one failure  1      1   FALSE  TRUE       0      0
+    4    nested_folder/test-errors.R                                       in the test  0      0   FALSE  TRUE       0      0
+    5    nested_folder/test-errors.R                                   in expect_error  1      0   FALSE FALSE       0      1
+    6  nested_folder/test-failures.R                                  just one failure  1      1   FALSE FALSE       0      0
+    7  nested_folder/test-failures.R                                one failure on two  2      1   FALSE FALSE       0      1
+    8  nested_folder/test-failures.R                                        no failure  2      0   FALSE FALSE       0      2
+    9      nested_folder/test-skip.R                                        Skips skip  1      0    TRUE FALSE       0      0
+    10                  test-basic.R                     logical tests act as expected  2      0   FALSE FALSE       0      2
+    11                  test-basic.R                   logical tests ignore attributes  2      0   FALSE FALSE       0      2
+    12                  test-basic.R                                    equality holds  2      0   FALSE FALSE       0      2
+    13                  test-basic.R         can't access variables from other tests 2  1      0    TRUE FALSE       0      0
+    14                  test-basic.R         can't access variables from other tests 1  1      0   FALSE FALSE       0      1
+    15                  test-empty.R                                        empty test  1      0    TRUE FALSE       0      0
+    16                  test-empty.R                             empty test with error  0      0   FALSE  TRUE       0      0
+    17                 test-helper.R                                       helper test  1      0   FALSE FALSE       0      1
+

tests/testthat/test-test-files.R

@@ -46,6 +46,17 @@ test_that("can control if warnings errors", {
   expect_error(test_warning(stop_on_warning = FALSE), NA)
 })
 
+test_that("runs all tests in nested directories and records output", {
+  withr::local_envvar(TESTTHAT_PARALLEL = "FALSE")
+  res <- test_dir(test_path("test_dir_recursive"), reporter = "silent", stop_on_failure = FALSE, recursive = TRUE)
+  df <- as.data.frame(res)
+  df$user <- df$system <- df$real <- df$result <- NULL
+
+  local_reproducible_output(width = 200)
+  local_edition(3)
+  expect_snapshot_output(print(df))
+})
+
 # test_file ---------------------------------------------------------------
 
 test_that("can test single file", {

tests/testthat/test_dir_recursive/helper_hello.R

@@ -0,0 +1 @@
+hello <- function() "Hello World"

tests/testthat/test_dir_recursive/nested_folder/test-errors.R

@@ -0,0 +1,22 @@
+test_that("simple", {
+  stop("argh")
+})
+
+test_that("after one success", {
+  expect_true(TRUE)
+  stop("argh")
+  expect_true(TRUE)
+})
+
+test_that("after one failure", {
+  expect_true(FALSE)
+  stop("argh")
+})
+
+test_that("in the test", {
+  expect_true(stop("Argh"))
+})
+
+test_that("in expect_error", {
+  expect_error(stop("Argh"))
+})

tests/testthat/test_dir_recursive/nested_folder/test-failures.R

@@ -0,0 +1,13 @@
+test_that("just one failure", {
+  expect_true(FALSE)
+})
+
+test_that("one failure on two", {
+  expect_false(FALSE)
+  expect_true(FALSE)
+})
+
+test_that("no failure", {
+  expect_false(FALSE)
+  expect_true(TRUE)
+})

tests/testthat/test_dir_recursive/nested_folder/test-skip.R

@@ -0,0 +1,4 @@
+test_that("Skips skip", {
+  skip("Skipping to avoid certain failure")
+  expect_true(FALSE)
+})

tests/testthat/test_dir_recursive/test-bare-expectations.R

@@ -0,0 +1 @@
+expect_equal(2, 2)

tests/testthat/test_dir_recursive/test-basic.R

@@ -0,0 +1,22 @@
+test_that("logical tests act as expected", {
+  expect_true(TRUE)
+  expect_false(FALSE)
+})
+
+test_that("logical tests ignore attributes", {
+  expect_true(c(a = TRUE))
+  expect_false(c(a = FALSE))
+})
+
+test_that("equality holds", {
+  expect_equal(5, 5)
+  expect_identical(10, 10)
+})
+
+test_that("can't access variables from other tests 2", {
+  a <- 10
+})
+
+test_that("can't access variables from other tests 1", {
+  expect_false(exists("a"))
+})

tests/testthat/test_dir_recursive/test-empty.R

@@ -0,0 +1,3 @@
+test_that("empty test", NULL)
+
+test_that("empty test with error", stop("Argh"))

tests/testthat/test_dir_recursive/test-helper.R

@@ -0,0 +1,4 @@
+# test that the companion helper script is sourced by test_dir
+test_that("helper test", {
+  expect_equal(hello(), "Hello World")
+})