Merge branch 'main' into f-6785-setequal

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: dplyr
 Title: A Grammar of Data Manipulation
-Version: 1.1.0.9000
+Version: 1.1.1.9000
 Authors@R: c(
     person("Hadley", "Wickham", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-4757-117X")),
@@ -28,7 +28,7 @@ Imports:
     lifecycle (>= 1.0.3),
     magrittr (>= 1.5),
     methods,
-    pillar (>= 1.5.1),
+    pillar (>= 1.9.0),
     R6,
     rlang (>= 1.1.0),
     tibble (>= 3.2.0),

NEWS.md

@@ -1,5 +1,9 @@
 # dplyr (development version)
 
+* Joins better handle key columns will all `NA`s (#6804).
+
+# dplyr 1.1.1
+
 * Mutating joins now warn about multiple matches much less often. At a high
   level, a warning was previously being thrown when a one-to-many or
   many-to-many relationship was detected between the keys of `x` and `y`, but is
@@ -65,6 +69,9 @@
   `na_rm` or `with_ties` (#6725).
 
 * `nth()` now errors informatively if `n` is `NA` (#6682).
+
+* Joins now throw a more informative error when `y` doesn't have the same
+  source as `x` (#6798).
 
 * All major dplyr verbs now throw an informative error message if the input
   data frame contains a column named `NA` or `""` (#6758).

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/conditions.R

@@ -40,7 +40,7 @@ cnd_bullet_cur_group_label <- function(what = "error") {
 
 cnd_bullet_rowwise_unlist <- function() {
   if (peek_mask()$is_rowwise()) {
-    glue_data(peek_error_context(), "Did you mean: `{error_name} = list({error_expression})` ?")
+    glue_data(peek_error_context(), "Did you mean: `{error_name} = list({quo_as_label(error_quo)})` ?")
   }
 }
 
@@ -84,15 +84,15 @@ new_error_context <- function(dots, i, mask) {
   if (!length(dots) || i == 0L) {
     env(
       error_name = "",
-      error_expression = NULL,
+      error_quo = NULL,
       mask = mask
     )
   } else {
-    expr <- quo_as_label(dots[[i]])
-
+    # Saving the quosure rather than the result of `quo_as_label()` to avoid
+    # slow label creation unless required
     env(
-      error_name = names(dots)[i],
-      error_expression = expr,
+      error_name = names(dots)[[i]],
+      error_quo = dots[[i]],
       mask = mask
     )
   }
@@ -117,24 +117,24 @@ mask_type <- function(mask = peek_mask()) {
 }
 
 ctxt_error_label <- function(ctxt = peek_error_context()) {
-  error_label(ctxt$error_name, ctxt$error_expression)
+  error_label(ctxt$error_name, ctxt$error_quo)
 }
-error_label <- function(name, expr_label) {
+error_label <- function(name, quo) {
   if (is_null(name) || !nzchar(name)) {
-    expr_label
+    quo_as_label(quo)
   } else {
     name
   }
 }
 
 ctxt_error_label_named <- function(ctxt = peek_error_context()) {
-  error_label_named(ctxt$error_name, ctxt$error_expression)
+  error_label_named(ctxt$error_name, ctxt$error_quo)
 }
-error_label_named <- function(name, expr_label) {
+error_label_named <- function(name, quo) {
   if (is_null(name) || !nzchar(name)) {
-    expr_label
+    quo_as_label(quo)
   } else {
-    paste0(name, " = ", expr_label)
+    paste0(name, " = ", quo_as_label(quo))
   }
 }
 
@@ -368,7 +368,7 @@ new_dplyr_warning <- function(data) {
     group_label <- ""
   }
 
-  label <- error_label_named(data$name, data$expr)
+  label <- error_label_named(data$name, data$quo)
 
   msg <- c(
     "i" = glue::glue("In argument: `{label}`."),

R/context.R

@@ -118,7 +118,7 @@ cnd_data <- function(cnd, ctxt, mask, call) {
   list(
     cnd = cnd,
     name = ctxt$error_name,
-    expr = ctxt$error_expression,
+    quo = ctxt$error_quo,
     type = mask_type,
     has_group_data = has_group_data,
     group_data = group_data,

R/copy-to.R

@@ -42,12 +42,16 @@ copy_to <- function(dest, df, name = deparse(substitute(df)),
 #' @param ... Other arguments passed on to methods.
 #' @export
 auto_copy <- function(x, y, copy = FALSE, ...) {
-  if (same_src(x, y)) return(y)
+  if (same_src(x, y)) {
+    return(y)
+  }
 
   if (!copy) {
     bullets <- c(
       "`x` and `y` must share the same src.",
-      i = "set `copy` = TRUE (may be slow)."
+      i = cli::format_inline("`x` is {obj_type_friendly(x)}."),
+      i = cli::format_inline("`y` is {obj_type_friendly(y)}."),
+      i = "Set `copy = TRUE` if `y` can be copied to the same source as `x` (may be slow)."
     )
     abort(bullets)
   }

R/join-cols.R

@@ -189,6 +189,9 @@ join_cast_common <- function(x, y, vars, error_call = caller_env()) {
     }
   )
 
+  # Finalize unspecified columns (#6804)
+  ptype <- vec_ptype_finalise(ptype)
+
   vec_cast_common(x = x, y = y, .to = ptype, .call = error_call)
 }
 

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)

R/utils-tidy-eval.R

@@ -22,8 +22,8 @@
 #'
 #' @keywords internal
 #' @name tidyeval-compat
-#' @aliases expr enquo enquos sym syms as_label
-#' @export expr enquo enquos sym syms as_label .data
+#' @aliases .data expr enquo enquos sym syms as_label
+#' @export .data expr enquo enquos sym syms as_label
 #' @aliases quo quos quo_name ensym ensyms enexpr enexprs
 #' @export quo quos quo_name ensym ensyms enexpr enexprs
 NULL