Add required argument to expect_true

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) {

tests/testthat/_snaps/expect-constant.md

@@ -31,3 +31,59 @@
       `actual` is an S3 object of class <data.frame>, 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
+

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"
+  )
 })