Skip to content

Commit eb7de57

Browse files
hadleyhadley
committed
Use fail()+succeed() instead of expect() 
1 parent 5ae7600 commit eb7de57

24 files changed

+250
-205
lines changed

‎R/expect-comparison.R‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -34,17 +34,17 @@ expect_compare <- function(operator = c("<", "<=", ">", ">="), act, exp) {
3434
if (length(cmp) != 1 || !is.logical(cmp)) {
3535
abort("Result of comparison must be a single logical value")
3636
}
37-
expect(
38-
if (!is.na(cmp)) cmp else FALSE,
39-
sprintf(
37+
if (!isTRUE(cmp)) {
38+
msg <- sprintf(
4039
"%s is %s %s. Difference: %.3g",
4140
act$lab,
4241
msg,
4342
exp$lab,
4443
act$val - exp$val
45-
),
46-
trace_env = caller_env()
47-
)
44+
)
45+
fail(msg, trace_env = caller_env())
46+
}
47+
succeed()
4848
invisible(act$val)
4949
}
5050
#' @export

‎R/expect-condition.R‎

Lines changed: 20 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -138,7 +138,10 @@ expect_error <- function(
138138

139139
# Access error fields with `[[` rather than `$` because the
140140
# `$.Throwable` from the rJava package throws with unknown fields
141-
expect(is.null(msg), msg, info = info, trace = act$cap[["trace"]])
141+
if (!is.null(msg)) {
142+
fail(msg, info = info, trace = act$cap[["trace"]])
143+
}
144+
succeed()
142145
invisible(act$val %||% act$cap)
143146
}
144147
}
@@ -186,7 +189,10 @@ expect_warning <- function(
186189
...,
187190
cond_type = "warnings"
188191
)
189-
expect(is.null(msg), msg, info = info)
192+
if (!is.null(msg)) {
193+
fail(msg, info = info)
194+
}
195+
succeed()
190196

191197
invisible(act$val)
192198
}
@@ -218,7 +224,10 @@ expect_message <- function(
218224
} else {
219225
act <- quasi_capture(enquo(object), label, capture_messages)
220226
msg <- compare_messages(act$cap, act$lab, regexp = regexp, all = all, ...)
221-
expect(is.null(msg), msg, info = info)
227+
if (!is.null(msg)) {
228+
fail(msg, info = info)
229+
}
230+
succeed()
222231

223232
invisible(act$val)
224233
}
@@ -262,7 +271,10 @@ expect_condition <- function(
262271
inherit = inherit,
263272
cond_type = "condition"
264273
)
265-
expect(is.null(msg), msg, info = info, trace = act$cap[["trace"]])
274+
if (!is.null(msg)) {
275+
fail(msg, info = info, trace = act$cap[["trace"]])
276+
}
277+
succeed()
266278

267279
invisible(act$val %||% act$cap)
268280
}
@@ -302,13 +314,10 @@ expect_condition_matching <- function(
302314

303315
# Access error fields with `[[` rather than `$` because the
304316
# `$.Throwable` from the rJava package throws with unknown fields
305-
expect(
306-
is.null(msg),
307-
msg,
308-
info = info,
309-
trace = act$cap[["trace"]],
310-
trace_env = trace_env
311-
)
317+
if (!is.null(msg)) {
318+
fail(msg, info = info, trace = act$cap[["trace"]], trace_env = trace_env)
319+
}
320+
succeed()
312321

313322
# If a condition was expected, return it. Otherwise return the value
314323
# of the expression.

‎R/expect-constant.R‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,6 @@ expect_false <- function(object, info = NULL, label = NULL) {
5656
#' show_failure(expect_null(y))
5757
expect_null <- function(object, info = NULL, label = NULL) {
5858
act <- quasi_label(enquo(object), label, arg = "object")
59-
6059
expect_waldo_constant(act, NULL, info = info)
6160
}
6261

@@ -71,17 +70,18 @@ expect_waldo_constant <- function(act, constant, info, ...) {
7170
...
7271
)
7372

74-
expect(
75-
length(comp) == 0,
76-
sprintf(
73+
if (length(comp) != 0) {
74+
msg <- sprintf(
7775
"%s is not %s\n\n%s",
7876
act$lab,
7977
deparse(constant),
8078
paste0(comp, collapse = "\n\n")
81-
),
82-
info = info,
83-
trace_env = caller_env()
84-
)
79+
)
80+
fail(msg, info = info, trace_env = caller_env())
81+
} else {
82+
# TODO figure out why an error return doesn't work with fail() above
83+
succeed()
84+
}
8585

8686
invisible(act$val)
8787
}

‎R/expect-equality.R‎

Lines changed: 31 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -75,11 +75,11 @@ expect_equal <- function(
7575
comp <- compare(act$val, exp$val, ...)
7676
}
7777

78-
expect(
79-
comp$equal,
80-
sprintf("%s not equal to %s.\n%s", act$lab, exp$lab, comp$message),
81-
info = info
82-
)
78+
if (!comp$equal) {
79+
msg <- sprintf("%s not equal to %s.\n%s", act$lab, exp$lab, comp$message)
80+
fail(msg, info = info)
81+
}
82+
succeed()
8383
invisible(act$val)
8484
}
8585
}
@@ -112,11 +112,11 @@ expect_identical <- function(
112112
}
113113
}
114114

