diff --git a/R/expect-constant.R b/R/expect-constant.R index e6ca95d25..59853e809 100644 --- a/R/expect-constant.R +++ b/R/expect-constant.R @@ -7,6 +7,10 @@ #' #' Attributes are ignored. #' +#' @param required "one" (default) to require an identical match to `TRUE`. +#' "any" to replicate `expect_true(any(TRUE))`. "all" for +#' `expect_true(all(TRUE))`. +#' #' @inheritParams expect_that #' @family expectations #' @examples @@ -28,12 +32,69 @@ NULL #' @export #' @rdname logical-expectations -expect_true <- function(object, info = NULL, label = NULL) { +expect_true <- function( + object, + info = NULL, + label = NULL, + required = c("one", "any", "all") +) { + required <- match.arg(required) act <- quasi_label(enquo(object), label) + + switch( + required, + "one" = expect_true_one(act, info), + "any" = expect_true_any(act, info), + "all" = expect_true_all(act, info), + stop("Unknown argument to `required`. This should never throw.") + ) +} + +expect_true_one <- function( + act, + info = NULL +) { exp <- labelled_value(TRUE, "TRUE") expect_waldo_constant_(act, exp, info = info, ignore_attr = TRUE) } +expect_true_any <- function( + act, + info = NULL +) { + if (!is_logical(act$val)) { + cli::cli_abort("{act$lab} must be a logical vector") + } + + if (!any(act$val)) { + msg <- sprintf("No values in %s are TRUE.", act$lab) + return(fail(msg, info = info)) + } + + pass(act$val) +} + +expect_true_all <- function( + act, + info = NULL +) { + if (!is_logical(act$val)) { + not_true_idx <- seq_along(act$val) + } else { + not_true_idx <- which(!act$val) + } + + if (length(not_true_idx) > 0) { + msg <- sprintf( + "%s is not TRUE at index: %s", + act$lab, + toString(not_true_idx) + ) + return(fail(msg, info = info)) + } + pass(act$val) +} + #' @export #' @rdname logical-expectations expect_false <- function(object, info = NULL, label = NULL) { diff --git a/man/logical-expectations.Rd b/man/logical-expectations.Rd index ff6c90539..459989260 100644 --- a/man/logical-expectations.Rd +++ b/man/logical-expectations.Rd @@ -6,7 +6,12 @@ \alias{expect_false} \title{Do you expect \code{TRUE} or \code{FALSE}?} \usage{ -expect_true(object, info = NULL, label = NULL) +expect_true( + object, + info = NULL, + label = NULL, + required = c("one", "any", "all") +) expect_false(object, info = NULL, label = NULL) } @@ -21,6 +26,10 @@ is soft-deprecated and should not be used in new code. Instead see alternatives in \link{quasi_label}.} \item{label}{Used to customise failure messages. For expert use only.} + +\item{required}{"one" (default) to require an identical match to \code{TRUE}. +"any" to replicate \code{expect_true(any(TRUE))}. "all" for +\code{expect_true(all(TRUE))}.} } \description{ These are fall-back expectations that you can use when none of the other diff --git a/tests/testthat/_snaps/expect-constant.md b/tests/testthat/_snaps/expect-constant.md index 37dcbd7f9..ba90a7682 100644 --- a/tests/testthat/_snaps/expect-constant.md +++ b/tests/testthat/_snaps/expect-constant.md @@ -31,3 +31,59 @@ `actual` is an S3 object of class , a list `expected` is NULL +# expect_true(required = 'all') + + Code + expect_true(FALSE, required = "all") + Condition + Error: + ! FALSE is not TRUE at index: 1 + +--- + + Code + expect_true(c(FALSE, FALSE), required = "all") + Condition + Error: + ! `c(FALSE, FALSE)` is not TRUE at index: 1, 2 + +--- + + Code + expect_true(c(TRUE, FALSE), required = "all") + Condition + Error: + ! `c(TRUE, FALSE)` is not TRUE at index: 2 + +--- + + Code + expect_true("not logical", required = "all") + Condition + Error: + ! "not logical" is not TRUE at index: 1 + +# expect_true(required = 'any') + + Code + expect_true(FALSE, required = "any") + Condition + Error: + ! No values in FALSE are TRUE. + +--- + + Code + expect_true(c(FALSE, FALSE), required = "any") + Condition + Error: + ! No values in `c(FALSE, FALSE)` are TRUE. + +--- + + Code + expect_true("not logical", required = "any") + Condition + Error in `expect_true_any()`: + ! "not logical" must be a logical vector + diff --git a/tests/testthat/test-expect-constant.R b/tests/testthat/test-expect-constant.R index f249277fc..2dfd9f082 100644 --- a/tests/testthat/test-expect-constant.R +++ b/tests/testthat/test-expect-constant.R @@ -27,6 +27,65 @@ test_that("expect_null works", { }) test_that("returns the input value", { - res <- expect_true(TRUE) - expect_equal(res, TRUE) + res_one <- expect_true(TRUE, required = "one") + expect_equal(res_one, TRUE) + + res_any <- expect_true(TRUE, required = "any") + expect_equal(res_any, TRUE) + + res_all <- expect_true(TRUE, required = "all") + expect_equal(res_all, TRUE) +}) + +test_that("expect_true(required = 'all')", { + expect_success( + expect_true(TRUE, required = "all") + ) + expect_success( + expect_true(c(TRUE, TRUE), required = "all") + ) + + expect_snapshot_failure( + expect_true(FALSE, required = "all") + ) + expect_snapshot_failure( + expect_true(c(FALSE, FALSE), required = "all") + ) + expect_snapshot_failure( + expect_true(c(TRUE, FALSE), required = "all") + ) + expect_snapshot_failure( + expect_true("not logical", required = "all") + ) + expect_failure( + expect_true(c(TRUE, FALSE), required = "all", label = "FOO"), + "FOO" + ) +}) + +test_that("expect_true(required = 'any')", { + expect_success( + expect_true(TRUE, required = "any") + ) + expect_success( + expect_true(c(TRUE, TRUE), required = "any") + ) + expect_success( + expect_true(c(FALSE, TRUE), required = "any") + ) + + expect_snapshot_failure( + expect_true(FALSE, required = "any") + ) + expect_snapshot_failure( + expect_true(c(FALSE, FALSE), required = "any") + ) + expect_snapshot_failure( + expect_true("not logical", required = "any") + ) + # Label works + expect_failure( + expect_true(c(FALSE, FALSE), required = "any", label = "FOO"), + "FOO" + ) })