diff --git a/NEWS.md b/NEWS.md index 983e3356f..80f650de6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # testthat (development version) +* Expectations now consistently return the value of the first argument, regardless of whether the expectation succeeds or fails. The primary exception are `expect_message()` and friends which will return the condition. This shouldn't affect existing tests, but will make failures clearer when you chain together multiple expectations (#2246). * `set_state_inspector()` gains `tolerance` argument and ignores minor FP differences by default (@mcol, #2237). * `expect_vector()` fails, instead of erroring, if `object` is not a vector (@plietar, #2224). * New `vignette("mocking")` explains mocking in detail (#1265). diff --git a/R/expect-comparison.R b/R/expect-comparison.R index 27b0915a5..2558e8bd5 100644 --- a/R/expect-comparison.R +++ b/R/expect-comparison.R @@ -28,45 +28,52 @@ expect_compare_ <- function( operator <- match.arg(operator) op <- match.fun(operator) - actual_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<") - cmp <- op(act$val, exp$val) if (length(cmp) != 1 || !is.logical(cmp)) { cli::cli_abort( - "Result of comparison must be a single logical value.", + "Result of comparison must be `TRUE`, `FALSE`, or `NA`", call = trace_env ) + } else if (!isTRUE(cmp)) { + msg <- failure_compare(act, exp, operator) + fail(msg, trace_env = trace_env) + } else { + pass() } - if (!isTRUE(cmp)) { - diff <- act$val - exp$val - msg_exp <- sprintf("Expected %s %s %s.", act$lab, operator, exp$lab) - - digits <- max( - digits(act$val), - digits(exp$val), - min_digits(act$val, exp$val) - ) +} - msg_act <- sprintf( - "Actual comparison: %s %s %s", - num_exact(act$val, digits), - actual_op, - num_exact(exp$val, digits) - ) +failure_compare <- function(act, exp, operator) { + actual_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<") - if (is.na(diff)) { - msg_diff <- NULL - } else { - msg_diff <- sprintf( - "Difference: %s %s 0", - num_exact(diff, digits), - actual_op - ) - } - return(fail(c(msg_exp, msg_act, msg_diff), trace_env = trace_env)) + diff <- act$val - exp$val + msg_exp <- sprintf("Expected %s %s %s.", act$lab, operator, exp$lab) + + digits <- max( + digits(act$val), + digits(exp$val), + min_digits(act$val, exp$val) + ) + + msg_act <- sprintf( + "Actual comparison: %s %s %s", + num_exact(act$val, digits), + actual_op, + num_exact(exp$val, digits) + ) + + if (is.na(diff)) { + msg_diff <- NULL + } else { + msg_diff <- sprintf( + "Difference: %s %s 0", + num_exact(diff, digits), + actual_op + ) } - pass(act$val) + + c(msg_exp, msg_act, msg_diff) } + #' @export #' @rdname comparison-expectations expect_lt <- function(object, expected, label = NULL, expected.label = NULL) { @@ -74,6 +81,7 @@ expect_lt <- function(object, expected, label = NULL, expected.label = NULL) { exp <- quasi_label(enquo(expected), expected.label) expect_compare_("<", act, exp) + invisible(act$val) } #' @export @@ -83,6 +91,7 @@ expect_lte <- function(object, expected, label = NULL, expected.label = NULL) { exp <- quasi_label(enquo(expected), expected.label) expect_compare_("<=", act, exp) + invisible(act$val) } #' @export @@ -92,6 +101,7 @@ expect_gt <- function(object, expected, label = NULL, expected.label = NULL) { exp <- quasi_label(enquo(expected), expected.label) expect_compare_(">", act, exp) + invisible(act$val) } #' @export @@ -101,6 +111,7 @@ expect_gte <- function(object, expected, label = NULL, expected.label = NULL) { exp <- quasi_label(enquo(expected), expected.label) expect_compare_(">=", act, exp) + invisible(act$val) } diff --git a/R/expect-condition.R b/R/expect-condition.R index c7414fead..b92e09619 100644 --- a/R/expect-condition.R +++ b/R/expect-condition.R @@ -143,9 +143,11 @@ expect_error <- function( # Access error fields with `[[` rather than `$` because the # `$.Throwable` from the rJava package throws with unknown fields if (!is.null(msg)) { - return(fail(msg, info = info, trace = act$cap[["trace"]])) + fail(msg, info = info, trace = act$cap[["trace"]]) + } else { + pass() } - pass(act$val %||% act$cap) + invisible(act$val %||% act$cap) } } @@ -198,9 +200,11 @@ expect_warning <- function( cond_type = "warnings" ) if (!is.null(msg)) { - return(fail(msg, info = info)) + fail(msg, info = info) + } else { + pass() } - pass(act$val) + invisible(act$val) } } @@ -236,9 +240,11 @@ expect_message <- function( act <- quasi_capture(enquo(object), label, capture_messages) msg <- compare_messages(act$cap, act$lab, regexp = regexp, all = all, ...) if (!is.null(msg)) { - return(fail(msg, info = info)) + fail(msg, info = info) + } else { + pass() } - pass(act$val) + invisible(act$val) } } @@ -285,9 +291,11 @@ expect_condition <- function( cond_type = "condition" ) if (!is.null(msg)) { - return(fail(msg, info = info, trace = act$cap[["trace"]])) + fail(msg, info = info, trace = act$cap[["trace"]]) + } else { + pass() } - pass(act$val %||% act$cap) + invisible(act$val %||% act$cap) } } @@ -327,16 +335,18 @@ expect_condition_matching_ <- function( # Access error fields with `[[` rather than `$` because the # `$.Throwable` from the rJava package throws with unknown fields if (!is.null(msg)) { - return(fail( + fail( msg, info = info, trace = act$cap[["trace"]], trace_env = trace_env - )) + ) + } else { + pass() } # If a condition was expected, return it. Otherwise return the value # of the expression. - pass(if (expected) act$cap else act$val) + invisible(if (expected) act$cap else act$val) } # ------------------------------------------------------------------------- diff --git a/R/expect-constant.R b/R/expect-constant.R index e6ca95d25..b4b0917d4 100644 --- a/R/expect-constant.R +++ b/R/expect-constant.R @@ -31,7 +31,9 @@ NULL expect_true <- function(object, info = NULL, label = NULL) { act <- quasi_label(enquo(object), label) exp <- labelled_value(TRUE, "TRUE") + expect_waldo_constant_(act, exp, info = info, ignore_attr = TRUE) + invisible(act$val) } #' @export @@ -39,7 +41,9 @@ expect_true <- function(object, info = NULL, label = NULL) { expect_false <- function(object, info = NULL, label = NULL) { act <- quasi_label(enquo(object), label) exp <- labelled_value(FALSE, "FALSE") + expect_waldo_constant_(act, exp, info = info, ignore_attr = TRUE) + invisible(act$val) } #' Do you expect `NULL`? @@ -59,7 +63,9 @@ expect_false <- function(object, info = NULL, label = NULL) { expect_null <- function(object, info = NULL, label = NULL) { act <- quasi_label(enquo(object), label) exp <- labelled_value(NULL, "NULL") + expect_waldo_constant_(act, exp, info = info) + invisible(act$val) } expect_waldo_constant_ <- function( @@ -82,7 +88,8 @@ expect_waldo_constant_ <- function( "Differences:", paste0(comp, collpase = "\n") ) - return(fail(msg, info = info, trace_env = trace_env)) + fail(msg, info = info, trace_env = trace_env) + } else { + pass() } - pass(act$val) } diff --git a/R/expect-equality.R b/R/expect-equality.R index c01665603..f59cfc156 100644 --- a/R/expect-equality.R +++ b/R/expect-equality.R @@ -76,16 +76,18 @@ expect_equal <- function( comp <- compare(act$val, exp$val, ...) } - if (!comp$equal) { + if (comp$equal) { + pass() + } else { msg <- c( sprintf("Expected %s to equal %s.", act$lab, exp$lab), "Differences:", comp$message ) - return(fail(msg, info = info)) + fail(msg, info = info) } - pass(act$val) } + invisible(act$val) } @@ -105,9 +107,8 @@ expect_identical <- function( if (edition_get() >= 3) { expect_waldo_equal_("identical", act, exp, info, ...) } else { - ident <- identical(act$val, exp$val, ...) - if (ident) { - msg_act <- NULL + if (identical(act$val, exp$val, ...)) { + pass() } else { compare <- compare(act$val, exp$val) if (compare$equal) { @@ -115,18 +116,16 @@ expect_identical <- function( } else { msg_act <- compare$message } - } - if (!ident) { msg <- c( sprintf("Expected %s to be identical to %s.", act$lab, exp$lab), "Differences:", msg_act ) - return(fail(msg, info = info)) + fail(msg, info = info) } - pass(act$val) } + invisible(act$val) } expect_waldo_equal_ <- function( @@ -144,15 +143,16 @@ expect_waldo_equal_ <- function( x_arg = "actual", y_arg = "expected" ) - if (length(comp) != 0) { + if (length(comp) == 0) { + pass() + } else { msg <- c( sprintf("Expected %s to be %s to %s.", act$lab, type, exp$lab), "Differences:", paste0(comp, collpase = "\n") ) - return(fail(msg, info = info, trace_env = trace_env)) + fail(msg, info = info, trace_env = trace_env) } - pass(act$val) } #' Is an object equal to the expected value, ignoring attributes? @@ -203,7 +203,9 @@ expect_equivalent <- function( exp$lab, comp$message ) - return(fail(msg, info = info)) + fail(msg, info = info) + } else { + pass() } - pass(act$val) + invisible(act$val) } diff --git a/R/expect-inheritance.R b/R/expect-inheritance.R index 6b55f95c5..316626816 100644 --- a/R/expect-inheritance.R +++ b/R/expect-inheritance.R @@ -70,13 +70,14 @@ expect_type <- function(object, type) { act_type <- typeof(act$val) if (!identical(act_type, type)) { - msg <- c( + fail(c( sprintf("Expected %s to have type %s.", act$lab, format_class(type)), sprintf("Actual type: %s", format_class(act_type)) - ) - return(fail(msg)) + )) + } else { + pass() } - pass(act$val) + invisible(act$val) } #' @export @@ -93,38 +94,34 @@ expect_s3_class <- function(object, class, exact = FALSE) { if (identical(class, NA)) { if (isS3(object)) { - msg <- sprintf("Expected %s not to be an S3 object.", act$lab) - return(fail(msg)) + fail(sprintf("Expected %s not to be an S3 object.", act$lab)) + } else { + pass() } } else if (is.character(class)) { if (!isS3(act$val)) { - msg <- c( + fail(c( sprintf("Expected %s to be an S3 object.", act$lab), sprintf("Actual OO type: %s.", oo_type(act$val)) - ) - return(fail(msg)) - } else if (exact) { - if (!identical(class(act$val), class)) { - msg <- c( - sprintf("Expected %s to have class %s.", act$lab, exp_lab), - sprintf("Actual class: %s.", act$class) - ) - return(fail(msg)) - } + )) + } else if (exact && !identical(class(act$val), class)) { + fail(c( + sprintf("Expected %s to have class %s.", act$lab, exp_lab), + sprintf("Actual class: %s.", act$class) + )) + } else if (!inherits(act$val, class)) { + fail(c( + sprintf("Expected %s to inherit from %s.", act$lab, exp_lab), + sprintf("Actual class: %s.", act$class) + )) } else { - if (!inherits(act$val, class)) { - msg <- c( - sprintf("Expected %s to inherit from %s.", act$lab, exp_lab), - sprintf("Actual class: %s.", act$class) - ) - return(fail(msg)) - } + pass() } } else { stop_input_type(class, c("a character vector", "NA")) } - pass(act$val) + invisible(act$val) } #' @export @@ -136,30 +133,29 @@ expect_s4_class <- function(object, class) { if (identical(class, NA)) { if (isS4(object)) { - msg <- sprintf("Expected %s not to be an S4 object.", act$lab) - return(fail(msg)) + fail(sprintf("Expected %s not to be an S4 object.", act$lab)) + } else { + pass() } } else if (is.character(class)) { if (!isS4(act$val)) { - msg <- c( + fail(c( sprintf("Expected %s to be an S4 object.", act$lab), sprintf("Actual OO type: %s.", oo_type(act$val)) - ) - return(fail(msg)) + )) + } else if (!methods::is(act$val, class)) { + fail(c( + sprintf("Expected %s to inherit from %s.", act$lab, exp_lab), + sprintf("Actual class: %s.", act$class) + )) } else { - if (!methods::is(act$val, class)) { - msg <- c( - sprintf("Expected %s to inherit from %s.", act$lab, exp_lab), - sprintf("Actual class: %s.", act$class) - ) - return(fail(msg)) - } + pass() } } else { stop_input_type(class, c("a character vector", "NA")) } - pass(act$val) + invisible(act$val) } #' @export @@ -169,24 +165,22 @@ expect_r6_class <- function(object, class) { check_string(class) if (!inherits(act$val, "R6")) { - msg <- c( + fail(c( sprintf("Expected %s to be an R6 object.", act$lab), sprintf("Actual OO type: %s.", oo_type(act$val)) - ) - return(fail(msg)) - } - - if (!inherits(act$val, class)) { + )) + } else if (!inherits(act$val, class)) { act_class <- format_class(class(act$val)) exp_class <- format_class(class) - msg <- c( + fail(c( sprintf("Expected %s to inherit from %s.", act$lab, exp_class), sprintf("Actual class: %s.", act_class) - ) - return(fail(msg)) + )) + } else { + pass() } - pass(act$val) + invisible(act$val) } #' @export @@ -200,26 +194,24 @@ expect_s7_class <- function(object, class) { act <- quasi_label(enquo(object)) if (!S7::S7_inherits(object)) { - msg <- c( + fail(c( sprintf("Expected %s to be an S7 object.", act$lab), sprintf("Actual OO type: %s.", oo_type(act$val)) - ) - return(fail(msg)) - } - - if (!S7::S7_inherits(object, class)) { + )) + } else if (!S7::S7_inherits(object, class)) { exp_class <- attr(class, "name", TRUE) act_class <- setdiff(base::class(object), "S7_object") act_class_desc <- paste0("<", act_class, ">", collapse = "/") - msg <- c( + fail(c( sprintf("Expected %s to inherit from <%s>.", act$lab, exp_class), sprintf("Actual class: %s.", act_class_desc) - ) - return(fail(msg)) + )) + } else { + pass() } - pass(act$val) + invisible(act$val) } #' Do you expect to inherit from this class? @@ -260,9 +252,11 @@ expect_is <- function(object, class, info = NULL, label = NULL) { exp_lab, act$class ) - return(fail(msg, info = info)) + fail(msg, info = info) + } else { + pass() } - pass(act$val) + invisible(act$val) } # Helpers ---------------------------------------------------------------------- diff --git a/R/expect-invisible.R b/R/expect-invisible.R index 9ae1ec596..cc88f4182 100644 --- a/R/expect-invisible.R +++ b/R/expect-invisible.R @@ -25,13 +25,14 @@ expect_invisible <- function(call, label = NULL) { vis <- withVisible(call) if (!identical(vis$visible, FALSE)) { - msg <- c( + fail(c( sprintf("Expected %s to return invisibly.", lab), "Actual visibility: visible." - ) - return(fail(msg)) + )) + } else { + pass() } - pass(vis$value) + invisible(vis$value) } #' @export @@ -41,11 +42,12 @@ expect_visible <- function(call, label = NULL) { vis <- withVisible(call) if (!identical(vis$visible, TRUE)) { - msg <- c( + fail(c( sprintf("Expected %s to return visibly.", lab), "Actual visibility: invisible." - ) - return(fail(msg)) + )) + } else { + pass() } - pass(vis$value) + invisible(vis$value) } diff --git a/R/expect-known.R b/R/expect-known.R index 98f32c866..c8ef59fab 100644 --- a/R/expect-known.R +++ b/R/expect-known.R @@ -73,15 +73,23 @@ expect_known_output <- function( act$lab <- label %||% quo_label(act$quo) act <- append(act, eval_with_output(object, print = print, width = width)) - compare_file(file, act$out, update = update, info = info, ...) + expect_file_unchanged_(file, act$out, update = update, info = info, ...) invisible(act$val) } -compare_file <- function(path, lines, ..., update = TRUE, info = NULL) { +expect_file_unchanged_ <- function( + path, + lines, + ..., + update = TRUE, + info = NULL, + trace_env = caller_env() +) { if (!file.exists(path)) { cli::cli_warn("Creating reference output.") brio::write_lines(lines, path) - return(pass(NULL)) + pass() + return() } old_lines <- brio::read_lines(path) @@ -108,9 +116,10 @@ compare_file <- function(path, lines, ..., update = TRUE, info = NULL) { encodeString(path, quote = "'"), paste0(comp, collapse = "\n\n") ) - return(fail(msg, info = info, trace_env = caller_env())) + fail(msg, info = info, trace_env = trace_env) + } else { + pass() } - pass(NULL) } #' Do you expect the output/result to equal a known good value? @@ -151,7 +160,7 @@ expect_output_file <- function( act$lab <- label %||% quo_label(act$quo) act <- append(act, eval_with_output(object, print = print, width = width)) - compare_file(file, act$out, update = update, info = info, ...) + expect_file_unchanged_(file, act$out, update = update, info = info, ...) invisible(act$val) } @@ -180,6 +189,7 @@ expect_known_value <- function( if (!file.exists(file)) { cli::cli_warn("Creating reference value.") saveRDS(object, file, version = version) + pass() } else { ref_val <- readRDS(file) comp <- compare(act$val, ref_val, ...) @@ -194,11 +204,13 @@ expect_known_value <- function( encodeString(file, quote = "'"), comp$message ) - return(fail(msg, info = info)) + fail(msg, info = info) + } else { + pass() } } - pass(act$value) + invisible(act$val) } #' @export @@ -233,18 +245,20 @@ expect_known_hash <- function(object, hash = NULL) { if (is.null(hash)) { cli::cli_warn("No recorded hash: use {substr(act_hash, 1, 10)}.") + pass() } else { if (hash != act_hash) { - msg <- sprintf( + fail(sprintf( "Expected value to hash to %s.\nActual hash: %s", hash, act_hash - ) - return(fail(msg)) + )) + } else { + pass() } } - pass(act$value) + invisible(act$val) } all_utf8 <- function(x) { diff --git a/R/expect-match.R b/R/expect-match.R index 1fc952b47..7abc76446 100644 --- a/R/expect-match.R +++ b/R/expect-match.R @@ -46,21 +46,25 @@ expect_match <- function( check_bool(all) if (length(object) == 0) { - msg <- sprintf("Expected %s to have at least one element.", act$lab) - return(fail(msg, info = info)) + fail( + sprintf("Expected %s to have at least one element.", act$lab), + info = info + ) + } else { + expect_match_( + act = act, + regexp = regexp, + perl = perl, + fixed = fixed, + ..., + all = all, + info = info, + label = label, + negate = FALSE + ) } - expect_match_( - act = act, - regexp = regexp, - perl = perl, - fixed = fixed, - ..., - all = all, - info = info, - label = label, - negate = FALSE - ) + invisible(act$val) } #' @describeIn expect_match Check that a string doesn't match a regular @@ -95,6 +99,7 @@ expect_no_match <- function( label = label, negate = TRUE ) + invisible(act$val) } expect_match_ <- function( @@ -114,28 +119,28 @@ expect_match_ <- function( condition <- if (negate) !matches else matches ok <- if (all) all(condition) else any(condition) - if (ok) { - return(pass(act$val)) - } - - values <- show_text(act$val, condition) - if (length(act$val) == 1) { - which <- "" + if (!ok) { + values <- show_text(act$val, condition) + if (length(act$val) == 1) { + which <- "" + } else { + which <- if (all) "every element of " else "some element of " + } + match <- if (negate) "not to match" else "to match" + + msg_exp <- sprintf( + "Expected %s%s %s %s %s.", + which, + act$lab, + match, + if (fixed) "string" else "regexp", + encodeString(regexp, quote = '"') + ) + msg_act <- c(paste0("Actual ", title, ':'), values) + fail(c(msg_exp, msg_act), info = info, trace_env = trace_env) } else { - which <- if (all) "every element of " else "some element of " + pass() } - match <- if (negate) "not to match" else "to match" - - msg_exp <- sprintf( - "Expected %s%s %s %s %s.", - which, - act$lab, - match, - if (fixed) "string" else "regexp", - encodeString(regexp, quote = '"') - ) - msg_act <- c(paste0("Actual ", title, ':'), values) - return(fail(c(msg_exp, msg_act), info = info, trace_env = trace_env)) } diff --git a/R/expect-named.R b/R/expect-named.R index 4a71ca121..a313ecf71 100644 --- a/R/expect-named.R +++ b/R/expect-named.R @@ -38,23 +38,30 @@ expect_named <- function( act <- quasi_label(enquo(object), label) if (missing(expected)) { - return(expect_has_names_(act)) - } - - exp <- quasi_label(enquo(expected), arg = "expected") + act_names <- names(act$val) + if (is.null(act_names)) { + msg <- sprintf("Expected %s to have names.", act$lab) + fail(msg) + } else { + pass() + } + } else { + exp <- quasi_label(enquo(expected), arg = "expected") - exp$val <- normalise_names(exp$val, ignore.order, ignore.case) - act_names <- normalise_names(names(act$val), ignore.order, ignore.case) + exp$val <- normalise_names(exp$val, ignore.order, ignore.case) + act_names <- labelled_value( + normalise_names(names(act$val), ignore.order, ignore.case), + paste0("names of ", act$lab) + ) - if (ignore.order) { - act <- labelled_value(act_names, paste0("names(", act$lab, ")")) - return(expect_setequal_(act, exp)) - } else { - act <- labelled_value(act_names, paste0("names(", act$lab, ")")) - return(expect_waldo_equal_("equal", act, exp)) + if (ignore.order) { + expect_setequal_(act_names, exp) + } else { + expect_waldo_equal_("equal", act_names, exp) + } } - pass(act$val) + invisible(act$val) } normalise_names <- function(x, ignore.order = FALSE, ignore.case = FALSE) { @@ -71,12 +78,3 @@ 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("Expected %s to have names.", act$lab) - return(fail(msg, trace_env = trace_env)) - } - return(pass(act$val)) -} diff --git a/R/expect-no-condition.R b/R/expect-no-condition.R index 50b939fb2..46e0fab10 100644 --- a/R/expect-no-condition.R +++ b/R/expect-no-condition.R @@ -119,10 +119,12 @@ expect_no_ <- function( "." ) msg_act <- actual_condition(first_match) - return(fail(c(msg_exp, msg_act), trace_env = trace_env)) + fail(c(msg_exp, msg_act), trace_env = trace_env) + } else { + pass() } - pass(act$val) + invisible(act$val) } indent_lines <- function(x) { diff --git a/R/expect-output.R b/R/expect-output.R index fea13a7a4..8f58acb64 100644 --- a/R/expect-output.R +++ b/R/expect-output.R @@ -40,17 +40,21 @@ expect_output <- function( sprintf("Expected %s to produce no output.", act$lab), sprintf("Actual output:\n%s", encodeString(act$cap)) ) - return(fail(msg, info = info)) + fail(msg, info = info) + } else { + pass() } - pass(act$val) } else if (is.null(regexp) || identical(act$cap, "")) { if (identical(act$cap, "")) { msg <- sprintf("Expected %s to produce output.", act$lab) - return(fail(msg, info = info)) + fail(msg, info = info) + } else { + pass() } - pass(act$val) } else { - act <- labelled_value(act$cap, act$lab) - expect_match_(act, enc2native(regexp), ..., title = "output") + act_out <- labelled_value(act$cap, paste0("output from ", act$lab)) + expect_match_(act_out, enc2native(regexp), ..., title = "output") } + + invisible(act$val) } diff --git a/R/expect-reference.R b/R/expect-reference.R index 6f23b3c7d..64d90c8d1 100644 --- a/R/expect-reference.R +++ b/R/expect-reference.R @@ -28,9 +28,11 @@ expect_reference <- function( if (!is_reference(act$val, exp$val)) { msg <- sprintf("Expected %s to be a reference to %s.", act$lab, exp$lab) - return(fail(msg, info = info)) + fail(msg, info = info) + } else { + pass() } - pass(act$val) + invisible(act$val) } # expect_reference() needs dev version of rlang diff --git a/R/expect-self-test.R b/R/expect-self-test.R index a0a565b80..12cee8d26 100644 --- a/R/expect-self-test.R +++ b/R/expect-self-test.R @@ -46,23 +46,18 @@ capture_success_failure <- function(expr) { expect_success <- function(expr) { status <- capture_success_failure(expr) + expected <- "Expected exactly one success and no failures." if (status$n_success != 1) { - msg <- c( - "Expected one success.", - sprintf("Actually succeeded %i times", status$n_success) - ) - return(fail(msg)) + actual <- sprintf("Actually succeeded %i times", status$n_success) + fail(c(expected, actual)) + } else if (status$n_failure > 0) { + actual <- sprintf("Actually failed %i times", status$n_failure) + fail(c(expected, actual)) + } else { + pass() } - if (status$n_failure > 0) { - msg <- c( - "Expected zero failures.", - sprintf("Actually failed %i times", status$n_failure) - ) - return(fail(msg)) - } - - pass(NULL) + invisible() } #' @export @@ -70,27 +65,22 @@ expect_success <- function(expr) { expect_failure <- function(expr, message = NULL, ...) { status <- capture_success_failure(expr) + expected <- "Expected exactly one failure and no successes." if (status$n_failure != 1) { - msg <- c( - "Expected one failure.", - sprintf("Actually failed %i times", status$n_failure) - ) - return(fail(msg)) - } - - if (status$n_success != 0) { - msg <- c( - "Expected zero successes.", - sprintf("Actually succeeded %i times", status$n_success) - ) - return(fail(msg)) - } - - if (!is.null(message)) { - act <- labelled_value(status$last_failure$message, "failure message") - return(expect_match_(act, message, ..., title = "message")) + actual <- sprintf("Actually failed %i times", status$n_failure) + fail(c(expected, actual)) + } else if (status$n_success != 0) { + actual <- sprintf("Actually succeeded %i times", status$n_success) + fail(c(expected, actual)) + } else { + if (is.null(message)) { + pass() + } else { + act <- labelled_value(status$last_failure$message, "failure message") + expect_match_(act, message, ..., title = "message") + } } - pass(NULL) + invisible() } #' @export @@ -116,9 +106,11 @@ expect_no_success <- function(expr) { status <- capture_success_failure(expr) if (status$n_success > 0) { - return(fail("Expectation succeeded")) + fail("Expectation succeeded") + } else { + pass() } - pass(NULL) + invisible() } #' @export @@ -128,9 +120,11 @@ expect_no_failure <- function(expr) { status <- capture_success_failure(expr) if (status$n_failure > 0) { - return(fail("Expectation failed")) + fail("Expectation failed") + } else { + pass() } - pass(NULL) + invisible() } expect_snapshot_skip <- function(x, cran = FALSE) { diff --git a/R/expect-setequal.R b/R/expect-setequal.R index f9a53839f..d52e80f08 100644 --- a/R/expect-setequal.R +++ b/R/expect-setequal.R @@ -45,7 +45,9 @@ expect_setequal_ <- function( 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)) { + if (length(exp_miss) == 0 && length(act_miss) == 0) { + pass() + } else { msg_exp <- sprintf( "Expected %s to have the same values as %s.", act$lab, @@ -57,10 +59,10 @@ expect_setequal_ <- function( if (length(act_miss)) sprintf("Needs: %s", values(act_miss)), if (length(exp_miss)) sprintf("Absent: %s", values(exp_miss)) ) - - return(fail(c(msg_exp, msg_act), trace_env = trace_env)) + fail(c(msg_exp, msg_act), trace_env = trace_env) } - pass(act$val) + + invisible(act$val) } values <- function(x) { @@ -88,6 +90,7 @@ expect_mapequal <- function(object, expected) { exp <- quasi_label(enquo(expected)) expect_waldo_equal_("equal", act, exp, list_as_map = TRUE) + invisible(act$val) } #' @export @@ -112,9 +115,11 @@ expect_contains <- function(object, expected) { sprintf("Missing: %s", values(exp$val[exp_miss])) ) fail(c(msg_exp, msg_act)) + } else { + pass() } - pass(act$val) + invisible(act$val) } #' @export @@ -139,9 +144,11 @@ expect_in <- function(object, expected) { sprintf("Invalid: %s", values(act$val[act_miss])) ) fail(c(msg_exp, msg_act)) + } else { + pass() } - pass(act$val) + invisible(act$val) } # Helpers ---------------------------------------------------------------------- diff --git a/R/expect-shape.R b/R/expect-shape.R index c7c1ae311..219c79cb5 100644 --- a/R/expect-shape.R +++ b/R/expect-shape.R @@ -28,13 +28,14 @@ expect_length <- function(object, n) { act$n <- length(act$val) if (act$n != n) { - msg <- c( + fail(c( sprintf("Expected %s to have length %i.", act$lab, n), sprintf("Actual length: %i.", act$n) - ) - return(fail(msg)) + )) + } else { + pass() } - pass(act$val) + invisible(act$val) } #' @param nrow,ncol Expected [nrow()]/[ncol()] of `object`. @@ -49,36 +50,35 @@ expect_shape = function(object, ..., nrow, ncol, dim) { dim_object <- base::dim(object) if (is.null(dim_object)) { - return(fail(sprintf("Expected %s to have dimensions.", act$lab))) - } - - if (!missing(nrow)) { + fail(sprintf("Expected %s to have dimensions.", act$lab)) + } else if (!missing(nrow)) { check_number_whole(nrow, allow_na = TRUE) act$nrow <- dim_object[1L] if (!identical(as.integer(act$nrow), as.integer(nrow))) { - msg <- c( + fail(c( sprintf("Expected %s to have %i rows.", act$lab, nrow), sprintf("Actual rows: %i.", act$nrow) - ) - return(fail(msg)) + )) + } else { + pass() } } else if (!missing(ncol)) { check_number_whole(ncol, allow_na = TRUE) if (length(dim_object) == 1L) { - msg <- sprintf("Expected %s to have two or more dimensions.", act$lab) - return(fail(msg)) - } + fail(sprintf("Expected %s to have two or more dimensions.", act$lab)) + } else { + act$ncol <- dim_object[2L] - act$ncol <- dim_object[2L] - - if (!identical(as.integer(act$ncol), as.integer(ncol))) { - msg <- c( - sprintf("Expected %s to have %i columns.", act$lab, ncol), - sprintf("Actual columns: %i.", act$ncol) - ) - return(fail(msg)) + if (!identical(as.integer(act$ncol), as.integer(ncol))) { + fail(c( + sprintf("Expected %s to have %i columns.", act$lab, ncol), + sprintf("Actual columns: %i.", act$ncol) + )) + } else { + pass() + } } } else { # !missing(dim) @@ -88,20 +88,19 @@ expect_shape = function(object, ..., nrow, ncol, dim) { act$dim <- dim_object if (length(act$dim) != length(dim)) { - msg <- c( + fail(c( sprintf("Expected %s to have %i dimensions.", act$lab, length(dim)), sprintf("Actual dimensions: %i.", length(act$dim)) - ) - } - - if (!identical(as.integer(act$dim), as.integer(dim))) { - msg <- c( + )) + } else if (!identical(as.integer(act$dim), as.integer(dim))) { + fail(c( sprintf("Expected %s to have dim (%s).", act$lab, toString(dim)), sprintf("Actual dim: (%s).", toString(act$dim)) - ) - return(fail(msg)) + )) + } else { + pass() } } - pass(act$val) + invisible(act$val) } diff --git a/R/expect-silent.R b/R/expect-silent.R index 7d96c5fec..adcc11666 100644 --- a/R/expect-silent.R +++ b/R/expect-silent.R @@ -27,11 +27,12 @@ expect_silent <- function(object) { ) if (length(outputs) != 0) { - msg <- c( + fail(c( sprintf("Expected %s to run silently.", act$lab), sprintf("Actual noise: %s.", paste(outputs, collapse = ", ")) - ) - return(fail(msg)) + )) + } else { + pass() } - pass(act$cap$result) + invisible(act$cap$result) } diff --git a/R/expect-that.R b/R/expect-that.R index 730f3b2fb..0299e22ac 100644 --- a/R/expect-that.R +++ b/R/expect-that.R @@ -2,8 +2,9 @@ #' #' @description #' These are the primitives that you can use to implement your own expectations. -#' Regardless of how it's called an expectation should either return `pass()`, -#' `fail()`, or throw an error (if for example, the arguments are invalid). +#' Every path through an expectation should either call `pass()`, `fail()`, +#' or throw an error (e.g. if the arguments are invalid). Expectations should +#' always return `invisible(act$val)`. #' #' Learn more about creating your own expectations in #' `vignette("custom-expectation")`. @@ -28,11 +29,12 @@ #' #' act_n <- length(act$val) #' if (act_n != n) { -#' msg <- sprintf("%s has length %i, not length %i.", act$lab, act_n, n) -#' return(fail(msg)) +#' fail(sprintf("%s has length %i, not length %i.", act$lab, act_n, n)) +#' } else { +#' pass() #' } #' -#' pass(act$val) +#' invisible(act$val) #' } fail <- function( message = "Failure has been forced", @@ -44,12 +46,14 @@ fail <- function( trace <- trace %||% capture_trace(trace_env) message <- paste(c(message, info), collapse = "\n") expectation("failure", message, srcref = srcref, trace = trace) + invisible() } snapshot_fail <- function(message, trace_env = caller_env()) { trace <- capture_trace(trace_env) message <- paste(message, collapse = "\n") expectation("failure", message, trace = trace, snapshot = TRUE) + invisible() } capture_trace <- function(trace_env) { @@ -62,12 +66,10 @@ capture_trace <- function(trace_env) { } #' @rdname fail -#' @param value Value to return, typically the result of evaluating the -#' `object` argument to the expectation. #' @export -pass <- function(value) { +pass <- function() { expectation("success", "success") - invisible(value) + invisible() } #' Mark a test as successful diff --git a/R/expect-vector.R b/R/expect-vector.R index 048337da4..5fd1752fc 100644 --- a/R/expect-vector.R +++ b/R/expect-vector.R @@ -22,15 +22,21 @@ expect_vector <- function(object, ptype = NULL, size = NULL) { # added by as_label() act$lab <- gsub("^`|`$", "", act$lab) + failed <- FALSE withCallingHandlers( vctrs::vec_assert(act$val, ptype = ptype, size = size, arg = act$lab), vctrs_error_scalar_type = function(e) { + failed <<- TRUE fail(e$message) }, vctrs_error_assert = function(e) { + failed <<- TRUE fail(e$message) } ) - pass(act$val) + if (!failed) { + pass() + } + invisible(act$val) } diff --git a/R/expectation.R b/R/expectation.R index 55f00845a..022135c0e 100644 --- a/R/expectation.R +++ b/R/expectation.R @@ -21,15 +21,17 @@ expect <- function( trace_env = caller_env() ) { if (!ok) { - return(fail( + fail( failure_message, info, srcref = srcref, trace = trace, trace_env = trace_env - )) + ) + } else { + # For backwards compatibility + succeed(failure_message) } - succeed(failure_message) } #' Construct an expectation object diff --git a/R/old-school.R b/R/old-school.R index b3fcb397d..1ee6b70f5 100644 --- a/R/old-school.R +++ b/R/old-school.R @@ -147,10 +147,10 @@ takes_less_than <- function(amount) { duration <- system.time(force(expr))["elapsed"] if (duration >= amount) { - msg <- paste0("took ", duration, " seconds, which is more than ", amount) - return(fail(msg)) + fail(paste0("took ", duration, " seconds, which is more than ", amount)) + } else { + pass() } - pass(expr) } } @@ -170,9 +170,10 @@ not <- function(f) { negate <- function(expt) { if (expectation_success(expt)) { msg <- paste0("NOT(", expt$message, ")") - return(fail(msg, srcref = expt$srcref)) + fail(msg, srcref = expt$srcref) + } else { + pass() } - pass(NULL) } function(...) { diff --git a/R/snapshot-file.R b/R/snapshot-file.R index 8a64ef334..b78763a90 100644 --- a/R/snapshot-file.R +++ b/R/snapshot-file.R @@ -191,9 +191,10 @@ expect_snapshot_file <- function( comp, hint ) - return(snapshot_fail(msg)) + snapshot_fail(msg) + } else { + pass() } - pass(NULL) } is_text_file <- function(path) { diff --git a/R/snapshot-reporter.R b/R/snapshot-reporter.R index 19d93c6ae..5cdb69cc3 100644 --- a/R/snapshot-reporter.R +++ b/R/snapshot-reporter.R @@ -115,7 +115,8 @@ SnapshotReporter <- R6::R6Class( value_enc ) if (fail_on_new) { - return(fail(message, trace_env = trace_env)) + fail(message, trace_env = trace_env) + return() } testthat_warn(message) character() diff --git a/R/snapshot.R b/R/snapshot.R index 2dc7686ac..68dad559a 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -129,7 +129,7 @@ expect_snapshot_ <- function( ) if (!is.null(msg)) { if (error) { - return(fail(msg, trace = state$error[["trace"]])) + fail(msg, trace = state$error[["trace"]]) } else { cnd_signal(state$error) } @@ -380,10 +380,12 @@ expect_snapshot_helper <- function( comp, hint ) - return(snapshot_fail(msg, trace_env = trace_env)) + snapshot_fail(msg, trace_env = trace_env) + } else { + pass() } - pass(NULL) + invisible() } snapshot_hint <- function(id, show_accept = TRUE, reset_output = TRUE) { diff --git a/R/test-compiled-code.R b/R/test-compiled-code.R index 8544822a6..80374ca91 100644 --- a/R/test-compiled-code.R +++ b/R/test-compiled-code.R @@ -24,10 +24,10 @@ expect_cpp_tests_pass <- function(package) { info <- paste(output[-1], collapse = "\n") if (!tests_passed) { - msg <- paste("C++ unit tests:", info, sep = "\n") - return(fail(msg)) + fail(paste("C++ unit tests:", info, sep = "\n")) + } else { + pass() } - pass(NULL) } #' Do C++ tests past? diff --git a/R/verify-output.R b/R/verify-output.R index 99f7af1de..c071c5258 100644 --- a/R/verify-output.R +++ b/R/verify-output.R @@ -64,7 +64,7 @@ verify_output <- function( if (!interactive() && on_cran()) { skip("On CRAN") } - compare_file(path, output, update = TRUE) + expect_file_unchanged_(path, output, update = TRUE) invisible() } diff --git a/man/fail.Rd b/man/fail.Rd index 09d9d4350..f7ca02211 100644 --- a/man/fail.Rd +++ b/man/fail.Rd @@ -13,7 +13,7 @@ fail( trace = NULL ) -pass(value) +pass() } \arguments{ \item{message}{Failure message to send to the user. It's best practice to @@ -33,14 +33,12 @@ you're calling \code{fail()} from a helper function; see \item{trace}{An optional backtrace created by \code{\link[rlang:trace_back]{rlang::trace_back()}}. When supplied, the expectation is displayed with the backtrace. Expert use only.} - -\item{value}{Value to return, typically the result of evaluating the -\code{object} argument to the expectation.} } \description{ These are the primitives that you can use to implement your own expectations. -Regardless of how it's called an expectation should either return \code{pass()}, -\code{fail()}, or throw an error (if for example, the arguments are invalid). +Every path through an expectation should either call \code{pass()}, \code{fail()}, +or throw an error (e.g. if the arguments are invalid). Expectations should +always return \code{invisible(act$val)}. Learn more about creating your own expectations in \code{vignette("custom-expectation")}. @@ -51,10 +49,11 @@ expect_length <- function(object, n) { act_n <- length(act$val) if (act_n != n) { - msg <- sprintf("\%s has length \%i, not length \%i.", act$lab, act_n, n) - return(fail(msg)) + fail(sprintf("\%s has length \%i, not length \%i.", act$lab, act_n, n)) + } else { + pass() } - pass(act$val) + invisible(act$val) } } diff --git a/tests/testthat/_snaps/expect-comparison.md b/tests/testthat/_snaps/expect-comparison.md index 30c210eab..3f9aeec72 100644 --- a/tests/testthat/_snaps/expect-comparison.md +++ b/tests/testthat/_snaps/expect-comparison.md @@ -82,5 +82,5 @@ expect_lt(1:10, 5) Condition Error in `expect_lt()`: - ! Result of comparison must be a single logical value. + ! Result of comparison must be `TRUE`, `FALSE`, or `NA` diff --git a/tests/testthat/_snaps/expect-named.md b/tests/testthat/_snaps/expect-named.md index 1cd4f1e45..08f4f82e8 100644 --- a/tests/testthat/_snaps/expect-named.md +++ b/tests/testthat/_snaps/expect-named.md @@ -12,7 +12,7 @@ expect_named(x, "b") Condition Error: - ! Expected names(`x`) to be equal to "b". + ! Expected names of `x` to be equal to "b". Differences: `actual`: "a" `expected`: "b" @@ -23,7 +23,7 @@ expect_named(x1, c("a", "b"), ignore.order = TRUE) Condition Error: - ! Expected names(`x1`) to have the same values as `c("a", "b")`. + ! Expected names of `x1` to have the same values as `c("a", "b")`. Actual: "a" Expected: "a", "b" Absent: "b" @@ -34,7 +34,7 @@ expect_named(x2, "a", ignore.order = TRUE) Condition Error: - ! Expected names(`x2`) to have the same values as "a". + ! Expected names of `x2` to have the same values as "a". Actual: "a", "b" Expected: "a" Needs: "b" @@ -45,7 +45,7 @@ expect_named(x1, "b", ignore.order = TRUE) Condition Error: - ! Expected names(`x1`) to have the same values as "b". + ! Expected names of `x1` to have the same values as "b". Actual: "a" Expected: "b" Needs: "a" @@ -57,7 +57,7 @@ expect_named(x1, c("a", "b"), ignore.order = FALSE) Condition Error: - ! Expected names(`x1`) to be equal to `c("a", "b")`. + ! Expected names of `x1` to be equal to `c("a", "b")`. Differences: `actual`: "a" `expected`: "a" "b" @@ -68,7 +68,7 @@ expect_named(x2, "a", ignore.order = FALSE) Condition Error: - ! Expected names(`x2`) to be equal to "a". + ! Expected names of `x2` to be equal to "a". Differences: `actual`: "a" "b" `expected`: "a" @@ -76,10 +76,10 @@ --- Code - expect_named(x1, c("b"), ignore.order = FALSE) + expect_named(x1, "b", ignore.order = FALSE) Condition Error: - ! Expected names(`x1`) to be equal to `c("b")`. + ! Expected names of `x1` to be equal to "b". Differences: `actual`: "a" `expected`: "b" diff --git a/tests/testthat/_snaps/expect-output.md b/tests/testthat/_snaps/expect-output.md index 4a9d73b64..2d4c77b74 100644 --- a/tests/testthat/_snaps/expect-output.md +++ b/tests/testthat/_snaps/expect-output.md @@ -22,7 +22,7 @@ expect_output(g(), "x") Condition Error: - ! Expected `g()` to match regexp "x". + ! Expected output from `g()` to match regexp "x". Actual output: x | ! diff --git a/tests/testthat/_snaps/expect-self-test.md b/tests/testthat/_snaps/expect-self-test.md index ab0f27e58..ad7c1d82c 100644 --- a/tests/testthat/_snaps/expect-self-test.md +++ b/tests/testthat/_snaps/expect-self-test.md @@ -4,19 +4,19 @@ expect_failure(expect_no_failure()) Condition Error: - ! Expected one failure. + ! Expected exactly one failure and no successes. Actually failed 0 times Code expect_failure(expect_many_failures()) Condition Error: - ! Expected one failure. + ! Expected exactly one failure and no successes. Actually failed 2 times Code expect_failure(expect_has_success()) Condition Error: - ! Expected zero successes. + ! Expected exactly one failure and no successes. Actually succeeded 1 times Code expect_failure(expect_failure_foo(), "bar") @@ -52,25 +52,25 @@ expect_success(expect_no_success()) Condition Error: - ! Expected one success. + ! Expected exactly one success and no failures. Actually succeeded 0 times Code expect_success(expect_many_successes()) Condition Error: - ! Expected one success. + ! Expected exactly one success and no failures. Actually succeeded 2 times Code expect_success(expect_has_failure()) Condition Error: - ! Expected zero failures. + ! Expected exactly one success and no failures. Actually failed 1 times # expect_no are deprecated Code - expect_no_failure(pass(NULL)) + expect_no_failure(pass()) Condition Warning: `expect_no_failure()` was deprecated in testthat 3.3.0. diff --git a/tests/testthat/_snaps/expect-shape.md b/tests/testthat/_snaps/expect-shape.md index f2b6c527b..1b73481bb 100644 --- a/tests/testthat/_snaps/expect-shape.md +++ b/tests/testthat/_snaps/expect-shape.md @@ -39,8 +39,8 @@ expect_shape(array(dim = 1:3), dim = 1:2) Condition Error: - ! Expected `array(dim = 1:3)` to have dim (1, 2). - Actual dim: (1, 2, 3). + ! Expected `array(dim = 1:3)` to have 2 dimensions. + Actual dimensions: 3. --- @@ -48,8 +48,8 @@ expect_shape(array(dim = 1:3), dim = 1:4) Condition Error: - ! Expected `array(dim = 1:3)` to have dim (1, 2, 3, 4). - Actual dim: (1, 2, 3). + ! Expected `array(dim = 1:3)` to have 4 dimensions. + Actual dimensions: 3. # nrow compared correctly diff --git a/tests/testthat/reporters/tests.R b/tests/testthat/reporters/tests.R index 8029f681b..05ad5e88d 100644 --- a/tests/testthat/reporters/tests.R +++ b/tests/testthat/reporters/tests.R @@ -3,7 +3,7 @@ local_edition(2) context("Successes") test_that("Success", { - pass(NULL) + pass() }) context("Failures") diff --git a/tests/testthat/test-expect-named.R b/tests/testthat/test-expect-named.R index 21dfe4aed..09bed4846 100644 --- a/tests/testthat/test-expect-named.R +++ b/tests/testthat/test-expect-named.R @@ -12,6 +12,13 @@ test_that("expected_named verifies actual of names", { expect_snapshot_failure(expect_named(x, "b")) }) +test_that("always returns inputs", { + x <- c(a = 1) + expect_equal(expect_named(x), x) + expect_equal(expect_named(x, "a"), x) + expect_equal(expect_named(x, "a", ignore.order = TRUE), x) +}) + test_that("expected_named optionally ignores order and case", { x <- c(a = 1, b = 2) expect_success(expect_named(x, c("A", "B"), ignore.case = TRUE)) @@ -28,7 +35,7 @@ test_that("provide useful feedback on failure", { expect_snapshot_failure(expect_named(x1, c("a", "b"), ignore.order = FALSE)) expect_snapshot_failure(expect_named(x2, "a", ignore.order = FALSE)) - expect_snapshot_failure(expect_named(x1, c("b"), ignore.order = FALSE)) + expect_snapshot_failure(expect_named(x1, "b", ignore.order = FALSE)) }) test_that("expect_named validates its inputs", { diff --git a/tests/testthat/test-expect-output.R b/tests/testthat/test-expect-output.R index c98144463..52e2adbd2 100644 --- a/tests/testthat/test-expect-output.R +++ b/tests/testthat/test-expect-output.R @@ -33,8 +33,18 @@ test_that("... passed on to grepl", { expect_success(expect_output(print("X"), "x", ignore.case = TRUE)) }) -test_that("returns first argument", { - expect_equal(expect_output(1, NA), 1) +test_that("always returns first argument", { + f1 <- function() { + 1 + } + f2 <- function() { + cat("x") + 1 + } + + expect_equal(expect_output(f1(), NA), 1) + expect_equal(expect_output(f2()), 1) + expect_equal(expect_output(f2(), "x"), 1) }) test_that("uses unicode characters in output where available", { diff --git a/tests/testthat/test-expect-self-test.R b/tests/testthat/test-expect-self-test.R index 4c14bd5e4..97ae8f849 100644 --- a/tests/testthat/test-expect-self-test.R +++ b/tests/testthat/test-expect-self-test.R @@ -2,16 +2,16 @@ test_that("expect_failure() requires 1 failure and zero successes", { expect_success(expect_failure(fail())) expect_failure(expect_failure({})) - expect_failure(expect_failure(pass(NULL))) + expect_failure(expect_failure(pass())) expect_failure(expect_failure({ - pass(NULL) + pass() fail() })) expect_failure(expect_failure({ fail() # Following succeed/fail are never reached - pass(NULL) + pass() fail() })) }) @@ -29,7 +29,7 @@ test_that("expect_failure() generates a useful error messages", { } expect_has_success <- function() { fail() - pass(NULL) + pass() } expect_failure_foo <- function() fail("foo") @@ -42,17 +42,17 @@ test_that("expect_failure() generates a useful error messages", { }) test_that("expect_success() requires 1 success and zero failures", { - expect_success(expect_success(pass(NULL))) + expect_success(expect_success(pass())) expect_failure(expect_success({})) expect_failure(expect_success(fail())) expect_failure(expect_success({ - pass(NULL) + pass() fail() })) expect_failure(expect_success({ - pass(NULL) - pass(NULL) + pass() + pass() })) }) @@ -69,12 +69,12 @@ test_that("show_failure", { test_that("expect_success() generates a useful error messages", { expect_no_success <- function() {} expect_many_successes <- function() { - pass(NULL) - pass(NULL) + pass() + pass() } expect_has_failure <- function() { fail() - pass(NULL) + pass() } expect_snapshot_failure({ @@ -90,8 +90,8 @@ test_that("can count successes and failures", { expect_equal(status$n_failure, 0) status <- capture_success_failure({ - pass(NULL) - pass(NULL) + pass() + pass() fail() }) expect_equal(status$n_success, 2) @@ -99,9 +99,9 @@ test_that("can count successes and failures", { # No code run after first fail status <- capture_success_failure({ - pass(NULL) + pass() fail() - pass(NULL) + pass() fail() }) expect_equal(status$n_success, 2) @@ -110,15 +110,15 @@ test_that("can count successes and failures", { test_that("expect_no are deprecated", { expect_snapshot({ - expect_no_failure(pass(NULL)) + expect_no_failure(pass()) expect_no_success(fail()) }) }) test_that("expect_no still work", { withr::local_options(lifecycle_verbosity = "quiet") - expect_success(expect_no_failure(pass(NULL))) + expect_success(expect_no_failure(pass())) expect_failure(expect_no_failure(fail())) expect_success(expect_no_success(fail())) - expect_failure(expect_no_success(pass(NULL))) + expect_failure(expect_no_success(pass())) }) diff --git a/tests/testthat/test-snapshot.R b/tests/testthat/test-snapshot.R index 2eaac72c9..351870d7c 100644 --- a/tests/testthat/test-snapshot.R +++ b/tests/testthat/test-snapshot.R @@ -194,7 +194,7 @@ test_that("expect_snapshot requires a non-empty test label", { expect_error(expect_snapshot(1 + 1)) }) - pass(NULL) # quiet message about this test being empty + pass() # quiet message about this test being empty }) test_that("expect_snapshot validates its inputs", { diff --git a/tests/testthat/test-test-that.R b/tests/testthat/test-test-that.R index 5e4a355ad..a4cea932d 100644 --- a/tests/testthat/test-test-that.R +++ b/tests/testthat/test-test-that.R @@ -9,7 +9,7 @@ test_that("can't access variables from other tests (2)", { test_that("messages are suppressed", { local_edition(2) message("YOU SHOULDN'T SEE ME") - pass(NULL) + pass() }) test_that("errors are captured", { @@ -72,7 +72,7 @@ test_that("return value from test_that", { with_reporter( "", success <- test_that("success", { - pass(NULL) + pass() }) ) expect_true(success) diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index c13711477..27b381a88 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -48,9 +48,11 @@ If we use it in a test you can see there's an issue: test_that("success", { expect_nrow(mtcars, 32) }) + test_that("failure 1", { expect_nrow(mtcars, 30) }) + test_that("failure 2", { expect_nrow(matrix(1:5), 2) }) @@ -64,35 +66,37 @@ These are both minor issues, so if they don't bother you, you can save yourself ## Expectation basics -An expectation has three main parts, as illustrated by `expect_length()`: +An expectation has four main parts, as illustrated by `expect_length()`: ```{r} expect_length <- function(object, n) { # 1. Capture object and label act <- quasi_label(rlang::enquo(object)) - - # 2. Check if expectations are violated + act_n <- length(act$val) if (act_n != n) { - msg <- c( + # 2. Fail if expectations are violated + fail(c( sprintf("Expected %s to have length %i.", act$lab, n), sprintf("Actual length: %i.", act_n) - ) - return(fail(msg)) + )) + } else { + # 3. Pass if expectations are met + pass() } - # 3. Pass when expectations are met - pass(act$val) + # 4. Invisibly return the input value + invisible(act$val) } ``` 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. -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. +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 many. Note the specific form of the failure message: the first element describes what we expected, and then the second line reports what we actually saw. -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. +If the object is as expected, call `pass()`. This ensures that a success will be registered in the test reporter. -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: +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: ```{r} #| label: piping @@ -149,23 +153,23 @@ expect_vector_length <- function(object, n) { # It's non-trivial to check if an object is a vector in base R so we # use an rlang helper if (!rlang::is_vector(act$val)) { - msg <- c( + fail(c( sprintf("Expected %s to be a vector", act$lab), sprintf("Actual type: %s", typeof(act$val)) - ) - return(fail(msg)) + )) + } else { + act_n <- length(act$val) + if (act_n != n) { + fail(c( + sprintf("Expected %s to have length %i.", act$lab, n), + sprintf("Actual length: %i.", act_n) + )) + } else { + pass() + } } - act_n <- length(act$val) - if (act_n != n) { - msg <- c( - sprintf("Expected %s to have length %i.", act$lab, n), - sprintf("Actual length: %i.", act_n) - ) - return(fail(msg)) - } - - pass(act$val) + invisible(act$val) } ``` @@ -188,27 +192,22 @@ expect_s3_class <- function(object, class) { act <- quasi_label(rlang::enquo(object)) if (!is.object(act$val)) { - msg <- sprintf("Expected %s to be an object.", act$lab) - return(fail(msg)) - } - - if (isS4(act$val)) { - msg <- c( + fail(sprintf("Expected %s to be an object.", act$lab)) + } else if (isS4(act$val)) { + fail(c( sprintf("Expected %s to be an S3 object.", act$lab), "Actual OO type: S4" - ) - return(fail(msg)) - } - - if (!inherits(act$val, class)) { - msg <- c( + )) + } else if (!inherits(act$val, class)) { + fail(c( sprintf("Expected %s to inherit from %s.", act$lab, class), sprintf("Actual class: %s", class(act$val)) - ) - return(fail(msg)) + )) + } else { + pass() } - pass(act$val) + invisible(act$val) } ``` @@ -253,27 +252,22 @@ expect_s3_object <- function(object, class = NULL) { act <- quasi_label(rlang::enquo(object)) if (!is.object(act$val)) { - msg <- sprintf("Expected %s to be an object.", act$lab) - return(fail(msg)) - } - - if (isS4(act$val)) { - msg <- c( + fail(sprintf("Expected %s to be an object.", act$lab)) + } else if (isS4(act$val)) { + fail(c( sprintf("Expected %s to be an S3 object.", act$lab), "Actual OO type: S4" - ) - return(fail(msg)) - } - - if (!is.null(class) && !inherits(act$val, class)) { - msg <- c( + )) + } else if (!is.null(class) && !inherits(act$val, class)) { + fail(c( sprintf("Expected %s to inherit from %s.", act$lab, class), sprintf("Actual class: %s", class(act$val)) - ) - return(fail(msg)) + )) + } else { + pass() } - pass(act$val) + invisible(act$val) } ``` @@ -287,16 +281,20 @@ The key challenge is that `fail()` captures a `trace_env`, which should be the e expect_length_ <- function(act, n, trace_env = caller_env()) { act_n <- length(act$val) if (act_n != n) { - msg <- sprintf("%s has length %i, not length %i.", act$lab, act_n, n) - return(fail(msg, trace_env = trace_env)) + fail( + sprintf("%s has length %i, not length %i.", act$lab, act_n, n), + trace_env = trace_env + ) + } else { + pass() } - - pass(act$val) } expect_length <- function(object, n) { act <- quasi_label(rlang::enquo(object)) + expect_length_(act, n) + invisible(act$val) } ``` @@ -304,6 +302,7 @@ A few recommendations: * The helper shouldn't be user-facing, so we give it a `_` suffix to make that clear. * It's typically easiest for a helper to take the labeled value produced by `quasi_label()`. -* Your helper should usually call both `fail()` and `pass()` and be returned from the wrapping expectation. +* Your helper should usually be called for its side effects (i.e. it calls `fail()` and `pass()`). +* You should return `invisible(act$val)` from the parent expecatation as usual. Again, you're probably not writing so many expectations that it makes sense for you to go to this effort, but it is important for testthat to get it right.