Skip to content

Commit 788b375

Browse files
hadleyhadley
committed
Reframe to expected + actual
1 parent da93c35 commit 788b375

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

56 files changed

+683
-292
lines changed

‎CLAUDE.md‎

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -12,18 +12,24 @@ General advice:
1212
* When running R from the console, always run it with `--quiet --vanilla`
1313
* Always run `air format .` after generating code
1414

15-
### Development tools
15+
### Testing
1616

17-
- `devtools::test()` - Run all tests
18-
- `devtools::test_file("tests/testthat/test-filename.R")` - Run tests in a specific file
17+
- Use `devtools::test()` to run all tests
18+
- Use `devtools::test_file("tests/testthat/test-filename.R")` to run tests in a specific file
1919
- DO NOT USE `devtools::test_active_file()`
20-
- `devtools::load_all()` - Load package for development
21-
- `devtools::check()` - Run R CMD check
22-
- `devtools::install()` - Install package locally
20+
- All testing functions automatically loads code; you don't have to.
21+
22+
- You can accept
23+
24+
- All new code should have an accompanying test.
25+
- Tests for `R/{name}.R` go in `tests/testthat/test-{name}.R`.
26+
- If there are existing tests, place new tests next to similar existing tests.
2327

2428
### Documentation
2529

2630
- Always run `devtools::document()` after changing any roxygen2 docs.
31+
- Every user facing function should be exported and have roxygen2 documentation.
32+
- Whenever you add a new documentation file, make sure to also add it to `_pkgdown.yml`. Run `pkgdown::check_pkgdown()` to check that it was added correctly.
2733

2834
## Core Architecture
2935

‎R/expect-comparison.R‎

Lines changed: 30 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -28,14 +28,7 @@ expect_compare_ <- function(
2828
operator <- match.arg(operator)
2929
op <- match.fun(operator)
3030

31-
msg <- c(
32-
"<" = "not strictly less than",
33-
"<=" = "not less than",
34-
">" = "not strictly greater than",
35-
">=" = "not greater than"
36-
)[[operator]]
37-
38-
negated_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
31+
actual_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
3932

4033
cmp <- op(act$val, exp$val)
4134
if (length(cmp) != 1 || !is.logical(cmp)) {
@@ -45,22 +38,35 @@ expect_compare_ <- function(
4538
)
4639
}
4740
if (!isTRUE(cmp)) {
48-
digits <- max(
49-
digits(act$val),
50-
digits(exp$val),
51-
min_digits(act$val, exp$val)
52-
)
53-
msg <- sprintf(
54-
"%s is %s %s.\n%s - %s = %s %s 0",
55-
act$lab,
56-
msg,
57-
exp$lab,
58-
num_exact(act$val, digits),
59-
num_exact(exp$val, digits),
60-
num_exact(act$val - exp$val, digits),
61-
negated_op
62-
)
63-
return(fail(msg, trace_env = trace_env))
41+
diff <- act$val - exp$val
42+
msg1 <- sprintf("Expected %s %s %s.", act$lab, operator, exp$lab)
43+
44+
if (is.nan(diff)) {
45+
msg2 <- "Actual values are incomparable."
46+
msg3 <- NULL
47+
} else if (is.na(diff)) {
48+
msg2 <- "Actual comparison is NA."
49+
msg3 <- NULL
50+
} else {
51+
digits <- max(
52+
digits(act$val),
53+
digits(exp$val),
54+
min_digits(act$val, exp$val)
55+
)
56+
57+
msg2 <- sprintf(
58+
"Actual %s %s %s",
59+
num_exact(act$val, digits),
60+
actual_op,
61+
num_exact(exp$val, digits)
62+
)
63+
msg3 <- sprintf(
64+
"Difference %s %s 0",
65+
num_exact(act$val - exp$val, digits),
66+
actual_op
67+
)
68+
}
69+
return(fail(c(msg1, msg2, msg3), trace_env = trace_env))
6470
}
6571
pass(act$val)
6672
}

‎R/expect-condition.R‎

