Skip stale snapshots

Author: lionel-

R/testthat-ui.R

@@ -80,12 +80,23 @@ expect_doppelganger <- function(title,
 
   testthat::local_edition(3)
 
-  testthat::expect_snapshot_file(
-    testcase,
-    name = paste0(fig_name, ".svg"),
-    binary = FALSE,
-    cran = FALSE
+  withCallingHandlers(
+    testthat::expect_snapshot_file(
+      testcase,
+      name = paste0(fig_name, ".svg"),
+      binary = FALSE,
+      cran = FALSE
+    ),
+    expectation_failure = function(cnd) {
+      if (is_snapshot_stale(title, testcase)) {
+        testthat::skip(paste_line(
+          "SVG snapshot generated under a different vdiffr version.",
+          "i" = "Please update your snapshots."
+        ))
+      }
+    }
   )
+
 }
 
 is_graphics_engine_stale <- function() {
@@ -99,3 +110,33 @@ str_standardise <- function(s, sep = "-") {
   s <- gsub(paste0("^", sep, "|", sep, "$"), "", s)
   s
 }
+
+is_snapshot_stale <- function(title, testcase) {
+  ctxt <- testthat::get_reporter()$.context
+  file <- paste0(str_standardise(title), ".svg")
+  path <- testthat::test_path("_snaps", ctxt, file)
+
+  if (!file.exists(path)) {
+    return(FALSE)
+  }
+
+  lines <- readLines(path)
+
+  match <- regexec(
+    "data-engine-version='([0-9.]+)'",
+    lines
+  )
+  match <- Filter(length, regmatches(lines, match))
+
+  # Old vdiffr snapshot that doesn't embed a version
+  if (!length(match)) {
+    return(TRUE)
+  }
+
+  if (length(match) > 1) {
+    abort("Found multiple vdiffr engine versions in SVG snapshot.")
+  }
+
+  snapshot_version <- match[[1]][[2]]
+  svg_engine_ver() != snapshot_version
+}

tests/testthat/_snaps/expectations/stale-snapshots-are-skipped.svg

@@ -0,0 +1,3 @@
+regenerate_snapshots <- function() {
+  FALSE
+}

tests/testthat/helper-vdiffr.R

@@ -26,16 +26,27 @@ test_that("grid doppelgangers pass", {
   expect_doppelganger("Grid doppelganger", p_grid)
 })
 
-skip("TODO")
-
-test_that("skip mismatches if vdiffr is stale", {
-  withr::local_envvar(c(NOT_CRAN = "true"))
-  mock_dir <- create_mock_pkg("mock-pkg-skip-stale")
-
-  mock_test_dir <- file.path(mock_dir, "tests", "testthat")
-  test_results <- testthat::test_dir(mock_test_dir, reporter = "silent")
-  result <- test_results[[1]]$results[[1]]
+test_that("stale snapshots are skipped", {
+  plot <- ggplot2::ggplot() + ggplot2::labs()
+  title <- "stale snapshots are skipped"
+  new_path <- test_path("_snaps", "expectations", "stale-snapshots-are-skipped.new.svg")
+
+  if (regenerate_snapshots()) {
+    expect_doppelganger(title, plot)
+
+    # Update engine field to a stale version
+    file <- new_path
+    if (!file.exists(file)) {
+      file <- test_path("_snaps", "expectations", "stale-snapshots-are-skipped.svg")
+    }
+    lines <- readLines(file)
+    lines <- sub("data-engine-version='[0-9.]+'", "data-engine-version='0.1'", lines)
+    writeLines(lines, file)
+
+    return()
+  }
 
-  expect_is(result, "expectation_skip")
-  expect_match(result$message, "The vdiffr engine is too old")
+  cnd <- catch_cnd(expect_doppelganger(title, plot))
+  expect_s3_class(cnd, "skip")
+  file.remove(new_path)
 })