From be580063df4f48cbce3e643b300c1b7f8049f36e Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Thu, 31 Jul 2025 14:12:33 -0500
Subject: [PATCH] Add more functions to `reparse()`

Fixes #1678. Fixes #2042.
---
 NEWS.md                              |  1 +
 R/snapshot-value.R                   | 49 ++++++++--------------------
 tests/testthat/test-snapshot-value.R |  2 ++
 3 files changed, 16 insertions(+), 36 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index bf297564e..33f1d552e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `expect_snapshot_value()` can now handle expressions that generate `-` (#1678) or zero length atomic vectors (#2042).
 * `expect_matches()` failures should be a little easier to read (#2135).
 * New `local_on_cran(TRUE)` allows you to simulate how your tests will run on CRAN (#2112).
 * `expect_no_*()` now executes the entire code block, rather than stopping at the first message or warning (#1991).
diff --git a/R/snapshot-value.R b/R/snapshot-value.R
index 339e2e694..9b9587de3 100644
--- a/R/snapshot-value.R
+++ b/R/snapshot-value.R
@@ -77,43 +77,20 @@ expect_snapshot_value <- function(
 # Safe environment for evaluating deparsed objects, based on inspection of
 # https://github.com/wch/r-source/blob/5234fe7b40aad8d3929d240c83203fa97d8c79fc/src/main/deparse.c#L845
 reparse <- function(x) {
-  env <- env(
-    emptyenv(),
-    `-` = `-`,
-    c = c,
-    list = list,
-    quote = quote,
-    structure = structure,
-    expression = expression,
-    `function` = `function`,
-    new = methods::new,
-    getClass = methods::getClass,
-    pairlist = pairlist,
-    alist = alist,
-    as.pairlist = as.pairlist
-  )
-
-  eval(parse(text = x), env)
-}
-
-# Safe environment for evaluating deparsed objects, based on inspection of
-# https://github.com/wch/r-source/blob/5234fe7b40aad8d3929d240c83203fa97d8c79fc/src/main/deparse.c#L845
-reparse <- function(x) {
-  env <- env(
-    emptyenv(),
-    `-` = `-`,
-    c = c,
-    list = list,
-    quote = quote,
-    structure = structure,
-    expression = expression,
-    `function` = `function`,
-    new = methods::new,
-    getClass = methods::getClass,
-    pairlist = pairlist,
-    alist = alist,
-    as.pairlist = as.pairlist
+  env <- env(emptyenv())
+  env_bind(
+    env,
+    !!!env_get_list(
+      base_env(),
+      c(
+        c("c", "structure", ":", "-"),
+        c("list", "numeric", "integer", "logical", "character"),
+        "function",
+        c("quote", "alist", "pairlist", "as.pairlist", "expression")
+      )
+    )
   )
+  env_bind(env, !!!env_get_list(ns_env("methods"), c("new", "getClass")))
 
   eval(parse(text = x), env)
 }
diff --git a/tests/testthat/test-snapshot-value.R b/tests/testthat/test-snapshot-value.R
index 96edbc06e..0e95acb2f 100644
--- a/tests/testthat/test-snapshot-value.R
+++ b/tests/testthat/test-snapshot-value.R
@@ -24,6 +24,8 @@ test_that("reparse handles common cases", {
   expect_equal(roundtrip(c(1, 2, 3)), c(1, 2, 3))
   expect_equal(roundtrip(list(1, 2, 3)), list(1, 2, 3))
   expect_equal(roundtrip(mtcars), mtcars)
+  expect_equal(roundtrip(1:10), 1:10)
+  expect_equal(roundtrip(numeric()), numeric())
 
   f <- function(x) x + 1
   expect_equal(roundtrip(f), f, ignore_function_env = TRUE)