diff --git a/NEWS.md b/NEWS.md index 976d6b07a..ba09d8630 100644 --- a/NEWS.md +++ b/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). diff --git a/R/data.table.R b/R/data.table.R index 70160affa..470b44847 100644 --- a/R/data.table.R +++ b/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) diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 92c7bfcea..df341cde0 100644 --- a/inst/tests/tests.Rraw +++ b/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) diff --git a/src/data.table.h b/src/data.table.h index dbfe495ed..df46c4a33 100644 --- a/src/data.table.h +++ b/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); diff --git a/src/init.c b/src/init.c index 069223b98..3209168c0 100644 --- a/src/init.c +++ b/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)©, -1}, + {"Ccopy", (DL_FUNC)©, 2}, {"Cshallowwrapper", (DL_FUNC)&shallowwrapper, -1}, {"Csetdt_nrows", (DL_FUNC)&setdt_nrows, -1}, {"Calloccolwrapper", (DL_FUNC)&alloccolwrapper, -1}, diff --git a/src/wrappers.c b/src/wrappers.c index a82bf5f05..ae2e738ba 100644 --- a/src/wrappers.c +++ b/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.