Teach test_active_file() about snapshot files (#2666)

* Teach `test_active_file()` about snapshot files

* Add news bullet

* Small tweaks

---------

Co-authored-by: Jenny Bryan <jenny.f.bryan@gmail.com>

Author: hadley

NEWS.md

@@ -12,6 +12,7 @@
 * `load_all()` now errors if called recursively, i.e. if you accidentally include a `load_all()` call in one of your R source files (#2617).
 * `release()` is deprecated in favour of `usethis::use_release_issue()`.
 * `show_news()` now looks for NEWS files in the same locations as `utils::news()`: `inst/NEWS.Rd`, `NEWS.md`, `NEWS`, and `inst/NEWS` (@arcresu, #2499).
+* `test_active_file()` now works when the active file is a snapshot file.
 * `test_coverage()` and `test_coverage_active_file()` gain a new `report` argument that can be set to `"html"` (the default, for an interactive browser report), `"zero"` (prints uncovered lines to the console, used for LLMs and non-interactive contexts), or `"silent"`. The `show_report` argument has been removed (#2632).
 * `test_file()` and `test_coverage_file()` are now defunct. These were deprecated in devtools 2.4.0 (2021-04-07) in favour of `test_active_file()` and `test_coverage_active_file()`. Removing `test_file()` eliminates the conflict with `testthat::test_file()`.
 

R/active.R

@@ -37,6 +37,8 @@ find_test_file <- function(path, call = parent.frame()) {
 
 test_file_type <- function(path) {
   dir <- path_file(path_dir(path))
+  # this accounts for snapshot files in a variant subfolder
+  parent_dir <- path_file(path_dir(path_dir(path)))
   name <- path_file(path)
   ext <- tolower(path_ext(path))
 
@@ -46,6 +48,8 @@ test_file_type <- function(path) {
   type[dir == "R" & ext == "r"] <- "R"
   type[dir == "testthat" & ext == "r" & grepl("^test", name)] <- "test"
   type[dir == "src" & ext %in% src_ext] <- "src"
+  type[dir == "_snaps" & ext == "md"] <- "snap"
+  type[parent_dir == "_snaps" & ext == "md"] <- "snap"
   type
 }
 

tests/testthat/test-active.R

@@ -12,6 +12,30 @@ test_that("fails if can't find tests", {
   })
 })
 
+test_that("find_test_file() works with snapshot files", {
+  dir <- local_package_create()
+  withr::local_dir(dir)
+
+  dir_create("tests/testthat/_snaps")
+  file_create("tests/testthat/test-foo.R")
+  file_create("tests/testthat/_snaps/foo.md")
+
+  path <- find_test_file("tests/testthat/_snaps/foo.md")
+  expect_equal(path_file(path), "test-foo.R")
+})
+
+test_that("find_test_file() works with snapshot variant files", {
+  dir <- local_package_create()
+  withr::local_dir(dir)
+
+  dir_create("tests/testthat/_snaps/variant")
+  file_create("tests/testthat/test-foo.R")
+  file_create("tests/testthat/_snaps/variant/foo.md")
+
+  path <- find_test_file("tests/testthat/_snaps/variant/foo.md")
+  expect_equal(path_file(path), "test-foo.R")
+})
+
 test_that("can determine file type", {
   expect_equal(test_file_type("R/foo.R"), "R")
   expect_equal(test_file_type("R/foo.c"), NA_character_)
@@ -23,5 +47,9 @@ test_that("can determine file type", {
   expect_equal(test_file_type("tests/testthat/test-foo.c"), NA_character_)
   expect_equal(test_file_type("tests/testthat/foo.R"), NA_character_)
 
+  expect_equal(test_file_type("tests/testthat/_snaps/foo.md"), "snap")
+  expect_equal(test_file_type("tests/testthat/_snaps/variant/foo.md"), "snap")
+  expect_equal(test_file_type("tests/testthat/_snaps/foo.R"), NA_character_)
+
   expect_equal(test_file_type("DESCRIPTION"), NA_character_)
 })