Provide optional recursive argument to test_dir()

[s-fleck]

Would it be possible to add a recursive argument to test_dir() so that it (optionally) also looks for test files in sub-directories?

Motivation:
I have a workflow where I put long running tests - or tests that needs stuff like database access - in subfolders of the /test directory. This works really well as they are not automatically executed by devtools::test(), but I can still manually trigger them. I even made a package to support this worklfow (testthis).

Now if I want to run all tests in a directory and it's subdirectories at once, I have to resort to some really ugly code where i just use with_mock to override the test file discovery of testthat:

  testthat::with_mock(
    devtools::test(...),
    `testthat::find_test_scripts` = find_test_scripts_mock
  )

I'd really love to be able to remove this abomination from my package, especially since with_mock() is deprecated.

[hadley]

I'd be happy to review a PR that implemented this.

[radbasa]

Hello @hadley , I submitted a PR #1850 that gives test_dir() the optional ability to recurse through nested test directories. Would you mind taking a look?

[hadley]

@radbasa thanks! I'll take a look when I'm next working on testthat.

[SaintRod]

Hello, all:

I'm adding support for this idea from a non-package perspective. I'm developing something that isn't a package, instead it uses box and modules.

I know testthat focuses on R packages, but testthat also works well with box. Adding a recursive argument to test_dir would be awesome and would greatly enhance the functionality between testthat and box.

For example. I've structured my tests to mirror the workflow, that is test files within sub-directories within ./tests/testthat/. With recursive = TRUE testing the modules would be a breeze.

./tests/testthat
├── eda
├── logistics
│   ├── test-logistics-a.R
│   ├── test-logistics-b.R
│   ├── test-logistics-c.R
│   ├── test-logistics-d.R
│   └── test-logistics-e.R
└── modeling

Thanks!

[king-of-poppk]

@SaintRod Here is my take at supporting box (so subdirs in sources, instead of subdirs in tests as in the OP):

.testRegExp <- "^test-.*\\.[rR]$"

.relativeTo <- function(root, path) {
  substr(path, nchar(root) + 2, nchar(path))
}

.maybeRelativeTo <- function(root, path) {
  ifelse(
    startsWith(path, root),
    .relativeTo(root, path),
    path
  )
}

purge_cache <- function() { # nolint: object_name_linter
  eapply(box:::loaded_mods, function(mod_ns) { # nolint: object_name_linter
    box:::call_hook(mod_ns, ".on_unload", mod_ns)
  }, all.names = TRUE)
  rm(list = names(box:::loaded_mods), envir = box:::loaded_mods)
}

.source_dir <- function( # nolint: object_name_linter
                        path,
                        pattern = "\\.[rR]$",
                        env = test_env(),
                        chdir = TRUE,
                        wrap = TRUE) {
  purge_cache()
}


withCallingHandlers(
  testthat::with_mock(
    testthat::auto_test("src", "tests/testthat"),
    `testthat::auto_test` = function(codePath,
                                     testPath,
                                     reporter = testthat:::default_reporter(),
                                     env = testthat:::test_env(),
                                     hash = TRUE,
                                     source_dir = .source_dir # nolint: object_name_linter
    ) {
      reporter <- testthat:::find_reporter(reporter)
      root <- normalizePath(".")
      codePath <- normalizePath(codePath)
      testPath <- normalizePath(testPath)

      # Start by loading all code and running all tests
      source_dir(codePath, env = env)
      testthat::test_dir(
        testPath,
        env = env,
        reporter = reporter$clone(deep = TRUE),
        stop_on_failure = FALSE,
        stop_on_warning = FALSE
      )

      # Next set up watcher to monitor changes
      watcher <- function(added, deleted, modified) {
        allTriggers <- normalizePath(c(added, deleted, modified))

        testsAndHelpers <- .relativeTo(testPath, allTriggers[
          testthat:::starts_with(allTriggers, testPath)
        ])
        code <- .maybeRelativeTo(root, allTriggers[
          testthat:::starts_with(allTriggers, codePath)
        ])

        .isTest <- grepl(.testRegExp, basename(testsAndHelpers))
        .testsTriggers <- normalizePath(c(added, modified))
        tests <- testsAndHelpers[.isTest & allTriggers %in% .testsTriggers]
        helpers <- testsAndHelpers[!.isTest]
        nonTests <- c(code, helpers)

        if (length(nonTests) >= 1) {
          # Rerun all tests
          if (length(code) >= 1) {
            cat(
              "Changed code: ",
              paste0(code, collapse = ", "),
              "\n"
            )
          }
          if (length(helpers) >= 1) {
            cat(
              "Changed helpers: ",
              paste0(helpers, collapse = ", "),
              "\n"
            )
          }
          if (length(code) >= 1) {
            cat("Reloading code\n")
            source_dir(codePath, env = env)
          }
          cat("Rerunning all tests\n")
          testthat::test_dir(
            testPath,
            env = env,
            reporter = reporter$clone(deep = TRUE),
            stop_on_failure = FALSE,
            stop_on_warning = FALSE
          )
        } else if (length(tests) >= 1) {
          # Rerun added or changed tests
          cat(
            "Rerunning tests: ", paste0(tests, collapse = ", "), "\n"
          )
          testthat:::test_files(
            test_dir = testPath,
            test_paths = tests,
            test_package = NULL,
            env = env,
            reporter = reporter$clone(deep = TRUE),
            stop_on_failure = FALSE,
            stop_on_warning = FALSE
          )
        }

        TRUE
      }
      watch(c(codePath, testPath), watcher, hash = hash)
    },
    `testthat:::dir_state` = function(path, pattern = NULL, hash = TRUE) {
      files <- list.files(path, pattern, full.names = TRUE, recursive = TRUE)
      if (hash) {
        fileStates <- vapply(files, testthat:::safe_digest, character(1))
      } else {
        fileStates <- stats::setNames(file.info(files)$mtime, files)
      }
      fileStates[!is.na(fileStates)]
    },
    `testthat::find_test_scripts` = function(path,
                                             filter = NULL,
                                             invert = FALSE,
                                             ...,
                                             full.names = TRUE, # nolint: object_name_linter
                                             start_first = NULL # nolint: object_name_linter
    ) {
      files <- list.files(
        path, .testRegExp,
        full.names = TRUE, recursive = TRUE
      )
      files <- lapply(files, \(filepath) .maybeRelativeTo(path, filepath))
      files <- testthat:::filter_test_scripts(files, filter, invert, ...)
      testthat:::order_test_scripts(files, start_first)
    }
  ),
  warning = \(cond) {
    if (
      startsWith(
        cond$message,
        "`with_mock()` was deprecated "
      )
    ) {
      invokeRestart("muffleWarning")
    }
  }
)