1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
expect_tibble_error <- function(object, cnd, fixed = NULL) {
cnd_actual <- expect_error(object, regexp = cnd_message(cnd), class = class(cnd)[[1]], fixed = TRUE)
expect_cnd_equivalent(cnd_actual, cnd)
expect_s3_class(cnd_actual, class(cnd), exact = TRUE)
}
expect_cnd_equivalent <- function(actual, expected) {
actual$trace <- NULL
actual$parent <- NULL
actual$body <- NULL
expected$trace <- NULL
expected$parent <- NULL
expected$body <- NULL
expect_equal(actual, expected)
}
expect_error_cnd <- function(object, class, message = NULL, ..., .fixed = TRUE) {
cnd <- expect_error(object, regexp = message, class = class, fixed = .fixed)
expect_true(inherits_all(cnd, class))
exp_fields <- list2(...)
if (has_length(exp_fields)) {
expect_true(is_empty(setdiff(!!names(exp_fields), names(cnd))))
expect_equal(cnd[names(exp_fields)], exp_fields)
}
}
expect_snapshot_with_error <- function(code) {
code <- rlang::enexpr(code)
if (packageVersion("testthat") > "3.0.0") {
rlang::eval_tidy(rlang::quo(expect_snapshot(!!code, error = TRUE)))
} else {
rlang::eval_tidy(rlang::quo(expect_snapshot(!!code)))
}
}
|
