Tweaks

R/vec-case-when.R

@@ -52,9 +52,7 @@ vec_case_when <- function(conditions,
     condition <- conditions[[i]]
     condition_arg <- condition_args[[i]]
     check_logical(condition, arg = condition_arg, call = call)
-    check_matrix(condition, call = call)
-
-
+    check_no_dim(condition, arg = condition_arg, call = call)
   }
 
   size <- vec_size_common(
@@ -211,10 +209,16 @@ vec_paste0 <- function (...) {
   exec(paste0, !!!args)
 }
 
-check_matrix <- function(condition, call) {
-  if (inherits(condition, "matrix")) {
-    abort("`conditions` cannot be a matrix.", call = call)
-
+check_no_dim <- function(x,
+                         ...,
+                         arg = caller_arg(x),
+                         call = caller_env()) {
+  if (is.null(dim(x))) {
+    return(invisible(NULL))
   }
 
+  cli::cli_abort(
+    "{.arg {arg}} can't be an array.",
+    call = call
+  )
 }

tests/testthat/_snaps/case-when.md

@@ -118,11 +118,3 @@
       Error in `case_when()`:
       ! Case 1 (`~1:2`) must be a two-sided formula.
 
-# condition input as matrix 
-
-    Code
-      case_when(!is.finite(x) ~ "Invalid", .default = "Default")
-    Condition
-      Error in `case_when()`:
-      ! `conditions` cannot be a matrix.
-

tests/testthat/_snaps/vec-case-when.md

@@ -102,6 +102,22 @@
       Error in `vec_case_when()`:
       ! `conditions[[2]]` must be a logical vector, not the number 3.5.
 
+# `conditions` can't be arrays (#7069)
+
+    Code
+      vec_case_when(list(x), list(y))
+    Condition
+      Error in `vec_case_when()`:
+      ! `conditions[[1]]` can't be an array.
+
+---
+
+    Code
+      vec_case_when(list(x), list(y))
+    Condition
+      Error in `vec_case_when()`:
+      ! `conditions[[1]]` can't be an array.
+
 # `size` overrides the `conditions` sizes
 
     Code

tests/testthat/test-case-when.R

@@ -305,13 +305,3 @@ test_that("case_when() give meaningful errors", {
   })
 
 })
-
-test_that("condition input as matrix ", {
-  # throw an informative error when condition is a matrix
-  x <- matrix(rnorm(36), ncol = 6)
-
-  expect_snapshot(error = TRUE, {
-    case_when(!is.finite(x) ~ "Invalid",
-              .default = "Default")
-  })
-})

tests/testthat/test-vec-case-when.R

@@ -315,6 +315,22 @@ test_that("`conditions` can be classed logicals", {
   expect_identical(vec_case_when(list(x), list(1), default = 2), c(2, 1))
 })
 
+test_that("`conditions` can't be arrays (#6862)", {
+  x <- array(TRUE, dim = c(3, 3))
+  y <- c("a", "b", "c")
+
+  expect_snapshot(error = TRUE, {
+    vec_case_when(list(x), list(y))
+  })
+
+  # Not even 1D arrays
+  x <- array(TRUE, dim = 3)
+
+  expect_snapshot(error = TRUE, {
+    vec_case_when(list(x), list(y))
+  })
+})
+
 test_that("`size` overrides the `conditions` sizes", {
   expect_snapshot(error = TRUE, {
     vec_case_when(list(TRUE), list(1), size = 5)
@@ -426,5 +442,3 @@ test_that("named inputs show up in the error message", {
     vec_case_when(list(TRUE), list(x = NULL), values_arg = "")
   })
 })
-
-