set(): only reallocate the table if resizing would fail otherwise (#7606)

* Regression tests

* set(): only reallocate if resizing would fail

* Update R/data.table.R

Co-authored-by: Michael Chirico <chiricom@google.com>

* Rename test variables

Co-Authored-By: Michael Chirico <michaelchirico4@gmail.com>

* Cache j %chin% names(x)

Co-Authored-By: Benjamin Schwendinger <52290390+ben-schwen@users.noreply.github.com

---------

Co-authored-by: Michael Chirico <chiricom@google.com>
Co-authored-by: Michael Chirico <michaelchirico4@gmail.com>

Author: aitap

R/data.table.R

@@ -2986,20 +2986,33 @@ setcolorder = function(x, neworder=key(x), before=NULL, after=NULL, skip_absent=
   invisible(x)
 }
 
-.set_needs_alloccol = function(x, value) {
+.set_needs_alloccol = function(x, j, value) {
+  # set() will try to resize x when adding or removing columns
+  # when removing a column, value can be NULL or list with NULLs inside
+  removing = is.null(value) || (is.list(value) && length(value) == length(j) && any(vapply_1b(value, is.null)))
+  # columns can be created by name
+  adding = if (is.character(j)) {
+    jexists = j %chin% names(x)
+    !all(jexists)
+  } else FALSE
+
+  if (!(removing || adding)) return(FALSE)
+
   # automatically allocate more space when tl <= ncol (either full or loaded from disk)
-  if (truelength(x) <= length(x)) return(TRUE)
-  if (selfrefok(x, verbose=FALSE) >= 1L) return(FALSE)
-  # value can be NULL or list with NULLs inside
-  if (is.null(value)) return(TRUE)
-  if (!is.list(value)) return(FALSE)
-  any(vapply_1b(value, is.null))
+  # (or if a resize operation would otherwise fail)
+  if (selfrefok(x, verbose=FALSE) < 1L || truelength(x) <= length(x))
+    return(TRUE)
+
+  if (adding)
+    return(truelength(x) < length(x) + sum(!jexists))
+
+  FALSE
 }
 
 set = function(x,i=NULL,j,value)  # low overhead, loopable
 {
   # If removing columns from a table that's not selfrefok, need to call setalloccol first, #7488
-  if (.set_needs_alloccol(x, value)) {
+  if (.set_needs_alloccol(x, j, value)) {
     name = substitute(x)
     setalloccol(x, verbose=FALSE)
     if (is.name(name)) {

inst/tests/tests.Rraw

@@ -21497,3 +21497,15 @@ test(2363.1, foverlaps(x, y, by.x, by.y), foverlaps(x, y2, by.x, by.y))
 test(2363.2, foverlaps(x, y2, by.x, by.y, type="any", mult="all"), foverlaps(x, y2, by.x, by.y, type="any", mult="first"))
 test(2363.3, foverlaps(x, y, by.x, by.y, which=TRUE, mult="first", nomatch=NULL), foverlaps(x, y2, by.x, by.y, which=TRUE, mult="first", nomatch=NULL))
 rm(x, y, y2)
+
+# internal use of set() causes non-resizable data.tables to be re-assigned in the wrong frame, #7604
+# bmerge -> coerce_col
+x = structure(list(a = as.double(2:3), b = list("foo", "bar")), class = c("data.table", "data.frame"))
+y = structure(list(a = 1:3), class = c("data.table", "data.frame"))
+test(2364.1, x[y, on = "a"], data.table(a = 1:3, b = list(NULL, "foo", "bar")))
+x = structure(list(a = factor("a", levels = letters)), class = c("data.table", "data.frame"))
+y = data.table(a = factor("a", levels = letters))
+setdroplevels(x)
+setdroplevels(y)
+test(2364.2, levels(x$a), levels(y$a))
+rm(x, y)