Refactored duplicate recursive assignment logic in [.data.table and setDT into shared helper

R/data.table.R

@@ -128,6 +128,35 @@ replace_dot_alias = function(e) {
   }
 }
 
+.reassign_extracted_table = function(name, value, env, err_msg_detail, err_msg_na) {
+  k = eval(name[[2L]], env, env)
+  if (is.list(k)) {
+    origj = j = if (name %iscall% "$") as.character(name[[3L]]) else eval(name[[3L]], env, env)
+    if (length(j) != 1L) {
+      stopf(
+        "Cannot assign with a recursive index of length %d. The syntax %s is only valid when the index i is length 1.",
+        length(j), err_msg_detail
+      )
+    }
+    if (is.character(j)) {
+      idx = match(j, names(k))
+      if (is.na(idx)) {
+        if (is.null(err_msg_na)) {
+          internal_error("item '%s' not found in names of list", origj) # nocov
+        } else {
+          stopf(err_msg_na, origj)
+        }
+      }
+      j = idx
+    }
+    .Call(Csetlistelt, k, as.integer(j), value)
+  } else if (is.environment(k) && exists(as.character(name[[3L]]), k, inherits = FALSE)) {
+    assign(as.character(name[[3L]]), value, k, inherits = FALSE)
+  } else if (isS4(k)) {
+    .Call(CsetS4elt, k, as.character(name[[3L]]), value)
+  }
+}
+
 "[.data.table" = function(x, i, j, by, keyby, with=TRUE, nomatch=NA, mult="all", roll=FALSE, rollends=if (roll=="nearest") c(TRUE,TRUE) else if (roll>=0.0) c(FALSE,TRUE) else c(TRUE,FALSE), which=FALSE, .SDcols, verbose=getOption("datatable.verbose"), allow.cartesian=getOption("datatable.allow.cartesian"), drop=NULL, on=NULL, env=NULL, showProgress=getOption("datatable.showProgress", interactive()))
 {
   # ..selfcount <<- ..selfcount+1  # in dev, we check no self calls, each of which doubles overhead, or could
@@ -1214,21 +1243,12 @@ replace_dot_alias = function(e) {
             setalloccol(x, n, verbose=verbose)   # always assigns to calling scope; i.e. this scope
             if (is.name(name)) {
               assign(as.character(name),x,parent.frame(),inherits=TRUE)
-            } else if (.is_simple_extraction(name)) { # TODO(#6702): use a helper here as the code is very similar to setDT().
-              k = eval(name[[2L]], parent.frame(), parent.frame())
-              if (is.list(k)) {
-                origj = j = if (name[[1L]] == "$") as.character(name[[3L]]) else eval(name[[3L]], parent.frame(), parent.frame())
-                if (is.character(j)) {
-                  if (length(j)!=1L) stopf("Cannot assign to an under-allocated recursively indexed list -- L[[i]][,:=] syntax is only valid when i is length 1, but its length is %d", length(j))
-                  j = match(j, names(k))
-                  if (is.na(j)) internal_error("item '%s' not found in names of list", origj) # nocov
-                }
-                .Call(Csetlistelt,k,as.integer(j), x)
-              } else if (is.environment(k) && exists(as.character(name[[3L]]), k)) {
-                assign(as.character(name[[3L]]), x, k, inherits=FALSE)
-              } else if (isS4(k)) {
-                .Call(CsetS4elt, k, as.character(name[[3L]]), x)
-              }
+            } else if (.is_simple_extraction(name)) {
+              .reassign_extracted_table(
+                name, x, parent.frame(),
+                err_msg_detail = "L[[i]][,:=]",
+                err_msg_na     = NULL # Shouldn't be needed; triggers internal error if so
+              )
             } # TO DO: else if env$<- or list$<-
           }
         }
@@ -2973,22 +2993,11 @@ setDT = function(x, keep.rownames=FALSE, key=NULL, check.names=FALSE) {
     assign(name, x, parent.frame(), inherits=TRUE)
   } else if (.is_simple_extraction(name)) {
     # common case is call from 'lapply()'
-    k = eval(name[[2L]], parent.frame(), parent.frame())
-    if (is.list(k)) {
-      origj = j = if (name[[1L]] == "$") as.character(name[[3L]]) else eval(name[[3L]], parent.frame(), parent.frame())
-      if (length(j) == 1L) {
-        if (is.character(j)) {
-          j = match(j, names(k))
-          if (is.na(j))
-            stopf("Item '%s' not found in names of input list", origj)
-        }
-      }
-      .Call(Csetlistelt, k, as.integer(j), x)
-    } else if (is.environment(k) && exists(as.character(name[[3L]]), k)) {
-      assign(as.character(name[[3L]]), x, k, inherits=FALSE)
-    } else if (isS4(k)) {
-      .Call(CsetS4elt, k, as.character(name[[3L]]), x)
-    }
+    .reassign_extracted_table(
+      name, x, parent.frame(),
+      err_msg_detail = "setDT(L[[i]])",
+      err_msg_na     = "Item '%s' not found in names of input list"
+    )
   } else if (name %iscall% "get") { # #6725
     # edit 'get(nm, env)' call to be 'assign(nm, x, envir=env)'
     name = match.call(get, name)

inst/tests/tests.Rraw

@@ -15880,7 +15880,7 @@ test(2074.03, data.table(grade=c(50L, 91L, 95L, 51L, 89L))[ , .N, by=evaluate(gr
 ## error: use recursive character list indexing to assign when also doing alloc.col()
 opt = options(datatable.alloccol=1L)
 l = list(foo = list(bar = data.table(a = 1:3, b = 4:6)))
-test(2074.04, l[[c('foo', 'bar')]][ , (letters) := 16:18], error = 'under-allocated recursively indexed list')
+test(2074.04, l[[c('foo', 'bar')]][ , (letters) := 16:18], error = 'Cannot assign with a recursive index of length')
 options(opt)
 ## alloc.col when using 0-truelength j assigning to a subset
 DT = data.table(a=1)
@@ -21167,3 +21167,9 @@ test(2317.6, DT1[DF1, on='a', .(d = x.a + i.d)]$d, 5)
 test(2317.7, DT1[DF2, on='a', e := i.e]$e, 5)
 test(2317.8, DT1[DF2, on='a', e2 := x.a + i.e]$e2, 6)
 test(2317.9, DT1[DF2, on='a', .(e = x.a + i.e)]$e, 6)
+
+# Test for issue #6702
+test(2318.1, {
+  data_store = list(nested = list(df_to_fix = data.frame(id = 1:3, val = letters[1:3])))
+  setDT(data_store[[c("nested", "df_to_fix")]])
+}, error = "Cannot assign with a recursive index of length")