115-
expect(
116-
ident,
117-
sprintf("%s not identical to %s.\n%s", act$lab, exp$lab, msg),
118-
info = info
119-
)
115+
if (!ident) {
116+
msg <- sprintf("%s not identical to %s.\n%s", act$lab, exp$lab, msg)
117+
fail(msg, info = info)
118+
}
119+
succeed()
120120
invisible(act$val)
121121
}
122122
}
@@ -129,20 +129,19 @@ expect_waldo_equal <- function(type, act, exp, info, ...) {
129129
x_arg = "actual",
130130
y_arg = "expected"
131131
)
132-
expect(
133-
length(comp) == 0,
134-
sprintf(
132+
if (length(comp) != 0) {
133+
msg <- sprintf(
135134
"%s (%s) not %s to %s (%s).\n\n%s",
136135
act$lab,
137136
"`actual`",
138137
type,
139138
exp$lab,
140139
"`expected`",
141140
paste0(comp, collapse = "\n\n")
142-
),
143-
info = info,
144-
trace_env = caller_env()
145-
)
141+
)
142+
fail(msg, info = info, trace_env = caller_env())
143+
}
144+
succeed()
146145

147146
invisible(act$val)
148147
}
@@ -188,11 +187,16 @@ expect_equivalent <- function(
188187
)
189188

190189
comp <- compare(act$val, exp$val, ..., check.attributes = FALSE)
191-
expect(
192-
comp$equal,
193-
sprintf("%s not equivalent to %s.\n%s", act$lab, exp$lab, comp$message),
194-
info = info
195-
)
190+
if (!comp$equal) {
191+
msg <- sprintf(
192+
"%s not equivalent to %s.\n%s",
193+
act$lab,
194+
exp$lab,
195+
comp$message
196+
)
197+
fail(msg, info = info)
198+
}
199+
succeed()
196200
invisible(act$val)
197201
}
198202

@@ -225,11 +229,11 @@ expect_reference <- function(
225229
act <- quasi_label(enquo(object), label, arg = "object")
226230
exp <- quasi_label(enquo(expected), expected.label, arg = "expected")
227231

228-
expect(
229-
is_reference(act$val, exp$val),
230-
sprintf("%s not a reference to %s.", act$lab, exp$lab),
231-
info = info
232-
)
232+
if (!is_reference(act$val, exp$val)) {
233+
msg <- sprintf("%s not a reference to %s.", act$lab, exp$lab)
234+
fail(msg, info = info)
235+
}
236+
succeed()
233237
invisible(act$val)
234238
}
235239

‎R/expect-inheritance.R‎

