Skip to content

Commit 41a7148

Browse files
hadleyhadley
committed
Move expect_snapshot_value() to own file
1 parent cc4fb01 commit 41a7148

10 files changed

+241
-222
lines changed

‎R/snapshot-reporter.R

-22
Original file line numberDiff line numberDiff line change
@@ -159,28 +159,6 @@ SnapshotReporter <- R6::R6Class("SnapshotReporter",
159159
)
160160
)
161161

162-
163-
check_roundtrip <- function(x,
164-
y,
165-
label,
166-
style,
167-
...,
168-
tolerance = testthat_tolerance(),
169-
error_call = caller_env()) {
170-
check <- waldo_compare(x, y, x_arg = "original", y_arg = "new", ..., tolerance = tolerance)
171-
if (length(check) > 0) {
172-
abort(c(
173-
paste0("`", label, "` could not be safely serialized with `style = \"", style, "\"`."),
174-
" " = paste0(
175-
"Serializing then deserializing the object returned something new:\n\n",
176-
check, "\n"
177-
),
178-
i = "You may need to try a different `style`."),
179-
call = error_call
180-
)
181-
}
182-
}
183-
184162
# set/get active snapshot reporter ----------------------------------------
185163

186164
get_snapshotter <- function() {

‎R/snapshot-value.R

+130
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
#' Snapshot testing for values
2+
#'
3+
#' Captures the result of function, flexibly serializing it into a text
4+
#' representation that's stored in a snapshot file. See [expect_snapshot()]
5+
#' for more details on snapshot testing.
6+
#'
7+
#' @param style Serialization style to use:
8+
#' * `json` uses [jsonlite::fromJSON()] and [jsonlite::toJSON()]. This
9+
#' produces the simplest output but only works for relatively simple
10+
#' objects.
11+
#' * `json2` uses [jsonlite::serializeJSON()] and [jsonlite::unserializeJSON()]
12+
#' which are more verbose but work for a wider range of type.
13+
#' * `deparse` uses [deparse()], which generates a depiction of the object
14+
#' using R code.
15+
#' * `serialize()` produces a binary serialization of the object using
16+
#' [serialize()]. This is all but guaranteed to work for any R object,
17+
#' but produces a completely opaque serialization.
18+
#' @param ... Passed on to [waldo::compare()] so you can control the details of
19+
#' the comparison.
20+
#' @inheritParams expect_snapshot
21+
#' @inheritParams compare
22+
#' @export
23+
expect_snapshot_value <- function(x,
24+
style = c("json", "json2", "deparse", "serialize"),
25+
cran = FALSE,
26+
tolerance = testthat_tolerance(),
27+
...,
28+
variant = NULL) {
29+
edition_require(3, "expect_snapshot_value()")
30+
variant <- check_variant(variant)
31+
lab <- quo_label(enquo(x))
32+
33+
style <- arg_match(style)
34+
35+
save <- switch(style,
36+
json = function(x) jsonlite::toJSON(x, auto_unbox = TRUE, pretty = TRUE),
37+
json2 = function(x) jsonlite::serializeJSON(x, pretty = TRUE),
38+
deparse = function(x) paste0(deparse(x), collapse = "\n"),
39+
serialize = function(x) jsonlite::base64_enc(serialize(x, NULL, version = 2))
40+
)
41+
load <- switch(style,
42+
json = function(x) jsonlite::fromJSON(x, simplifyVector = FALSE),
43+
json2 = function(x) jsonlite::unserializeJSON(x),
44+
deparse = function(x) reparse(x),
45+
serialize = function(x) unserialize(jsonlite::base64_dec(x))
46+
)
47+
48+
with_is_snapshotting(force(x))
49+
check_roundtrip(
50+
x,
51+
load(save(x)),
52+
label = lab,
53+
style = style,
54+
tolerance = tolerance
55+
)
56+
57+
expect_snapshot_helper(lab, x,
58+
save = save,
59+
load = load,
60+
cran = cran,
61+
...,
62+
tolerance = tolerance,
63+
variant = variant,
64+
trace_env = caller_env()
65+
)
66+
}
67+
68+
# Safe environment for evaluating deparsed objects, based on inspection of
69+
# https://github.com/wch/r-source/blob/5234fe7b40aad8d3929d240c83203fa97d8c79fc/src/main/deparse.c#L845
70+
reparse <- function(x) {
71+
env <- env(emptyenv(),
72+
`-` = `-`,
73+
c = c,
74+
list = list,
75+
quote = quote,
76+
structure = structure,
77+
expression = expression,
78+
`function` = `function`,
79+
new = methods::new,
80+
getClass = methods::getClass,
81+
pairlist = pairlist,
82+
alist = alist,
83+
as.pairlist = as.pairlist
84+
)
85+
86+
eval(parse(text = x), env)
87+
}
88+
89+
# Safe environment for evaluating deparsed objects, based on inspection of
90+
# https://github.com/wch/r-source/blob/5234fe7b40aad8d3929d240c83203fa97d8c79fc/src/main/deparse.c#L845
91+
reparse <- function(x) {
92+
env <- env(emptyenv(),
93+
`-` = `-`,
94+
c = c,
95+
list = list,
96+
quote = quote,
97+
structure = structure,
98+
expression = expression,
99+
`function` = `function`,
100+
new = methods::new,
101+
getClass = methods::getClass,
102+
pairlist = pairlist,
103+
alist = alist,
104+
as.pairlist = as.pairlist
105+
)
106+
107+
eval(parse(text = x), env)
108+
}
109+
110+
check_roundtrip <- function(x,
111+
y,
112+
label,
113+
style,
114+
...,
115+
tolerance = testthat_tolerance(),
116+
error_call = caller_env()) {
117+
check <- waldo_compare(x, y, x_arg = "original", y_arg = "new", ..., tolerance = tolerance)
118+
if (length(check) > 0) {
119+
abort(c(
120+
paste0("`", label, "` could not be safely serialized with `style = \"", style, "\"`."),
121+
" " = paste0(
122+
"Serializing then deserializing the object returned something new:\n\n",
123+
check, "\n"
124+
),
125+
i = "You may need to try a different `style`."),
126+
call = error_call
127+
)
128+
}
129+
}
130+

‎R/snapshot.R

-88
Original file line numberDiff line numberDiff line change
@@ -257,94 +257,6 @@ expect_snapshot_condition <- function(base_class, x, class, cran = FALSE, varian
257257
)
258258
}
259259

