diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 696697ed9..7d49411c6 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -3046,8 +3046,8 @@ test(1006, print(as.data.table(M), nrows=10), output="gear NA.*1: 21.0") # rbinding factor with non-factor/character DT1 <- data.table(x=1:5, y=factor("a")) DT2 <- data.table(x=1:5, y=2) -test(1007, rbindlist(list(DT1, DT2)), data.table(x = c(1:5, 1:5), y = factor(c(rep('a', 5), rep('2', 5)), levels = c('a', '2')))) -test(1008, rbindlist(list(DT2, DT1)), data.table(x = c(1:5, 1:5), y = factor(c(rep('2', 5), rep('a', 5))))) +test(1007.1, rbindlist(list(DT1, DT2)), data.table(x = c(1:5, 1:5), y = factor(c(rep('a', 5), rep('2', 5)), levels = c('a', '2')))) +test(1007.2, rbindlist(list(DT2, DT1)), data.table(x = c(1:5, 1:5), y = factor(c(rep('2', 5), rep('a', 5))))) # rbindlist different types DT1 <- data.table(a = 1L, b = 2L) diff --git a/src/rbindlist.c b/src/rbindlist.c index 68c3166e1..40fcd8fe0 100644 --- a/src/rbindlist.c +++ b/src/rbindlist.c @@ -244,9 +244,9 @@ SEXP rbindlist(SEXP l, SEXP usenamesArg, SEXP fillArg, SEXP idcolArg, SEXP ignor ncol = length(VECTOR_ELT(l, first)); // ncol was increased as if fill=true, so reduce it back given fill=false (fill==false checked above) } - int nprotect = 0; - SEXP ans = PROTECT(allocVector(VECSXP, idcol + ncol)); nprotect++; - SEXP ansNames = PROTECT(allocVector(STRSXP, idcol + ncol)); nprotect++; + int nprotect = 2; + SEXP ans = PROTECT(allocVector(VECSXP, idcol + ncol)); + SEXP ansNames = PROTECT(allocVector(STRSXP, idcol + ncol)); setAttrib(ans, R_NamesSymbol, ansNames); if (idcol) { SET_STRING_ELT(ansNames, 0, STRING_ELT(idcolArg, 0)); @@ -534,15 +534,18 @@ SEXP rbindlist(SEXP l, SEXP usenamesArg, SEXP fillArg, SEXP idcolArg, SEXP ignor if (w==-1 || !length(thisCol=VECTOR_ELT(li, w))) { // !length for zeroCol warning above; #1871 writeNA(target, ansloc, thisnrow, false); // writeNA is integer64 aware and writes INT64_MIN } else { - bool listprotect = false; - if ((TYPEOF(target)==VECSXP || TYPEOF(target)==EXPRSXP) && TYPEOF(thisCol)!=TYPEOF(target)) { - // do an as.list() on the atomic column; #3528 - thisCol = PROTECT(coerceVector(thisCol, TYPEOF(target))); listprotect = true; + bool listprotect = (TYPEOF(target)==VECSXP || TYPEOF(target)==EXPRSXP) && TYPEOF(thisCol)!=TYPEOF(target); + // do an as.list() on the atomic column; #3528 + if (listprotect) { + thisCol = PROTECT(coerceVector(thisCol, TYPEOF(target))); + // else coerces if needed within memrecycle; with a no-alloc direct coerce from 1.12.4 (PR #3909) + const char *ret = memrecycle(target, R_NilValue, ansloc, thisnrow, thisCol, 0, -1, idcol+j+1, foundName); + UNPROTECT(1); // earlier unprotect rbindlist calls with lots of lists #4536 + if (ret) warning(_("Column %d of item %d: %s"), w+1, i+1, ret); + } else { + const char *ret = memrecycle(target, R_NilValue, ansloc, thisnrow, thisCol, 0, -1, idcol+j+1, foundName); + if (ret) warning(_("Column %d of item %d: %s"), w+1, i+1, ret); } - // else coerces if needed within memrecycle; with a no-alloc direct coerce from 1.12.4 (PR #3909) - const char *ret = memrecycle(target, R_NilValue, ansloc, thisnrow, thisCol, 0, -1, idcol+j+1, foundName); - if (listprotect) UNPROTECT(1); // earlier unprotect rbindlist calls with lots of lists #4536 - if (ret) warning(_("Column %d of item %d: %s"), w+1, i+1, ret); // e.g. when precision is lost like assigning 3.4 to integer64; test 2007.2 // TODO: but maxType should handle that and this should never warn } @@ -550,6 +553,6 @@ SEXP rbindlist(SEXP l, SEXP usenamesArg, SEXP fillArg, SEXP idcolArg, SEXP ignor } } } - UNPROTECT(nprotect); // ans, coercedForFactor, thisCol + UNPROTECT(nprotect); // ans, ansNames, coercedForFactor? return(ans); }