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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
#' Does code return a vector containing the expected values?
#'
#' * `expect_setequal(x, y)` tests that every element of `x` occurs in `y`,
#' and that every element of `y` occurs in `x`.
#' * `expect_contains(x, y)` tests that `x` contains every element of `y`
#' (i.e. `y` is a subset of `x`).
#' * `expect_in(x, y)` tests every element of `x` is in `y`
#' (i.e. `x` is a subset of `y`).
#' * `expect_mapequal(x, y)` tests that `x` and `y` have the same names, and
#' that `x[names(y)]` equals `y`.
#'
#' Note that `expect_setequal()` ignores names, and you will be warned if both
#' `object` and `expected` have them.
#'
#' @inheritParams expect_equal
#' @export
#' @examples
#' expect_setequal(letters, rev(letters))
#' show_failure(expect_setequal(letters[-1], rev(letters)))
#'
#' x <- list(b = 2, a = 1)
#' expect_mapequal(x, list(a = 1, b = 2))
#' show_failure(expect_mapequal(x, list(a = 1)))
#' show_failure(expect_mapequal(x, list(a = 1, b = "x")))
#' show_failure(expect_mapequal(x, list(a = 1, b = 2, c = 3)))
expect_setequal <- function(object, expected) {
act <- quasi_label(enquo(object), arg = "object")
exp <- quasi_label(enquo(expected), arg = "expected")
if (!is_vector(act$val) || !is_vector(exp$val)) {
abort("`object` and `expected` must both be vectors")
}
if (!is.null(names(act$val)) && !is.null(names(exp$val))) {
warn("expect_setequal() ignores names")
}
act_miss <- unique(act$val[!act$val %in% exp$val])
exp_miss <- unique(exp$val[!exp$val %in% act$val])
if (length(exp_miss) || length(act_miss)) {
fail(paste0(
act$lab, " (`actual`) and ", exp$lab, " (`expected`) don't have the same values.\n",
if (length(act_miss))
paste0("* Only in `actual`: ", values(act_miss), "\n"),
if (length(exp_miss))
paste0("* Only in `expected`: ", values(exp_miss), "\n")
))
} else {
succeed()
}
invisible(act$val)
}
values <- function(x) {
has_extra <- length(x) > 10
if (has_extra) {
x <- x[1:9]
}
if (is.character(x)) {
x <- encodeString(x, quote = '"')
}
out <- paste0(x, collapse = ", ")
if (has_extra) {
out <- paste0(out, ", ...")
}
out
}
is_vector <- function(x) is.list(x) || (is.atomic(x) && !is.null(x))
#' @export
#' @rdname expect_setequal
expect_mapequal <- function(object, expected) {
act <- quasi_label(enquo(object), arg = "object")
exp <- quasi_label(enquo(expected), arg = "expected")
if (!is_vector(act$val) || !is_vector(exp$val)) {
abort("`object` and `expected` must both be vectors")
}
# Length-0 vectors are OK whether named or unnamed.
if (length(act$val) == 0 && length(exp$val) == 0) {
warn("`object` and `expected` are empty lists")
succeed()
return(invisible(act$val))
}
act_nms <- names(act$val)
exp_nms <- names(exp$val)
check_names_ok(act_nms, "object")
check_names_ok(exp_nms, "expected")
if (!setequal(act_nms, exp_nms)) {
act_miss <- setdiff(exp_nms, act_nms)
if (length(act_miss) > 0) {
vals <- paste0(encodeString(act_miss, quote = '"'), ", ")
fail(paste0("Names absent from `object`: ", vals))
}
exp_miss <- setdiff(act_nms, exp_nms)
if (length(exp_miss) > 0) {
vals <- paste0(encodeString(exp_miss, quote = '"'), ", ")
fail(paste0("Names absent from `expected`: ", vals))
}
} else {
expect_equal(act$val[exp_nms], exp$val)
}
invisible(act$val)
}
check_names_ok <- function(x, label) {
if (anyDuplicated(x)) {
stop("Duplicate names in `", label, "`: ", unique(x[duplicated(x)]))
}
if (any(x == "")) {
stop("All elements in `", label, "` must be named")
}
}
#' @export
#' @rdname expect_setequal
expect_contains <- function(object, expected) {
act <- quasi_label(enquo(object), arg = "object")
exp <- quasi_label(enquo(expected), arg = "expected")
if (!is_vector(act$val) || !is_vector(exp$val)) {
abort("`object` and `expected` must both be vectors")
}
exp_miss <- !exp$val %in% act$val
if (any(exp_miss)) {
fail(paste0(
act$lab, " (`actual`) doesn't fully contain all the values in ", exp$lab, " (`expected`).\n",
paste0("* Missing from `actual`: ", values(exp$val[exp_miss]), "\n"),
paste0("* Present in `actual`: ", values(act$val), "\n")
))
} else {
succeed()
}
invisible(act$val)
}
#' @export
#' @rdname expect_setequal
expect_in <- function(object, expected) {
act <- quasi_label(enquo(object), arg = "object")
exp <- quasi_label(enquo(expected), arg = "expected")
if (!is_vector(act$val) || !is_vector(exp$val)) {
abort("`object` and `expected` must both be vectors")
}
act_miss <- !act$val %in% exp$val
if (any(act_miss)) {
fail(paste0(
act$lab, " (`actual`) isn't fully contained within ", exp$lab, " (`expected`).\n",
paste0("* Missing from `expected`: ", values(act$val[act_miss]), "\n"),
paste0("* Present in `expected`: ", values(exp$val), "\n")
))
} else {
succeed()
}
invisible(act$val)
}
|
