Preserve snapshots for tests that were not run

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `test_file(desc = ...)` no longer loses snapshot results (#2066).
 * In `R CMD check`, snapshots now only advise on how to resolve failures once (#2207).
 * `snapshot_review()` includes a reject button and only displays the file navigation and the skip button if there are multiple files to review (#2025).
 * New `snapshot_download_gh()` makes it easy to get snapshots off GitHub and into your local package (#1779).

R/snapshot-reporter.R

@@ -10,14 +10,20 @@ SnapshotReporter <- R6::R6Class(
     snap_file_saved = character(),
     variants_changed = FALSE,
     fail_on_new = NULL,
+    desc = NULL,
 
     old_snaps = NULL,
     cur_snaps = NULL,
     new_snaps = NULL,
 
-    initialize = function(snap_dir = "_snaps", fail_on_new = NULL) {
+    initialize = function(
+      snap_dir = "_snaps",
+      fail_on_new = NULL,
+      desc = NULL
+    ) {
       self$snap_dir <- normalizePath(snap_dir, mustWork = FALSE)
       self$fail_on_new <- fail_on_new
+      self$desc <- desc
     },
 
     start_file = function(path, test = NULL) {
@@ -31,6 +37,22 @@ SnapshotReporter <- R6::R6Class(
       self$cur_snaps <- FileSnaps$new(self$snap_dir, self$file, type = "cur")
       self$new_snaps <- FileSnaps$new(self$snap_dir, self$file, type = "new")
 
+      if (!is.null(self$desc)) {
+        # When filtering tests, we need to copy over all of the old snapshots,
+        # apart from the one that matches the test
+        snaps <- self$old_snaps$snaps
+        test_name <- test_description(self$desc)
+        for (variant in names(snaps)) {
+          # In the case of subtests, snaps are named a / b / c1, a / b / c2 etc.
+          # So if we run a / b, we want to remove a / b, a / b / c, a / b / c2
+          # Subtests that use / in their names are not currently supported.
+          matches <- startsWith(names(snaps[[variant]]), test_name)
+          # Can't just remove because we want to preserve order
+          snaps[[variant]][matches] <- rep(list(NULL), sum(matches))
+        }
+        self$cur_snaps$snaps <- snaps
+      }
+
       if (!is.null(test)) {
         self$start_test(NULL, test)
       }
@@ -207,16 +229,30 @@ local_snapshotter <- function(
   reporter = SnapshotReporter,
   snap_dir = "_snaps",
   cleanup = FALSE,
+  desc = NULL,
   fail_on_new = NULL,
   frame = caller_env()
 ) {
-  reporter <- reporter$new(snap_dir = snap_dir, fail_on_new = fail_on_new)
+  reporter <- reporter$new(
+    snap_dir = snap_dir,
+    fail_on_new = fail_on_new,
+    desc = desc
+  )
   withr::local_options("testthat.snapshotter" = reporter, .local_envir = frame)
 
   reporter
 }
 
-local_test_snapshotter <- function(snap_dir = NULL, frame = caller_env()) {
+local_test_snapshotter <- function(
+  snap_dir = NULL,
+  desc = NULL,
+  frame = caller_env()
+) {
   snap_dir <- snap_dir %||% withr::local_tempdir(.local_envir = frame)
-  local_snapshotter(snap_dir = snap_dir, fail_on_new = FALSE, frame = frame)
+  local_snapshotter(
+    snap_dir = snap_dir,
+    desc = desc,
+    fail_on_new = FALSE,
+    frame = frame
+  )
 }

R/test-files.R

@@ -221,7 +221,7 @@ test_files_serial <- function(
   local_testing_env(env)
 
   test_files_setup_state(test_dir, test_package, load_helpers, env)
-  reporters <- test_files_reporter(reporter, "serial")
+  reporters <- test_files_reporter(reporter, "serial", desc = desc)
 
   with_reporter(
     reporters$multi,
@@ -318,6 +318,7 @@ test_files_setup_state <- function(
 test_files_reporter <- function(
   reporter,
   mode = c("serial", "parallel"),
+  desc = NULL,
   frame = caller_env()
 ) {
   mode <- arg_match(mode)
@@ -334,7 +335,12 @@ test_files_reporter <- function(
   } else {
     snap_base <- SnapshotReporter
   }
-  snap <- local_snapshotter(snap_base, fail_on_new = on_ci(), frame = frame)
+  snap <- local_snapshotter(
+    snap_base,
+    fail_on_new = on_ci(),
+    desc = desc,
+    frame = frame
+  )
 
   reporters <- compact(list(user, lister, snap))
   list(

R/test-that.R

@@ -216,10 +216,10 @@ local_description_set <- function(
   invisible(old)
 }
 
-test_description <- function() {
-  if (length(the$description) == 0) {
+test_description <- function(desc = the$description) {
+  if (length(desc) == 0) {
     NULL
   } else {
-    paste(the$description, collapse = " / ")
+    paste(desc, collapse = " / ")
   }
 }

tests/testthat/test-expect-inheritance.R

@@ -132,5 +132,6 @@ test_that("can check with actual class", {
 })
 
 test_that("expect_s7_class validates its inputs", {
+  skip_if_not_installed("S7")
   expect_snapshot(expect_s7_class(1, 1), error = TRUE)
 })

tests/testthat/test-snapshot-reporter.R

@@ -176,3 +176,33 @@ test_that("`expect_error()` can fail inside `expect_snapshot()`", {
   err <- out[[1]]$results[[1]]
   expect_match(err$message, "did not throw the expected error")
 })
+
+
+test_that("can filter with desc", {
+  path <- withr::local_tempdir()
+
+  # First record some results
+  suppressWarnings({
+    snapper <- local_test_snapshotter(snap_dir = path)
+    snapper$start_file("snapshot")
+    snapper$start_test(test = "x")
+    expect_snapshot_output(cat("x"))
+    snapper$end_test()
+    snapper$start_test(test = "y")
+    expect_snapshot_output(cat("y"))
+    snapper$end_test()
+    snapper$end_file()
+  })
+  snaps_all <- readLines(file.path(path, "snapshot.md"))
+
+  # Now pretend we just ran one
+  snapper <- local_test_snapshotter(snap_dir = path, desc = "x")
+  snapper$start_file("snapshot")
+  snapper$start_test(test = "x")
+  expect_snapshot_output(cat("x"))
+  snapper$end_test()
+  snapper$end_file()
+  snaps_filtered <- readLines(file.path(path, "snapshot.md"))
+
+  expect_equal(snaps_all, snaps_filtered)
+})