Lines changed: 13 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -440,10 +440,10 @@ compare_condition_3e <- function(cond_type, cond_class, cond, lab, expected) {
440440
if (expected) {
441441
if (is.null(cond)) {
442442
if (is.null(cond_class)) {
443-
sprintf("%s did not throw the expected %s.", lab, cond_type)
443+
sprintf("Expected %s to throw a %s.", lab, cond_type)
444444
} else {
445445
sprintf(
446-
"%s did not throw a %s with class <%s>.",
446+
"Expected %s to throw a %s with class <%s>.",
447447
lab,
448448
cond_type,
449449
cond_class
@@ -455,11 +455,11 @@ compare_condition_3e <- function(cond_type, cond_class, cond, lab, expected) {
455455
} else {
456456
if (!is.null(cond)) {
457457
sprintf(
458-
"%s threw an unexpected %s.\nMessage: %s\nClass: %s",
458+
"Expected %s to not throw a %s.\nActual <%s>:\n%s",
459459
lab,
460460
cond_type,
461-
cnd_message(cond),
462-
paste(class(cond), collapse = "/")
461+
paste(class(cond), collapse = "/"),
462+
cnd_message(cond)
463463
)
464464
} else {
465465
NULL
@@ -493,7 +493,7 @@ compare_condition_2e <- function(
493493

494494
# Otherwise we're definitely expecting a condition
495495
if (is.null(cond)) {
496-
return(sprintf("%s did not throw an %s.", lab, cond_type))
496+
return(sprintf("Expected %s to throw a %s.", lab, cond_type))
497497
}
498498

499499
matches <- cnd_matches_2e(cond, class, regexp, inherit, ...)
@@ -562,15 +562,20 @@ compare_messages <- function(
562562
# Expecting no messages
563563
if (identical(regexp, NA)) {
564564
if (length(messages) > 0) {
565-
return(sprintf("%s generated %s:\n%s", lab, cond_type, bullets))
565+
return(sprintf(
566+
"Expected %s to not generate %s.\nActually generated:\n%s",
567+
lab,
568+
cond_type,
569+
bullets
570+
))
566571
} else {
567572
return()
568573
}
569574
}
570575

571576
# Otherwise we're definitely expecting messages
572577
if (length(messages) == 0) {
573-
return(sprintf("%s did not produce any %s.", lab, cond_type))
578+
return(sprintf("Expected %s to produce %s.", lab, cond_type))
574579
}
575580

576581
if (is.null(regexp)) {

‎R/expect-equality.R‎

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,12 @@ expect_equal <- function(
7777
}
7878

7979
if (!comp$equal) {
80-
msg <- sprintf("%s not equal to %s.\n%s", act$lab, exp$lab, comp$message)
80+
msg <- sprintf(
81+
"Expected %s to equal %s.\nActual:\n%s",
82+
act$lab,
83+
exp$lab,
84+
comp$message
85+
)
8186
return(fail(msg, info = info))
8287
}
8388
pass(act$val)
@@ -113,7 +118,12 @@ expect_identical <- function(
113118
}
114119

115120
if (!ident) {
116-
msg <- sprintf("%s not identical to %s.\n%s", act$lab, exp$lab, msg)
121+
msg <- sprintf(
122+
"Expected %s to be identical to %s.\n%s",
123+
act$lab,
124+
exp$lab,
125+
msg
126+
)
117127
return(fail(msg, info = info))
118128
}
119129
pass(act$val)
@@ -138,7 +148,7 @@ expect_waldo_equal_ <- function(
138148
)
139149
if (length(comp) != 0) {
140150
msg <- sprintf(
141-
"%s is not %s to %s.\n\n%s",
151+
"Expected %s to be %s to %s.\n\n%s",
142152
act$lab,
143153
type,
144154
exp$lab,
@@ -193,7 +203,7 @@ expect_equivalent <- function(
193203
comp <- compare(act$val, exp$val, ..., check.attributes = FALSE)
194204
if (!comp$equal) {
195205
msg <- sprintf(
196-
"%s not equivalent to %s.\n%s",
206+
"Expected %s to be equivalent to %s.\n%s",
197207
act$lab,
198208
exp$lab,
199209
comp$message

‎R/expect-inheritance.R‎

Lines changed: 71 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -71,10 +71,10 @@ expect_type <- function(object, type) {
7171

7272
if (!identical(act_type, type)) {
7373
msg <- sprintf(
74-
"%s has type %s, not %s.",
74+
"Expected %s to have type %s.\nActual type: %s",
7575
act$lab,
76-
format_class(act_type),
77-
format_class(type)
76+
format_class(type),
77+
format_class(act_type)
7878
)
7979
return(fail(msg))
8080
}
@@ -95,24 +95,31 @@ expect_s3_class <- function(object, class, exact = FALSE) {
9595

9696
if (identical(class, NA)) {
9797
if (isS3(object)) {
98-
msg <- sprintf("%s is an S3 object", act$lab)
98+
msg <- sprintf("Expected %s to not be an S3 object.", act$lab)
9999
return(fail(msg))
100100
}
101101
} else if (is.character(class)) {
102102
if (!isS3(act$val)) {
103-
return(fail(sprintf("%s is not an S3 object", act$lab)))
103+
msg <- c(
104+
sprintf("Expected %s to be an S3 object.", act$lab),
105+
sprintf("Actually is a %s object.", oo_type(act$val))
106+
)
107+
return(fail(msg))
104108
} else if (exact) {
105109
if (!identical(class(act$val), class)) {
106-
msg <- sprintf("%s has class %s, not %s.", act$lab, act$class, exp_lab)
110+
msg <- sprintf(
111+
"Expected %s to have class %s.\nActual class: %s",
112+
act$lab,
113+
exp_lab,
114+
act$class
115+
)
107116
return(fail(msg))
108117
}
109118
} else {
110119
if (!inherits(act$val, class)) {
111-
msg <- sprintf(
112-
"%s inherits from %s not %s.",
113-
act$lab,
114-
act$class,
115-
exp_lab
120+
msg <- c(
121+
sprintf("Expected %s to inherit from %s.", act$lab, exp_lab),
122+
sprintf("Actual class: %s", act$class)
116123
)
117124
return(fail(msg))
118125
}
@@ -133,19 +140,21 @@ expect_s4_class <- function(object, class) {
133140

134141
if (identical(class, NA)) {
135142
if (isS4(object)) {
136-
msg <- sprintf("%s is an S4 object", act$lab)
143+
msg <- sprintf("Expected %s to not be an S4 object.", act$lab)
137144
return(fail(msg))
138145
}
139146
} else if (is.character(class)) {
140147
if (!isS4(act$val)) {
141-
return(fail(sprintf("%s is not an S4 object", act$lab)))
148+
msg <- c(
149+
sprintf("Expected %s to be an S4 object.", act$lab),
150+
sprintf("Actually is a %s object.", oo_type(act$val))
151+
)
152+
return(fail(msg))
142153
} else {
143154
if (!methods::is(act$val, class)) {
144-
msg <- sprintf(
145-
"%s inherits from %s not %s.",
146-
act$lab,
147-
act$class,
148-
exp_lab
155+
msg <- c(
156+
sprintf("Expected %s to inherit from %s.", act$lab, exp_lab),
157+
sprintf("Actual class: %s", act$class)
149158
)
150159
return(fail(msg))
151160
}
@@ -164,13 +173,20 @@ expect_r6_class <- function(object, class) {
164173
check_string(class)
165174

166175
if (!inherits(act$val, "R6")) {
167-
return(fail(sprintf("%s is not an R6 object.", act$lab)))
176+
msg <- c(
177+
sprintf("Expected %s to be an R6 object.", act$lab),
178+
sprintf("Actually is a %s object.", oo_type(act$val))
179+
)
180+
return(fail(msg))
168181
}
169182

170183
if (!inherits(act$val, class)) {
171184
act_class <- format_class(class(act$val))
172185
exp_class <- format_class(class)
173-
msg <- sprintf("%s inherits from %s not %s.", act$lab, act_class, exp_class)
186+
msg <- c(
187+
sprintf("Expected %s to inherit from %s.", act$lab, exp_class),
188+
sprintf("Actual class: %s", act_class)
189+
)
174190
return(fail(msg))
175191
}
176192

@@ -188,17 +204,21 @@ expect_s7_class <- function(object, class) {
188204
act <- quasi_label(enquo(object))
189205

190206
if (!S7::S7_inherits(object)) {
191-
return(fail(sprintf("%s is not an S7 object", act$lab)))
207+
msg <- c(
208+
sprintf("Expected %s to be an S7 object.", act$lab),
209+
sprintf("Actually is a %s object.", oo_type(act$val))
210+
)
211+
return(fail(msg))
192212
}
193213

194214
if (!S7::S7_inherits(object, class)) {
195-
obj_class <- setdiff(base::class(object), "S7_object")
196-
class_desc <- paste0("<", obj_class, ">", collapse = "/")
197-
msg <- sprintf(
198-
"%s inherits from %s not <%s>.",
199-
act$lab,
200-
class_desc,
201-
attr(class, "name", TRUE)
215+
exp_class <- attr(class, "name", TRUE)
216+
act_class <- setdiff(base::class(object), "S7_object")
217+
act_class_desc <- paste0("<", act_class, ">", collapse = "/")
218+
219+
msg <- c(
220+
sprintf("Expected %s to inherit from <%s>.", act$lab, exp_class),
221+
sprintf("Actual class: %s", act_class_desc)
202222
)
203223
return(fail(msg))
204224
}
@@ -239,10 +259,10 @@ expect_is <- function(object, class, info = NULL, label = NULL) {
239259

240260
if (!inherits(act$val, class)) {
241261
msg <- sprintf(
242-
"%s inherits from `%s` not `%s`.",
262+
"Expected %s to inherit from `%s`.\nActual inheritance: `%s`",
243263
act$lab,
244-
act$class,
245-
exp_lab
264+
exp_lab,
265+
act$class
246266
)
247267
return(fail(msg, info = info))
248268
}
@@ -256,3 +276,23 @@ isS3 <- function(x) is.object(x) && !isS4(x)
256276
format_class <- function(x) {
257277
paste0(encodeString(x, quote = "'"), collapse = "/")
258278
}
279+
280+
oo_type <- function(x) {
281+
if (!is.object(x)) {
282+
"base"
283+
} else if (!isS4(x)) {
284+
if (inherits(x, "R6")) {
285+
"R6"
286+
} else if (inherits(x, "S7")) {
287+
"S7"
288+
} else {
289+
"S3"
290+
}
291+
} else {
292+
if (!is(x, "refClass")) {
293+
"S4"
294+
} else {
295+
"RC"
296+
}
297+
}
298+
}

0 commit comments

Comments
 (0)