260-
#' Snapshot testing for values
261-
#'
262-
#' Captures the result of function, flexibly serializing it into a text
263-
#' representation that's stored in a snapshot file. See [expect_snapshot()]
264-
#' for more details on snapshot testing.
265-
#'
266-
#' @param style Serialization style to use:
267-
#' * `json` uses [jsonlite::fromJSON()] and [jsonlite::toJSON()]. This
268-
#' produces the simplest output but only works for relatively simple
269-
#' objects.
270-
#' * `json2` uses [jsonlite::serializeJSON()] and [jsonlite::unserializeJSON()]
271-
#' which are more verbose but work for a wider range of type.
272-
#' * `deparse` uses [deparse()], which generates a depiction of the object
273-
#' using R code.
274-
#' * `serialize()` produces a binary serialization of the object using
275-
#' [serialize()]. This is all but guaranteed to work for any R object,
276-
#' but produces a completely opaque serialization.
277-
#' @param ... Passed on to [waldo::compare()] so you can control the details of
278-
#' the comparison.
279-
#' @inheritParams expect_snapshot
280-
#' @inheritParams compare
281-
#' @export
282-
expect_snapshot_value <- function(x,
283-
style = c("json", "json2", "deparse", "serialize"),
284-
cran = FALSE,
285-
tolerance = testthat_tolerance(),
286-
...,
287-
variant = NULL) {
288-
edition_require(3, "expect_snapshot_value()")
289-
variant <- check_variant(variant)
290-
lab <- quo_label(enquo(x))
291-
292-
style <- arg_match(style)
293-
294-
save <- switch(style,
295-
json = function(x) jsonlite::toJSON(x, auto_unbox = TRUE, pretty = TRUE),
296-
json2 = function(x) jsonlite::serializeJSON(x, pretty = TRUE),
297-
deparse = function(x) paste0(deparse(x), collapse = "\n"),
298-
serialize = function(x) jsonlite::base64_enc(serialize(x, NULL, version = 2))
299-
)
300-
load <- switch(style,
301-
json = function(x) jsonlite::fromJSON(x, simplifyVector = FALSE),
302-
json2 = function(x) jsonlite::unserializeJSON(x),
303-
deparse = function(x) reparse(x),
304-
serialize = function(x) unserialize(jsonlite::base64_dec(x))
305-
)
306-
307-
with_is_snapshotting(force(x))
308-
check_roundtrip(
309-
x,
310-
load(save(x)),
311-
label = lab,
312-
style = style,
313-
tolerance = tolerance
314-
)
315-
316-
expect_snapshot_helper(lab, x,
317-
save = save,
318-
load = load,
319-
cran = cran,
320-
...,
321-
tolerance = tolerance,
322-
variant = variant,
323-
trace_env = caller_env()
324-
)
325-
}
326-
327-
# Safe environment for evaluating deparsed objects, based on inspection of
328-
# https://github.com/wch/r-source/blob/5234fe7b40aad8d3929d240c83203fa97d8c79fc/src/main/deparse.c#L845
329-
reparse <- function(x) {
330-
env <- env(emptyenv(),
331-
`-` = `-`,
332-
c = c,
333-
list = list,
334-
quote = quote,
335-
structure = structure,
336-
expression = expression,
337-
`function` = `function`,
338-
new = methods::new,
339-
getClass = methods::getClass,
340-
pairlist = pairlist,
341-
alist = alist,
342-
as.pairlist = as.pairlist
343-
)
344-
345-
eval(parse(text = x), env)
346-
}
347-
348260
expect_snapshot_helper <- function(lab, val,
349261
cran = FALSE,
350262
save = identity,

‎man/expect_snapshot_value.Rd

+1-1
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/_snaps/snapshot-reporter.md

-14
This file was deleted.

‎tests/testthat/_snaps/snapshot-value.md

+69
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
# can snapshot values
2+
3+
[
4+
"a",
5+
1.5,
6+
1,
7+
true
8+
]
9+
10+
---
11+
12+
{
13+
"type": "list",
14+
"attributes": {},
15+
"value": [
16+
{
17+
"type": "character",
18+
"attributes": {},
19+
"value": ["a"]
20+
},
21+
{
22+
"type": "double",
23+
"attributes": {},
24+
"value": [1.5]
25+
},
26+
{
27+
"type": "integer",
28+
"attributes": {},
29+
"value": [1]
30+
},
31+
{
32+
"type": "logical",
33+
"attributes": {},
34+
"value": [true]
35+
}
36+
]
37+
}
38+
39+
---
40+
41+
list("a", 1.5, 1L, TRUE)
42+
43+
---
44+
45+
WAoAAAACAAQCAwACAwAAAAATAAAABAAAABAAAAABAAQACQAAAAFhAAAADgAAAAE/+AAAAAAA
46+
AAAAAA0AAAABAAAAAQAAAAoAAAABAAAAAQ==
47+
48+
# can control snapshot value details
49+
50+
1.2
51+
52+
# tolerance passed to check_roundtrip
53+
54+
0.9
55+
56+
# check_roundtrip() gives nice error
57+
58+
Code
59+
wrapper(NULL, list(), label = "foo", style = "json")
60+
Condition
61+
Error in `wrapper()`:
62+
! `foo` could not be safely serialized with `style = "json"`.
63+
Serializing then deserializing the object returned something new:
64+
65+
`original` is NULL
66+
`new` is a list
67+
68+
i You may need to try a different `style`.
69+

0 commit comments

Comments
 (0)