Lines changed: 56 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -51,15 +51,16 @@ expect_type <- function(object, type) {
5151
act <- quasi_label(enquo(object), arg = "object")
5252
act_type <- typeof(act$val)
5353

54-
expect(
55-
identical(act_type, type),
56-
sprintf(
54+
if (!identical(act_type, type)) {
55+
msg <- sprintf(
5756
"%s has type %s, not %s.",
5857
act$lab,
5958
format_class(act_type),
6059
format_class(type)
6160
)
62-
)
61+
fail(msg)
62+
}
63+
succeed()
6364
invisible(act$val)
6465
}
6566

@@ -74,28 +75,34 @@ expect_s3_class <- function(object, class, exact = FALSE) {
7475
exp_lab <- format_class(class)
7576

7677
if (identical(class, NA)) {
77-
expect(
78-
isS3(object) == !is.na(class),
79-
sprintf("%s is an S3 object", act$lab)
80-
)
78+
if (isS3(object)) {
79+
msg <- sprintf("%s is an S3 object", act$lab)
80+
fail(msg)
81+
}
8182
} else if (is.character(class)) {
8283
if (!isS3(act$val)) {
8384
fail(sprintf("%s is not an S3 object", act$lab))
8485
} else if (exact) {
85-
expect(
86-
identical(class(act$val), class),
87-
sprintf("%s has class %s, not %s.", act$lab, act$class, exp_lab)
88-
)
86+
if (!identical(class(act$val), class)) {
87+
msg <- sprintf("%s has class %s, not %s.", act$lab, act$class, exp_lab)
88+
fail(msg)
89+
}
8990
} else {
90-
expect(
91-
inherits(act$val, class),
92-
sprintf("%s inherits from %s not %s.", act$lab, act$class, exp_lab)
93-
)
91+
if (!inherits(act$val, class)) {
92+
msg <- sprintf(
93+
"%s inherits from %s not %s.",
94+
act$lab,
95+
act$class,
96+
exp_lab
97+
)
98+
fail(msg)
99+
}
94100
}
95101
} else {
96102
abort("`class` must be a NA or a character vector")
97103
}
98104

105+
succeed()
99106
invisible(act$val)
100107
}
101108

@@ -112,20 +119,18 @@ expect_s7_class <- function(object, class) {
112119
if (!S7::S7_inherits(object)) {
113120
fail(sprintf("%s is not an S7 object", act$lab))
114121
} else {
115-
expect(
116-
S7::S7_inherits(object, class),
117-
sprintf(
122+
if (!S7::S7_inherits(object, class)) {
123+
obj_class <- setdiff(base::class(object), "S7_object")
124+
class_desc <- paste0("<", obj_class, ">", collapse = "/")
125+
msg <- sprintf(
118126
"%s inherits from %s not <%s>.",
119127
act$lab,
120-
paste0(
121-
"<",
122-
setdiff(base::class(object), "S7_object"),
123-
">",
124-
collapse = "/"
125-
),
128+
class_desc,
126129
attr(class, "name", TRUE)
127130
)
128-
)
131+
fail(msg)
132+
}
133+
succeed()
129134
}
130135

131136
invisible(act$val)
@@ -139,18 +144,25 @@ expect_s4_class <- function(object, class) {
139144
exp_lab <- format_class(class)
140145

141146
if (identical(class, NA)) {
142-
expect(
143-
isS4(object) == !is.na(class),
144-
sprintf("%s is an S4 object", act$lab)
145-
)
147+
if (!(isS4(object) == !is.na(class))) {
148+
msg <- sprintf("%s is an S4 object", act$lab)
149+
fail(msg)
150+
}
151+
succeed()
146152
} else if (is.character(class)) {
147153
if (!isS4(act$val)) {
148154
fail(sprintf("%s is not an S4 object", act$lab))
149155
} else {
150-
expect(
151-
methods::is(act$val, class),
152-
sprintf("%s inherits from %s not %s.", act$lab, act$class, exp_lab)
153-
)
156+
if (!methods::is(act$val, class)) {
157+
msg <- sprintf(
158+
"%s inherits from %s not %s.",
159+
act$lab,
160+
act$class,
161+
exp_lab
162+
)
163+
fail(msg)
164+
}
165+
succeed()
154166
}
155167
} else {
156168
abort("`class` must be a NA or a character vector")
@@ -191,11 +203,16 @@ expect_is <- function(object, class, info = NULL, label = NULL) {
191203
act$class <- format_class(class(act$val))
192204
exp_lab <- format_class(class(class))
193205

194-
expect(
195-
inherits(act$val, class),
196-
sprintf("%s inherits from `%s` not `%s`.", act$lab, act$class, exp_lab),
197-
info = info
198-
)
206+
if (!inherits(act$val, class)) {
207+
msg <- sprintf(
208+
"%s inherits from `%s` not `%s`.",
209+
act$lab,
210+
act$class,
211+
exp_lab
212+
)
213+
fail(msg, info = info)
214+
}
215+
succeed()
199216
invisible(act$val)
200217
}
201218

0 commit comments

Comments
 (0)