Log vdiffr failures

Author: lionel-

R/testthat-ui.R

@@ -80,10 +80,12 @@ expect_doppelganger <- function(title,
 
   testthat::local_edition(3)
 
+  file <- paste0(fig_name, ".svg")
+
   withCallingHandlers(
     testthat::expect_snapshot_file(
       testcase,
-      name = paste0(fig_name, ".svg"),
+      name = file,
       binary = FALSE,
       cran = FALSE
     ),
@@ -94,9 +96,34 @@ expect_doppelganger <- function(title,
           "i" = "Please update your snapshots."
         ))
       }
+
+      if (!is.null(snapshotter <- get_snapshotter())) {
+        path_old <- snapshot_path(snapshotter, file)
+        path_new <- snapshot_path(snapshotter, paste0(fig_name, ".new.svg"))
+
+        if (all(file.exists(path_old, path_new))) {
+          push_log(fig_name, path_old, path_new)
+        }
+      }
     }
   )
+}
+
+# From testthat
+get_snapshotter <- function() {
+  x <- getOption("testthat.snapshotter")
+  if (is.null(x)) {
+    return()
+  }
 
+  if (!x$is_active()) {
+    return()
+  }
+
+  x
+}
+snapshot_path <- function(snapshotter, file) {
+  file.path(snapshotter$snap_dir, snapshotter$file, file)
 }
 
 is_graphics_engine_stale <- function() {
@@ -112,10 +139,13 @@ str_standardise <- function(s, sep = "-") {
 }
 
 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 (is_null(snapshotter <- get_snapshotter())) {
+    return(FALSE)
+  }
 
+  file <- paste0(str_standardise(title), ".svg")
+  path <- snapshot_path(snapshotter, file)
+  
   if (!file.exists(path)) {
     return(FALSE)
   }

R/utils.R

@@ -12,3 +12,65 @@ paste_line <- function(..., trailing = FALSE) {
   }
   lines
 }
+
+push_log <- function(name, old_path, new_path) {
+  log_path <- Sys.getenv("VDIFFR_LOG_PATH")
+
+  # If no envvar is set, check if we are running under R CMD check. In
+  # that case, always push a log file.
+  if (!nzchar(log_path)) {
+    if (!is_checking_remotely()) {
+      return(invisible(FALSE))
+    }
+    log_path <- testthat::test_path("..", "vdiffr.Rout.fail")
+  }
+
+  log_exists <- file.exists(log_path)
+
+  file <- file(log_path, "a")
+  on.exit(close(file))
+
+  if (!log_exists) {
+    cat_line(
+      file = file,
+      "Environment:",
+      vdiffr_info(),
+      ""
+    )
+  }
+
+  diff_lines <- diff_lines(name, old_path, new_path)
+  cat_line(file = file, "", !!!diff_lines, "")
+}
+is_checking_remotely <- function() {
+  nzchar(Sys.getenv("CI")) || !nzchar(Sys.getenv("NOT_CRAN"))
+}
+
+diff_lines <- function(name,
+                       before_path,
+                       after_path) {
+  before <- readLines(before_path)
+  after <- readLines(after_path)
+
+  diff <- diffobj::diffChr(
+    before,
+    after,
+    format = "raw",
+    # For reproducibility
+    disp.width = 80
+  )
+  lines <- as.character(diff)
+
+  paste_line(
+    glue("Failed doppelganger: {name} ({before_path})"),
+    "",
+    !!!lines
+  )
+}
+
+vdiffr_info <- function() {
+  glue(
+    "- vdiffr-svg-engine: { SVG_ENGINE_VER }
+     - vdiffr: { utils::packageVersion('vdiffr') }"
+  )
+}

tests/testthat/test-log.R

@@ -0,0 +1,31 @@
+vdiffr_skip_stale()
+
+test_that("Failures are logged", {
+  reporter <- testthat::SilentReporter$new()
+
+  path <- create_mock_pkg()
+  vars <- c("CI" = "true")
+  suppressMessages(withr::with_envvar(vars,
+    testthat::test_dir(
+      file.path(path, "tests", "testthat"),
+      reporter = reporter,
+      stop_on_failure = FALSE,
+      stop_on_warning = FALSE
+    )
+  ))
+
+  log_path <- file.path(path, "tests", "vdiffr.Rout.fail")
+  if (!file.exists(log_path)) {
+    abort("Can't find log.")
+  }
+
+  on.exit(file.remove(log_path))
+
+  log <- readLines(log_path)
+  
+  results <- reporter$expectations()
+  n_expected <- sum(purrr::map_lgl(results, inherits, "expectation_failure"))
+
+  n_logged <- length(grep("Failed doppelganger:", log))
+  expect_equal(n_logged, n_expected)
+})