From bc5d676c89e42446b449c052a274065445df9cf7 Mon Sep 17 00:00:00 2001
From: Marco Colombo <mar.colombo13@gmail.com>
Date: Sun, 17 Nov 2024 12:56:31 +0100
Subject: [PATCH] Make accept_snapshot() work on filenames containing a dot
 (#1669)

This changes slightly the logic for matching file names:

- before if a file name was considered to be without extension, we would
add the `.md` and then compare it with the actual file names in the
`_snaps` directory. However, that would fail if the file contained dots,
as they would be considered to be a file extension: for them no `.md` was
added to their name, and therefore they would never match with the actual
files in the `_snaps` directory, so no update could ever succeed

- with this patch, we strip any `.md` or `.txt` extension from the file
names received by `snapshot_manage()`, and compare those with the actual
file names from the `_snaps` directory also without extension
---
 NEWS.md                                  |  3 +++
 R/snapshot-manage.R                      |  6 ++++--
 tests/testthat/_snaps/snapshot-manage.md | 16 ++++++++++++++++
 tests/testthat/test-snapshot-manage.R    |  9 +++++++++
 4 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 6304f6b78..0e19a8ce8 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -43,6 +43,9 @@
 * `with_mock()` and `local_mock()` have been unconditionally deprecated as
   they will no longer work in future versions of R (#1999).
 
+* `snapshot_accept()` now works also when the tested file contains dots in
+  the filename (@mcol #1669).
+
 # testthat 3.2.1
 
 * Fix incorrect format string detected by latest R-devel. Fix thanks to
diff --git a/R/snapshot-manage.R b/R/snapshot-manage.R
index afd1cbc29..769469ecf 100644
--- a/R/snapshot-manage.R
+++ b/R/snapshot-manage.R
@@ -161,9 +161,11 @@ snapshot_meta <- function(files = NULL, path = "tests/testthat") {
     files <- files[!is_dir]
 
     dirs <- substr(dirs, 1, nchar(dirs) - 1)
-    files <- ifelse(tools::file_ext(files) == "", paste0(files, ".md"), files)
+    files <- gsub("\\.md|\\.txt$", "", files)
 
-    out <- out[out$name %in% files | out$test %in% dirs, , drop = FALSE]
+    out_name_sans_ext <- tools::file_path_sans_ext(out$name)
+    out <- out[out_name_sans_ext %in% files |
+               out$test %in% dirs, , drop = FALSE]
   }
 
   out
diff --git a/tests/testthat/_snaps/snapshot-manage.md b/tests/testthat/_snaps/snapshot-manage.md
index 1a76f78af..685cfe8d9 100644
--- a/tests/testthat/_snaps/snapshot-manage.md
+++ b/tests/testthat/_snaps/snapshot-manage.md
@@ -38,6 +38,22 @@
       Updating snapshots:
       * test/a.txt
 
+---
+
+    Code
+      snapshot_accept("test/c.d.md", path = path)
+    Message
+      Updating snapshots:
+      * test/c.d.md
+
+---
+
+    Code
+      snapshot_accept("test/c.d", path = path)
+    Message
+      Updating snapshots:
+      * test/c.d.md
+
 # can work with variants
 
     Code
diff --git a/tests/testthat/test-snapshot-manage.R b/tests/testthat/test-snapshot-manage.R
index 4c7930642..ab943f1e5 100644
--- a/tests/testthat/test-snapshot-manage.R
+++ b/tests/testthat/test-snapshot-manage.R
@@ -21,6 +21,15 @@ test_that("can accept specific files", {
   expect_snapshot(snapshot_accept("test/", path = path))
   expect_equal(dir(file.path(path, "_snaps"), recursive = TRUE), "test/a.txt")
 
+  ## file names with dots
+  path <- local_snapshot_dir(c("test/c.d.md", "test/c.d.new.md"))
+  expect_snapshot(snapshot_accept("test/c.d.md", path = path))
+  expect_equal(dir(file.path(path, "_snaps"), recursive = TRUE), "test/c.d.md")
+
+  path <- local_snapshot_dir(c("test/c.d.md", "test/c.d.new.md"))
+  expect_snapshot(snapshot_accept("test/c.d", path = path))
+  expect_equal(dir(file.path(path, "_snaps"), recursive = TRUE), "test/c.d.md")
+
 })
 
 test_that("can work with variants", {