Skip to content

Commit 7bb8bff

Browse files
committed
Polishing/fixes
1 parent c219d63 commit 7bb8bff

File tree

4 files changed

+61
-57
lines changed

4 files changed

+61
-57
lines changed

R/expect-match.R

Lines changed: 19 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -116,26 +116,27 @@ expect_match_ <- function(
116116

117117
if (ok) {
118118
pass()
119+
invisible(act$val)
120+
}
121+
122+
values <- show_text(act$val, condition)
123+
if (length(act$val) == 1) {
124+
which <- ""
119125
} else {
120-
values <- show_text(act$val, condition)
121-
if (length(act$val) == 1) {
122-
which <- ""
123-
} else {
124-
which <- if (all) "every element of " else "some element of "
125-
}
126-
match <- if (negate) "not to match" else "to match"
127-
128-
msg_exp <- sprintf(
129-
"Expected %s%s %s %s %s.",
130-
which,
131-
act$lab,
132-
match,
133-
if (fixed) "string" else "regexp",
134-
encodeString(regexp, quote = '"')
135-
)
136-
msg_act <- c(paste0("Actual ", title, ':'), values)
137-
fail(c(msg_exp, msg_act), info = info, trace_env = trace_env)
126+
which <- if (all) "every element of " else "some element of "
138127
}
128+
match <- if (negate) "not to match" else "to match"
129+
130+
msg_exp <- sprintf(
131+
"Expected %s%s %s %s %s.",
132+
which,
133+
act$lab,
134+
match,
135+
if (fixed) "string" else "regexp",
136+
encodeString(regexp, quote = '"')
137+
)
138+
msg_act <- c(paste0("Actual ", title, ':'), values)
139+
fail(c(msg_exp, msg_act), info = info, trace_env = trace_env)
139140

140141
invisible(act$val)
141142
}

R/expect-that.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,7 @@
2121
#' @param trace An optional backtrace created by [rlang::trace_back()].
2222
#' When supplied, the expectation is displayed with the backtrace.
2323
#' Expert use only.
24-
#' @return `pass()` returns `value` invisibly; `fail()` returns `FALSE`
25-
#' invisibly.
24+
#' @export
2625
#' @examples
2726
#' expect_length <- function(object, n) {
2827
#' act <- quasi_label(rlang::enquo(object), arg = "object")
@@ -45,7 +44,6 @@ fail <- function(
4544
trace <- trace %||% capture_trace(trace_env)
4645
message <- paste(c(message, info), collapse = "\n")
4746
expectation("failure", message, srcref = srcref, trace = trace)
48-
invisible(FALSE)
4947
}
5048

