copy(): only overwrite the list when necessary, consider the attributes

NEWS.md

@@ -70,6 +70,8 @@
 
 15. `as.IDate()` and `as.ITime()` now preserve names, matching base `as.Date()` behavior, [#7252](https://github.com/Rdatatable/data.table/issues/7252). Thanks @DavisVaughan for the report and @venom1204 for the PR.
 
+16. `copy()` is now more consistent about reallocating nested `data.table`s, [#7456](https://github.com/Rdatatable/data.table/issues/7456). The resulting list is now only overwritten when necessary, list columns inside data.tables are searched recursively, and their attributes are walked in search of data.tables to reallocate as well. Thanks to @be-marc for the report, @david-cortes for additional information, and @aitap for the fix.
+
 ### Notes
 
 1. {data.table} now depends on R 3.5.0 (2018).

R/data.table.R

@@ -2780,26 +2780,8 @@ sort_by.data.table <- function(x, y, ...)
 
 # TO DO, add more warnings e.g. for by.data.table(), telling user what the data.table syntax is but letting them dispatch to data.frame if they want
 
-copy = function(x) {
-  newx = .Call(Ccopy,x)  # copies at length but R's duplicate() also copies truelength over.
-                         # TO DO: inside Ccopy it could reset tl to 0 or length, but no matter as selfrefok detects it
-                         # TO DO: revisit duplicate.c in R 3.0.3 and see where it's at
-
-  reallocate = function(y) {
-    if (is.data.table(y)) {
-      .Call(C_unlock, y)
-      setalloccol(y)
-    } else if (is.list(y)) {
-      oldClass = class(y)
-      setattr(y, 'class', NULL)  # otherwise [[.person method (which returns itself) results in infinite recursion, #4620
-      y[] = lapply(y, reallocate)
-      if (!identical(oldClass, 'list')) setattr(y, 'class', oldClass)
-    }
-    y
-  }
-
-  reallocate(newx)
-}
+copy = function(x)
+  .Call(Ccopy, x, getOption('datatable.alloccol'))
 
 .shallow = function(x, cols = NULL, retain.key = FALSE, unlock = FALSE) {
   wasnull = is.null(cols)

inst/tests/tests.Rraw

@@ -21855,3 +21855,16 @@ test(2379.14, as.IDate(d) - 1L, as.IDate(as.Date(d) - 1L))
 test(2380.01, tstrsplit(c("ABC-DEF", "ABC-DEF-GHI", "ABC-DEF-GHI-JKL", "ABC-DEF-GHI-JKL-MNO"), "-", fixed=TRUE, keep=1:3, rev=TRUE), list(c("DEF", "GHI", "JKL", "MNO"), c("ABC", "DEF", "GHI", "JKL"), c(NA_character_, "ABC", "DEF", "GHI")))
 test(2380.02, tstrsplit(c("A-B", "A-B-C"), "-", fixed=TRUE, rev=TRUE), list(c("B", "C"), c("A", "B"), c(NA_character_, "A")))
 test(2380.03, tstrsplit("A-B", "-", rev=NA), error="'rev' must be TRUE or FALSE.")
+
+# copy() reallocates data.tables inside list columns and attributes, #7820
+x = list()
+attr(x, 'foo') = 1:2
+attr(x, 'dt') = data.table()
+test(2381.1, truelength(attr(copy(x), 'dt')) > 0L)
+rm(x)
+inner = data.table(a=1)
+DT = data.table(x=1:2, y=list(inner, inner))
+DT2 = copy(DT)
+test(2381.2, truelength(DT2$y[[1L]]) > 0L)
+test(2381.3, DT2$y[[1L]][, b := 2][, b], 2)
+rm(inner, DT, DT2)

src/data.table.h

@@ -409,7 +409,7 @@ SEXP copyCols(SEXP x, SEXP cols);
 // where there are no arguments, it must be (void) not () to be a strict prototype
 SEXP setattrib(SEXP, SEXP, SEXP);
 SEXP assign(SEXP, SEXP, SEXP, SEXP, SEXP);
-SEXP copy(SEXP);
+SEXP copy(SEXP, SEXP);
 SEXP setdt_nrows(SEXP);
 SEXP alloccolwrapper(SEXP, SEXP, SEXP);
 SEXP allocrowwrapper(SEXP, SEXP);

src/init.c

@@ -54,7 +54,7 @@ static const R_CallMethodDef callMethods[] = {
     {"Cbmerge", (DL_FUNC)&bmerge, -1},
     {"Cassign", (DL_FUNC)&assign, -1},
     {"Cdogroups", (DL_FUNC)&dogroups, -1},
-    {"Ccopy", (DL_FUNC)&copy, -1},
+    {"Ccopy", (DL_FUNC)&copy, 2},
     {"Cshallowwrapper", (DL_FUNC)&shallowwrapper, -1},
     {"Csetdt_nrows", (DL_FUNC)&setdt_nrows, -1},
     {"Calloccolwrapper", (DL_FUNC)&alloccolwrapper, -1},

src/wrappers.c

@@ -57,9 +57,48 @@ SEXP setlevels(SEXP x, SEXP levels, SEXP ulevels) {
   return(x);
 }
 
-SEXP copy(SEXP x)
-{
-  return(duplicate(x));
+struct realloc_nested_dt_attr_ctx {
+  SEXP x;
+  int overAlloc;
+};
+static SEXP realloc_nested_dt_list(SEXP x, int overAlloc, bool replacePairlists);
+static SEXP realloc_nested_dt_list_attr(SEXP tag, SEXP att, void *ctx_) {
+  struct realloc_nested_dt_attr_ctx *ctx = ctx_;
+  SEXP newatt = realloc_nested_dt_list(att, ctx->overAlloc, false);
+  if (newatt != att) {
+    PROTECT(newatt);
+    setAttrib(ctx->x, tag, newatt);
+    UNPROTECT(1);
+  }
+  return NULL;
+}
+static SEXP realloc_nested_dt_list(SEXP x, int overAlloc, bool replacePairlists) {
+  int nprot = 0;
+  if (inherits(x, "data.table")) {
+    x = PROTECT(alloccol(x, LENGTH(x) + overAlloc, FALSE)); ++nprot;
+    unlock(x);
+  }
+  if (replacePairlists && TYPEOF(x) == LISTSXP) {
+    x = PROTECT(coerceVector(x, VECSXP)); ++nprot;
+  }
+  if (TYPEOF(x) == VECSXP) for (R_xlen_t i = 0; i < XLENGTH(x); ++i) {
+    SEXP xi = VECTOR_ELT(x, i);
+    SEXP xinew = realloc_nested_dt_list(xi, overAlloc, false);
+    if (xinew != xi)
+      SET_VECTOR_ELT(x, i, xinew);
+  }
+  struct realloc_nested_dt_attr_ctx ctx = { .x = x, .overAlloc = overAlloc };
+  R_mapAttrib(x, realloc_nested_dt_list_attr, &ctx);
+  UNPROTECT(nprot);
+  return x;
+}
+
+SEXP copy(SEXP x, SEXP overAllocArg) {
+  int overAlloc = checkOverAlloc(overAllocArg);
+  PROTECT(x = duplicate(x));
+  x = realloc_nested_dt_list(x, overAlloc, true);
+  UNPROTECT(1);
+  return x;
 }
 
 // Internal use only. So that := can update elements of a list of data.table, #2204. Just needed to overallocate/grow the VECSXP.