fix: Allow glue() and other classed characters for subassignment

NAMESPACE

@@ -95,6 +95,7 @@ importFrom(vctrs,vec_as_location)
 importFrom(vctrs,vec_as_location2)
 importFrom(vctrs,vec_as_names)
 importFrom(vctrs,vec_as_names_legacy)
+importFrom(vctrs,vec_as_subscript)
 importFrom(vctrs,vec_as_subscript2)
 importFrom(vctrs,vec_assign)
 importFrom(vctrs,vec_c)

R/subsetting.R

@@ -416,7 +416,7 @@ tbl_subset2 <- function(x, j, j_arg) {
   .subset2(x, j)
 }
 
-tbl_subassign <- function(x, i, j, value, i_arg, j_arg, value_arg) {
+tbl_subassign <- function(x, i, j, value, i_arg, j_arg, value_arg, call = caller_env()) {
   if (is.null(i)) {
     xo <- unclass(x)
 
@@ -426,7 +426,7 @@ tbl_subassign <- function(x, i, j, value, i_arg, j_arg, value_arg) {
       j <- seq_along(xo)
       names(j) <- names2(j)
     } else if (!is.null(j_arg)) {
-      j <- vectbl_as_new_col_index(j, xo, j_arg, names2(value), value_arg)
+      j <- vectbl_as_new_col_index(j, xo, j_arg, names2(value), value_arg, call = call)
     }
 
     value <- vectbl_recycle_rhs_rows(value, fast_nrow(xo), i_arg = NULL, value_arg)
@@ -453,7 +453,7 @@ tbl_subassign <- function(x, i, j, value, i_arg, j_arg, value_arg) {
       # (Invariant: x[[j]] is equivalent to x[[vec_as_location(j)]],
       # allowed by corollary that only existing columns can be updated)
       if (!is.null(j_arg)) {
-        j <- vectbl_as_new_col_index(j, xo, j_arg, names2(value), value_arg)
+        j <- vectbl_as_new_col_index(j, xo, j_arg, names2(value), value_arg, call = call)
       }
 
       # Fill up columns if necessary
@@ -496,12 +496,16 @@ vectbl_as_new_row_index <- function(i, x, i_arg) {
   }
 }
 
-vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) {
+vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL, call = caller_env()) {
   # Creates a named index vector
   # Values: index
   # Name: column name (for all columns)
 
-  if (is_bare_character(j)) {
+  if (is.object(j)) {
+    j <- vectbl_as_col_subscript(j, j_arg = j_arg, assign = TRUE, call = call)
+  }
+
+  if (is.character(j)) {
     if (anyNA(j)) {
       abort_assign_columns_non_na_only()
     }
@@ -516,7 +520,7 @@ vectbl_as_new_col_index <- function(j, x, j_arg, names = "", value_arg = NULL) {
     } else {
       new <- NULL
     }
-  } else if (is_bare_numeric(j)) {
+  } else if (is.numeric(j)) {
     if (anyNA(j)) {
       abort_assign_columns_non_na_only()
     }
@@ -627,8 +631,20 @@ vectbl_as_col_location2 <- function(j, n, names = NULL, j_arg, assign = FALSE, c
   subclass_col_index_errors(vec_as_location2(j, n, names, call = call), j_arg = j_arg, assign = assign)
 }
 
+vectbl_as_col_subscript <- function(j, j_arg, assign = FALSE, call = caller_env()) {
+  subclass_col_index_errors(
+    vec_as_subscript(j, call = call),
+    j_arg = j_arg,
+    assign = assign
+  )
+}
+
 vectbl_as_col_subscript2 <- function(j, j_arg, assign = FALSE, call = my_caller_env()) {
-  subclass_col_index_errors(vec_as_subscript2(j, logical = "error", call = call), j_arg = j_arg, assign = assign)
+  subclass_col_index_errors(
+    vec_as_subscript2(j, logical = "error", call = call),
+    j_arg = j_arg,
+    assign = assign
+  )
 }
 
 is_tight_sequence_at_end <- function(i_new, n) {

R/tibble-package.R

@@ -12,6 +12,7 @@
 #' @importFrom vctrs vec_as_location2
 #' @importFrom vctrs vec_as_names
 #' @importFrom vctrs vec_as_names_legacy
+#' @importFrom vctrs vec_as_subscript
 #' @importFrom vctrs vec_as_subscript2
 #' @importFrom vctrs vec_assign
 #' @importFrom vctrs vec_c

tests/testthat/_snaps/subsetting.md

@@ -423,11 +423,6 @@
       x `as.list(1:3)` must be logical, numeric, or character, not a list.
     Code
       foo[factor(1:3)] <- 1
-    Condition
-      Error in `[<-`:
-      ! Can't assign to columns that don't exist.
-      x Columns `1`, `2`, and `3` don't exist.
-    Code
       foo[Sys.Date()] <- 1
     Condition
       Error in `[<-`:

tests/testthat/test-subsetting.R

@@ -403,6 +403,7 @@ test_that("can use classed character indexes (#778)", {
   expect_null(df[[mychr("c")]])
 
   expect_silent(df[mychr(letters[1:2])] <- df)
+  expect_silent(df[mychr(letters[3:4])] <- df)
   expect_silent(df[[mychr("c")]] <- 1)
   expect_silent(df[[mychr("a")]] <- df[["a"]])
 })
@@ -413,7 +414,8 @@ test_that("can use classed integer indexes (#778)", {
   expect_identical(df[myint(1:3), myint(1:2)], df)
   expect_identical(df[[myint(2)]], df[[2]])
 
-  expect_silent(df[mylgl(TRUE), ] <- df)
+  expect_silent(df[myint(1:2)] <- df)
+  expect_silent(df[myint(3:4)] <- list(c = 4, d = 5))
   expect_silent(df[[myint(2)]] <- df[[2]])
   expect_silent(df[[myint(3)]] <- 1)
 })
@@ -422,6 +424,8 @@ test_that("can use classed logical indexes (#778)", {
   df <- tibble::tibble(a = 1:3, b = LETTERS[1:3])
 
   expect_identical(df[mylgl(TRUE), mylgl(TRUE)], df)
+
+  expect_silent(df[mylgl(TRUE), ] <- df)
   expect_silent(df[mylgl(TRUE), mylgl(TRUE)] <- df)
 })