diff --git a/NEWS.md b/NEWS.md index 41aba9f5f..fabc83aeb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # testthat (development version) +* `expect_named()` now gives more informative errors (#2091). +* `expect_*()` functions consistently and rigorously check their inputs (#1754). * `test_that()` no longer warns about the absence of `{}` since it no longer seems to be necessary. * `test_that()`, `describe()`, and `it()` can now be arbitrarily nested. Each component will skip only if it and its subtests don't contain any expectations. The interactive stop reporter has been fixed so it doesn't duplicate failures. (#2063, #2188). * Test filtering now works with `it()`, and the `desc` argument can take a character vector in order to recursively filter subtests (i.e. `it()` nested inside of `describe()`) (#2118). diff --git a/R/expect-equality.R b/R/expect-equality.R index 61e1b6187..08d8bc077 100644 --- a/R/expect-equality.R +++ b/R/expect-equality.R @@ -126,7 +126,8 @@ expect_waldo_equal_ <- function( exp, info = NULL, ..., - trace_env = caller_env() + trace_env = caller_env(), + error_prefix = NULL ) { comp <- waldo_compare( act$val, @@ -145,6 +146,7 @@ expect_waldo_equal_ <- function( "`expected`", paste0(comp, collapse = "\n\n") ) + msg <- paste0(error_prefix, msg) return(fail(msg, info = info, trace_env = trace_env)) } pass(act$val) diff --git a/R/expect-named.R b/R/expect-named.R index 6518e40da..6f9e63f1b 100644 --- a/R/expect-named.R +++ b/R/expect-named.R @@ -36,27 +36,24 @@ expect_named <- function( check_bool(ignore.case) act <- quasi_label(enquo(object), label) - act$names <- names(act$val) if (missing(expected)) { - if (identical(act$names, NULL)) { - msg <- sprintf("%s does not have names.", act$lab) - return(fail(msg)) - } - } else { - exp_names <- normalise_names(expected, ignore.order, ignore.case) - act$names <- normalise_names(act$names, ignore.order, ignore.case) + return(expect_has_names_(act)) + } + + exp <- quasi_label(enquo(expected), arg = "expected") - if (!identical(act$names, exp_names)) { - msg <- sprintf( - "Names of %s (%s) don't match %s", - act$lab, - paste0("'", act$names, "'", collapse = ", "), - paste0("'", exp_names, "'", collapse = ", ") - ) - return(fail(msg, info = info)) - } + exp$val <- normalise_names(exp$val, ignore.order, ignore.case) + act_names <- normalise_names(names(act$val), ignore.order, ignore.case) + + if (ignore.order) { + act <- labelled_value(act_names, act$lab) + return(expect_setequal_(act, exp, error_prefix = "Names of ")) + } else { + act <- labelled_value(act_names, act$lab) + return(expect_waldo_equal_("equal", act, exp, error_prefix = "Names of ")) } + pass(act$val) } @@ -74,3 +71,12 @@ normalise_names <- function(x, ignore.order = FALSE, ignore.case = FALSE) { x } + +expect_has_names_ <- function(act, trace_env = caller_env()) { + act_names <- names(act$val) + if (identical(act_names, NULL)) { + msg <- sprintf("%s does not have names.", act$lab) + return(fail(msg, trace_env = trace_env)) + } + return(pass(act$val)) +} diff --git a/R/expect-setequal.R b/R/expect-setequal.R index 34e1ea904..3a39e07be 100644 --- a/R/expect-setequal.R +++ b/R/expect-setequal.R @@ -34,11 +34,23 @@ expect_setequal <- function(object, expected) { testthat_warn("expect_setequal() ignores names") } + expect_setequal_(act, exp) +} + +expect_setequal_ <- function( + act, + exp, + trace_env = caller_env(), + error_prefix = NULL +) { 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)) { - return(fail(paste0( + msg <- paste0( + if (!is.null(error_prefix)) { + error_prefix + }, act$lab, " (`actual`) and ", exp$lab, @@ -49,7 +61,8 @@ expect_setequal <- function(object, expected) { if (length(exp_miss)) { paste0("* Only in `expected`: ", values(exp_miss), "\n") } - ))) + ) + return(fail(msg, trace_env = trace_env)) } pass(act$val) } diff --git a/tests/testthat/_snaps/expect-named.md b/tests/testthat/_snaps/expect-named.md index 21b3225cc..3a54b0219 100644 --- a/tests/testthat/_snaps/expect-named.md +++ b/tests/testthat/_snaps/expect-named.md @@ -1,3 +1,43 @@ +# provide useful feedback on failure + + Names of c(a = 1) (`actual`) and c("a", "b") (`expected`) don't have the same values. + * Only in `expected`: "b" + + +--- + + Names of c(a = 1, b = 1) (`actual`) and c("a") (`expected`) don't have the same values. + * Only in `actual`: "b" + + +--- + + Names of c(a = 1) (`actual`) and c("b") (`expected`) don't have the same values. + * Only in `actual`: "a" + * Only in `expected`: "b" + + +--- + + Names of c(a = 1) (`actual`) is not equal to c("a", "b") (`expected`). + + `actual`: "a" + `expected`: "a" "b" + +--- + + Names of c(a = 1, b = 1) (`actual`) is not equal to c("a") (`expected`). + + `actual`: "a" "b" + `expected`: "a" + +--- + + Names of c(a = 1) (`actual`) is not equal to c("b") (`expected`). + + `actual`: "a" + `expected`: "b" + # expect_named validates its inputs Code diff --git a/tests/testthat/test-expect-named.R b/tests/testthat/test-expect-named.R index e04d42bb8..c25bedc69 100644 --- a/tests/testthat/test-expect-named.R +++ b/tests/testthat/test-expect-named.R @@ -20,9 +20,41 @@ test_that("expected_named optionally ignores order", { )) }) +test_that("provide useful feedback on failure", { + expect_snapshot_error( + expect_named(c(a = 1), c("a", "b"), ignore.order = TRUE) + ) + expect_snapshot_error( + expect_named(c(a = 1, b = 1), c("a"), ignore.order = TRUE) + ) + expect_snapshot_error( + expect_named(c(a = 1), c("b"), ignore.order = TRUE) + ) + + expect_snapshot_error( + expect_named(c(a = 1), c("a", "b"), ignore.order = FALSE) + ) + expect_snapshot_error( + expect_named(c(a = 1, b = 1), c("a"), ignore.order = FALSE) + ) + expect_snapshot_error( + expect_named(c(a = 1), c("b"), ignore.order = FALSE) + ) +}) + test_that("expect_named validates its inputs", { expect_snapshot(error = TRUE, { expect_named(c(a = 1), "a", ignore.order = "yes") expect_named(c(a = 1), "a", ignore.case = "yes") }) }) + +test_that("expect_named accepts glue for 'expected'", { + n <- structure( + c("v1", "v2", "v3", "v4", "v5"), + class = c("glue", "character") + ) + v <- set_names(1:5, n) + + expect_named(v, n) +})