Delay dplyr_quosures() auto naming until needed (tidyverse#6797)

R/across.R

@@ -545,25 +545,35 @@ new_dplyr_quosure <- function(quo, ...) {
   quo
 }
 
+dplyr_quosure_name <- function(quo_data) {
+  if (quo_data$is_named) {
+    # `name` is a user-supplied or known character string
+    quo_data$name
+  } else {
+    # `name` is a quosure that must be auto-named
+    with_no_rlang_infix_labeling(as_label(quo_data$name))
+  }
+}
+
 dplyr_quosures <- function(...) {
   # We're using quos() instead of enquos() here for speed, because we're not defusing named arguments --
   # only the ellipsis is converted to quosures, there are no further arguments.
   quosures <- quos(..., .ignore_empty = "all")
-  names_given <- names2(quosures)
+  names <- names2(quosures)
 
   for (i in seq_along(quosures)) {
     quosure <- quosures[[i]]
-    name_given <- names_given[[i]]
-    is_named <- (name_given != "")
-    if (is_named) {
-      name_auto <- name_given
-    } else {
-      name_auto <- with_no_rlang_infix_labeling(as_label(quosure))
+    name <- names[[i]]
+    is_named <- (name != "")
+
+    if (!is_named) {
+      # Will be auto-named by `dplyr_quosure_name()` only as needed
+      name <- quosure
     }
 
-    quosures[[i]] <- new_dplyr_quosure(quosure,
-      name_given = name_given,
-      name_auto = name_auto,
+    quosures[[i]] <- new_dplyr_quosure(
+      quo = quosure,
+      name = name,
       is_named = is_named,
       index = i
     )
@@ -739,8 +749,7 @@ expand_across <- function(quo) {
       quo <- new_quosure(sym(var), empty_env())
       quo <- new_dplyr_quosure(
         quo,
-        name_given = name,
-        name_auto = name,
+        name = name,
         is_named = TRUE,
         index = c(quo_data$index, k),
         column = var
@@ -770,8 +779,7 @@ expand_across <- function(quo) {
       name <- names[[k]]
       expressions[[k]] <- new_dplyr_quosure(
         fn_call,
-        name_given = name,
-        name_auto = name,
+        name = name,
         is_named = TRUE,
         index = c(quo_data$index, k),
         column = var

R/mutate.R

@@ -382,7 +382,8 @@ mutate_col <- function(dot, data, mask, new_columns) {
         chunks <- withCallingHandlers(
           mask$eval_all_mutate(quo),
           error = function(cnd) {
-            msg <- glue("Can't compute column `{quo_data$name_auto}`.")
+            name <- dplyr_quosure_name(quo_data)
+            msg <- glue("Can't compute column `{name}`.")
             abort(msg, call = call("across"), parent = cnd)
           }
         )
@@ -398,7 +399,8 @@ mutate_col <- function(dot, data, mask, new_columns) {
       if (length(rows) == 1) {
         result <- chunks[[1]]
       } else {
-        chunks <- dplyr_vec_cast_common(chunks, quo_data$name_auto)
+        # `name` specified lazily
+        chunks <- dplyr_vec_cast_common(chunks, name = dplyr_quosure_name(quo_data))
         result <- list_unchop(chunks, indices = rows)
       }
     }
@@ -414,7 +416,7 @@ mutate_col <- function(dot, data, mask, new_columns) {
     quo_result <- quosures_results[[k]]
     if (is.null(quo_result)) {
       if (quo_data$is_named) {
-        name <- quo_data$name_given
+        name <- dplyr_quosure_name(quo_data)
         new_columns[[name]] <- zap()
         mask$remove(name)
       }
@@ -436,7 +438,7 @@ mutate_col <- function(dot, data, mask, new_columns) {
       new_columns[types_names] <- result
     } else {
       # treat as a single output otherwise
-      name <- quo_data$name_auto
+      name <- dplyr_quosure_name(quo_data)
       mask$add_one(name = name, chunks = chunks, result = result)
 
       new_columns[[name]] <- result

R/summarise.R

@@ -302,7 +302,7 @@ summarise_cols <- function(data, dots, by, verb, error_call = caller_env()) {
           results <- append(results, results_k)
           out_names <- c(out_names, types_k_names)
         } else {
-          name <- quo_data$name_auto
+          name <- dplyr_quosure_name(quo_data)
           mask$add_one(name = name, chunks = chunks_k, result = results_k)
           chunks <- append(chunks, list(chunks_k))
           types <- append(types, list(types_k))
@@ -360,7 +360,8 @@ summarise_eval_one <- function(quo, mask) {
     chunks_k <- withCallingHandlers(
       mask$eval_all_summarise(quo),
       error = function(cnd) {
-        msg <- glue("Can't compute column `{quo_data$name_auto}`.")
+        name <- dplyr_quosure_name(quo_data)
+        msg <- glue("Can't compute column `{name}`.")
         abort(msg, call = call("across"), parent = cnd)
       }
     )
@@ -372,7 +373,11 @@ summarise_eval_one <- function(quo, mask) {
     return(NULL)
   }
 
-  types_k <- dplyr_vec_ptype_common(chunks_k, quo_data$name_auto)
+  # `name` specified lazily
+  types_k <- dplyr_vec_ptype_common(
+    chunks = chunks_k,
+    name = dplyr_quosure_name(quo_data)
+  )
 
   chunks_k <- vec_cast_common(!!!chunks_k, .to = types_k)
   result_k <- vec_c(!!!chunks_k, .ptype = types_k)

tests/testthat/_snaps/pick.md

@@ -128,6 +128,18 @@
       Error in `pick()`:
       ! Must only be used inside data-masking verbs like `mutate()`, `filter()`, and `group_by()`.
 
+# when expansion occurs, error labels use the pre-expansion quosure
+
+    Code
+      mutate(df, if (cur_group_id() == 1L) pick(x) else "x", .by = g)
+    Condition
+      Error in `mutate()`:
+      i In argument: `if (cur_group_id() == 1L) pick(x) else "x"`.
+      Caused by error:
+      ! `if (cur_group_id() == 1L) pick(x) else "x"` must return compatible vectors across groups.
+      i Result of type <tbl_df<x:double>> for group 1: `g = 1`.
+      i Result of type <character> for group 2: `g = 2`.
+
 # doesn't allow renaming
 
     Code

tests/testthat/test-across.R

@@ -1020,8 +1020,7 @@ test_that("expand_across() expands lambdas", {
   quo <- quo(across(c(cyl, am), ~ identity(.x)))
   quo <- new_dplyr_quosure(
     quo,
-    name_given = "",
-    name_auto = "across()",
+    name = quo,
     is_named = FALSE,
     index = 1
   )
@@ -1042,8 +1041,7 @@ test_that("expand_if_across() expands lambdas", {
   quo <- quo(if_any(c(cyl, am), ~ . > 4))
   quo <- new_dplyr_quosure(
     quo,
-    name_given = "",
-    name_auto = "if_any()",
+    name = quo,
     is_named = FALSE,
     index = 1
   )

tests/testthat/test-pick.R

@@ -326,6 +326,16 @@ test_that("selection on rowwise data frames uses full list-cols, but actual eval
   expect_identical(out$y, map(df$x, ~tibble(x = .x)))
 })
 
+test_that("when expansion occurs, error labels use the pre-expansion quosure", {
+  df <- tibble(g = c(1, 2, 2), x = c(1, 2, 3))
+
+  # Fails in common type casting of the group chunks,
+  # which references the auto-named column name
+  expect_snapshot(error = TRUE, {
+    mutate(df, if (cur_group_id() == 1L) pick(x) else "x", .by = g)
+  })
+})
+
 test_that("doesn't allow renaming", {
   expect_snapshot(error = TRUE, {
     mutate(data.frame(x = 1), pick(y = x))