across() gains .call= so that we can control which call governs the c…

…aching.

closes #5782

R/across.R

@@ -33,6 +33,8 @@
 #'   `{.fn}` to stand for the name of the function being applied. The default
 #'   (`NULL`) is equivalent to `"{.col}"` for the single function case and
 #'   `"{.col}_{.fn}"` for the case where a list is used for `.fns`.
+#' @param .call Call used by the caching mechanism. This is only useful when `across()`
+#'   is called from another function, and should mostly just be ignored.
 #'
 #' @returns
 #' `across()` returns a tibble with one column for each column in `.cols` and each function in `.fns`.
@@ -86,8 +88,8 @@
 #'
 #' @export
 #' @seealso [c_across()] for a function that returns a vector
-across <- function(.cols = everything(), .fns = NULL, ..., .names = NULL) {
-  key <- key_deparse(sys.call())
+across <- function(.cols = everything(), .fns = NULL, ..., .names = NULL, .call = sys.call()) {
+  key <- key_deparse(.call)
   setup <- across_setup({{ .cols }}, fns = .fns, names = .names, key = key, .caller_env = caller_env())
 
   vars <- setup$vars
@@ -147,17 +149,17 @@ across <- function(.cols = everything(), .fns = NULL, ..., .names = NULL) {
 
 #' @rdname across
 #' @export
-if_any <- function(.cols = everything(), .fns = NULL, ..., .names = NULL) {
-  df <- across({{ .cols }}, .fns = .fns, ..., .names = .names)
+if_any <- function(.cols = everything(), .fns = NULL, ..., .names = NULL, .call = sys.call()) {
+  df <- across({{ .cols }}, .fns = .fns, ..., .names = .names, .call = .call)
   n <- nrow(df)
   df <- vec_cast_common(!!!df, .to = logical())
   .Call(dplyr_reduce_lgl_or, df, n)
 }
 
 #' @rdname across
 #' @export
-if_all <- function(.cols = everything(), .fns = NULL, ..., .names = NULL) {
-  df <- across({{ .cols }}, .fns = .fns, ..., .names = .names)
+if_all <- function(.cols = everything(), .fns = NULL, ..., .names = NULL, .call = sys.call()) {
+  df <- across({{ .cols }}, .fns = .fns, ..., .names = .names, .call = .call)
   n <- nrow(df)
   df <- vec_cast_common(!!!df, .to = logical())
   .Call(dplyr_reduce_lgl_and, df, n)

tests/testthat/test-across.R

@@ -367,6 +367,16 @@ test_that("if_any() and if_all() can be used in mutate() (#5709)", {
   expect_equal(res$all, c(FALSE, FALSE, FALSE, TRUE))
 })
 
+test_that("across() caching not confused when used from if_any() and if_all() (#5782)", {
+  res <- data.frame(x = 1:3) %>%
+    mutate(
+      any = if_any(x, ~ . >= 2) + if_any(x, ~ . >= 3),
+      all = if_all(x, ~ . >= 2) + if_all(x, ~ . >= 3)
+    )
+  expect_equal(res$any, c(0, 1, 2))
+  expect_equal(res$all, c(0, 1, 2))
+})
+
 test_that("if_any() and if_all() respect filter()-like NA handling", {
   df <- expand.grid(
     x = c(TRUE, FALSE, NA), y = c(TRUE, FALSE, NA)