5149
snapshot_fail <- function(message, trace_env = caller_env()) {

man/fail.Rd

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

vignettes/custom-expectation.Rmd

Lines changed: 40 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -48,9 +48,11 @@ If we use it in a test you can see there's an issue:
4848
test_that("success", {
4949
expect_nrow(mtcars, 32)
5050
})
51+
5152
test_that("failure 1", {
5253
expect_nrow(mtcars, 30)
5354
})
55+
5456
test_that("failure 2", {
5557
expect_nrow(matrix(1:5), 2)
5658
})
@@ -64,35 +66,38 @@ These are both minor issues, so if they don't bother you, you can save yourself
6466

6567
## Expectation basics
6668

67-
An expectation has three main parts, as illustrated by `expect_length()`:
69+
An expectation has four main parts, as illustrated by `expect_length()`:
6870

6971
```{r}
7072
expect_length <- function(object, n) {
7173
# 1. Capture object and label
7274
act <- quasi_label(rlang::enquo(object))
73-
74-
# 2. Check if expectations are violated
75+
7576
act_n <- length(act$val)
7677
if (act_n != n) {
7778
msg <- c(
7879
sprintf("Expected %s to have length %i.", act$lab, n),
7980
sprintf("Actual length: %i.", act_n)
8081
)
81-
return(fail(msg))
82+
# 2. Fail if expectations are violated
83+
fail(msg)
84+
} else {
85+
# 3. Pass if expectations are met
86+
pass()
8287
}
8388
84-
# 3. Pass when expectations are met
85-
pass(act$val)
89+
# 4. Invisibly return the input value
90+
invisible(act$val)
8691
}
8792
```
8893

8994
The first step in any expectation is to use `quasi_label()` to capture a "labeled value", i.e., a list that contains both the value (`$val`) for testing and a label (`$lab`) used to make failure messages as informative as possible. This is a pattern that exists for fairly esoteric reasons; you don't need to understand it, just copy and paste it.
9095

91-
Next you need to check each way that `object` could violate the expectation. In this case, there's only one check, but in more complicated cases there can be multiple checks. In most cases, it's easier to check for violations one by one, using early returns to `fail()`. This makes it easier to write informative failure messages that first describe what was expected and then what was actually seen.
96+
Next you need to check each way that `object` could violate the expectation. In this case, there's only one check, but in more complicated cases there can be multiple checks. In most cases, it's easier to check for violations one by one, using an nested if-else statement. That makes it easier to write informative failure messages that first describe what was expected and then what was actually seen.
9297

93-
Note that you need to use `return(fail())` here. If you don't, your expectation might end up failing multiple times or both failing and succeeding. You won't see these problems when interactively testing your expectation, but forgetting to `return()` can lead to incorrect fail and pass counts in typical usage. In the next section, you'll learn how to test your expectation to avoid this issue.
98+
If the object is as expected, call `pass()`. This ensures that a success will be registered in the test reporter.
9499

95-
Finally, if the object is as expected, call `pass()` with `act$val`. This is good practice because expectation functions are called primarily for their side-effects (triggering a failure), and returning the value allows expectations to be piped together:
100+
Finally, return the input value (`act$val`) invisibly. This is good practice because expectations are called primarily for their side-effects (triggering a failure), and returning the value allows expectations to be piped together:
96101

97102
```{r}
98103
#| label: piping
@@ -153,7 +158,8 @@ expect_vector_length <- function(object, n) {
153158
sprintf("Expected %s to be a vector", act$lab),
154159
sprintf("Actual type: %s", typeof(act$val))
155160
)
156-
return(fail(msg))
161+
fail(msg)
162+
return(invisible(act$val))
157163
}
158164
159165
act_n <- length(act$val)
@@ -162,10 +168,11 @@ expect_vector_length <- function(object, n) {
162168
sprintf("Expected %s to have length %i.", act$lab, n),
163169
sprintf("Actual length: %i.", act_n)
164170
)
165-
return(fail(msg))
171+
fail(msg)
172+
} else {
173+
pass()
166174
}
167-
168-
pass(act$val)
175+
invisible(act$val)
169176
}
170177
```
171178

@@ -189,26 +196,24 @@ expect_s3_class <- function(object, class) {
189196
190197
if (!is.object(act$val)) {
191198
msg <- sprintf("Expected %s to be an object.", act$lab)
192-
return(fail(msg))
193-
}
194-
195-
if (isS4(act$val)) {
199+
fail(msg)
200+
} else if (isS4(act$val)) {
196201
msg <- c(
197202
sprintf("Expected %s to be an S3 object.", act$lab),
198203
"Actual OO type: S4"
199204
)
200-
return(fail(msg))
201-
}
202-
203-
if (!inherits(act$val, class)) {
205+
fail(msg)
206+
} else if (!inherits(act$val, class)) {
204207
msg <- c(
205208
sprintf("Expected %s to inherit from %s.", act$lab, class),
206209
sprintf("Actual class: %s", class(act$val))
207210
)
208-
return(fail(msg))
211+
fail(msg)
212+
} else {
213+
pass()
209214
}
210215
211-
pass(act$val)
216+
invisible(act$val)
212217
}
213218
```
214219

@@ -254,26 +259,24 @@ expect_s3_object <- function(object, class = NULL) {
254259
255260
if (!is.object(act$val)) {
256261
msg <- sprintf("Expected %s to be an object.", act$lab)
257-
return(fail(msg))
258-
}
259-
260-
if (isS4(act$val)) {
262+
fail(msg)
263+
} else if (isS4(act$val)) {
261264
msg <- c(
262265
sprintf("Expected %s to be an S3 object.", act$lab),
263266
"Actual OO type: S4"
264267
)
265-
return(fail(msg))
266-
}
267-
268-
if (!is.null(class) && !inherits(act$val, class)) {
268+
fail(msg)
269+
} else if (!is.null(class) && !inherits(act$val, class)) {
269270
msg <- c(
270271
sprintf("Expected %s to inherit from %s.", act$lab, class),
271272
sprintf("Actual class: %s", class(act$val))
272273
)
273-
return(fail(msg))
274+
fail(msg)
275+
} else {
276+
pass()
274277
}
275278
276-
pass(act$val)
279+
invisible(act$val)
277280
}
278281
```
279282

@@ -288,10 +291,12 @@ expect_length_ <- function(act, n, trace_env = caller_env()) {
288291
act_n <- length(act$val)
289292
if (act_n != n) {
290293
msg <- sprintf("%s has length %i, not length %i.", act$lab, act_n, n)
291-
return(fail(msg, trace_env = trace_env))
294+
fail(msg, trace_env = trace_env)
295+
} else {
296+
pass()
292297
}
293298
294-
pass(act$val)
299+
invisible(act$val)
295300
}
296301
297302
expect_length <- function(object, n) {

0 commit comments

Comments
 (0)