More careful PROTECT()/UNPROTECT() in rbindlist for rchk (#6311)

* More careful PROTECT()/UNPROTECT() in rbindlist for rchk

* use one UNPROTECT

* initialize nprotect=2

* smaller diff

Author: MichaelChirico

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)

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,22 +534,25 @@ 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
         }
         ansloc += thisnrow;
       }
     }
   }
-  UNPROTECT(nprotect);  // ans, coercedForFactor, thisCol
+  UNPROTECT(nprotect); // ans, ansNames, coercedForFactor?
   return(ans);
 }