Clear rchk messages on CRAN

CRAN_Release.cmd

@@ -262,6 +262,17 @@ There are some things to overcome to achieve compile without USE_RINTERNALS, tho
 ## test.data.table()
 ## q("no")
 
+########################################################################
+#  rchk : https://github.com/kalibera/rchk
+########################################################################
+cd ~/build/rchk/trunk
+echo 'install.packages("~/GitHub/data.table/data.table_1.11.5.tar.gz",repos=NULL)' | ./bin/R --slave
+../scripts/check_package.sh data.table
+cat packages/lib/data.table/libs/*check
+# keep running and rerunning locally until all problems cease.
+#   rchk has an internal stack which can exhaust. Clearing the current set of problems (e.g. as displayed
+#   on CRAN) is not sufficient because new problems can be found because it didn't get that far before.
+#   hence repeating locally until clear is necessary.
 
 ###############################################
 #  QEMU to emulate big endian

src/assign.c

@@ -35,15 +35,15 @@ void setselfref(SEXP x) {
   // Called from C only, not R level, so returns void.
   setAttrib(x, SelfRefSymbol, p=R_MakeExternalPtr(
     R_NilValue,                  // for identical() to return TRUE. identical() doesn't look at tag and prot
-    getAttrib(x, R_NamesSymbol), // to detect if names has been replaced and its tl lost, e.g. setattr(DT,"names",...)
+    PROTECT(getAttrib(x, R_NamesSymbol)),  // to detect if names has been replaced and its tl lost, e.g. setattr(DT,"names",...)
     PROTECT(R_MakeExternalPtr(   // to avoid an infinite loop in object.size(), if prot=x here
       x,                         // to know if this data.table has been copied by key<-, attr<-, names<-, etc.
       R_NilValue,                // this tag and prot currently unused
       R_NilValue
     ))
   ));
   R_RegisterCFinalizerEx(p, finalizer, FALSE);
-  UNPROTECT(1);  // The PROTECT above is needed by --enable-strict-barrier (it seems, iiuc)
+  UNPROTECT(2);
 
 /*
   *  base::identical doesn't check prot and tag of EXTPTR, just that the ptr itself is the

src/fmelt.c

@@ -351,10 +351,9 @@ static void preprocess(SEXP DT, SEXP id, SEXP measure, SEXP varnames, SEXP valna
 }
 
 SEXP getvaluecols(SEXP DT, SEXP dtnames, Rboolean valfactor, Rboolean verbose, struct processData *data) {
-
-  int i, j, k, protecti=0, counter=0, thislen=0;
-  SEXP seqcols, thiscol, thisvaluecols, target, ansvals, thisidx=R_NilValue, flevels, clevels;
-  Rboolean coerced=FALSE, thisfac=FALSE, copyattr = FALSE, thisvalfactor;
+  int i, j, k, counter=0, thislen=0;
+  SEXP thisvaluecols, ansvals, thisidx=R_NilValue, flevels;
+  Rboolean copyattr = FALSE, thisvalfactor;
   size_t size;
   for (i=0; i<data->lvalues; i++) {
     thisvaluecols = VECTOR_ELT(data->valuecols, i);
@@ -366,7 +365,7 @@ SEXP getvaluecols(SEXP DT, SEXP dtnames, Rboolean valfactor, Rboolean verbose, s
     }
   }
   if (data->narm) {
-    seqcols = PROTECT(seq_int(data->lvalues, 1)); protecti++;
+    SEXP seqcols = PROTECT(seq_int(data->lvalues, 1));
     for (i=0; i<data->lmax; i++) {
       SEXP tmp = PROTECT(allocVector(VECSXP, data->lvalues));
       for (j=0; j<data->lvalues; j++) {
@@ -383,25 +382,30 @@ SEXP getvaluecols(SEXP DT, SEXP dtnames, Rboolean valfactor, Rboolean verbose, s
       data->totlen += length(w);
       UNPROTECT(2); // tmp twice
     }
-  } else data->totlen = data->nrow * data->lmax;
-  flevels = PROTECT(allocVector(VECSXP, data->lmax)); protecti++;
+    UNPROTECT(1);  // seqcols
+  } else {
+    data->totlen = data->nrow * data->lmax;
+  }
+  flevels = PROTECT(allocVector(VECSXP, data->lmax));
   Rboolean *isordered = (Rboolean *)R_alloc(data->lmax, sizeof(Rboolean));
-  ansvals = PROTECT(allocVector(VECSXP, data->lvalues)); protecti++;
+  ansvals = PROTECT(allocVector(VECSXP, data->lvalues));
   for (i=0; i<data->lvalues; i++) {
     thisvalfactor = (data->maxtype[i] == VECSXP) ? FALSE : valfactor;
-    SET_VECTOR_ELT(ansvals, i, target=allocVector(data->maxtype[i], data->totlen) );
+    SEXP target = PROTECT(allocVector(data->maxtype[i], data->totlen)); // to keep rchk happy
+    SET_VECTOR_ELT(ansvals, i, target);
+    UNPROTECT(1);  // still protected by virtue of being member of protected ansval.
     thisvaluecols = VECTOR_ELT(data->valuecols, i);
     counter = 0; copyattr = FALSE;
     for (j=0; j<data->lmax; j++) {
-      thiscol = (j < data->leach[i]) ? VECTOR_ELT(DT, INTEGER(thisvaluecols)[j]-1)
+      int thisprotecti = 0;
+      SEXP thiscol = (j < data->leach[i]) ? VECTOR_ELT(DT, INTEGER(thisvaluecols)[j]-1)
                        : allocNAVector(data->maxtype[i], data->nrow);
       if (!copyattr && data->isidentical[i] && !data->isfactor[i]) {
         copyMostAttrib(thiscol, target);
         copyattr = TRUE;
       }
       if (TYPEOF(thiscol) != TYPEOF(target) && (data->maxtype[i] == VECSXP || !isFactor(thiscol))) {
-        thiscol = PROTECT(coerceVector(thiscol, TYPEOF(target)));
-        coerced = TRUE;
+        thiscol = PROTECT(coerceVector(thiscol, TYPEOF(target)));  thisprotecti++;
       }
       if (data->narm) {
         thisidx = VECTOR_ELT(data->naidx, j);
@@ -421,8 +425,7 @@ SEXP getvaluecols(SEXP DT, SEXP dtnames, Rboolean valfactor, Rboolean verbose, s
         if (data->isfactor[i]) {
           if (isFactor(thiscol)) {
             SET_VECTOR_ELT(flevels, j, getAttrib(thiscol, R_LevelsSymbol));
-            thiscol = PROTECT(asCharacterFactor(thiscol));
-            thisfac = TRUE;
+            thiscol = PROTECT(asCharacterFactor(thiscol));  thisprotecti++;
             isordered[j] = isOrdered(thiscol);
           } else SET_VECTOR_ELT(flevels, j, thiscol);
         }
@@ -460,21 +463,16 @@ SEXP getvaluecols(SEXP DT, SEXP dtnames, Rboolean valfactor, Rboolean verbose, s
         default : error("Unknown column type '%s' for column '%s'.", type2char(TYPEOF(thiscol)), CHAR(STRING_ELT(dtnames, INTEGER(thisvaluecols)[i]-1)));
       }
       if (data->narm) counter += thislen;
-      if (coerced) {
-        UNPROTECT(1); coerced = FALSE;
-      }
-      if (thisfac) {
-        UNPROTECT(1); thisfac = FALSE;
-      }
+      UNPROTECT(thisprotecti);  // inside inner loop (note that it's double loop) so as to limit use of protection stack
     }
     if (thisvalfactor && data->isfactor[i] && TYPEOF(target) != VECSXP) {
-      clevels = combineFactorLevels(flevels, &(data->isfactor[i]), isordered);
+      SEXP clevels = PROTECT(combineFactorLevels(flevels, &(data->isfactor[i]), isordered));
       SEXP factorLangSxp = PROTECT(lang3(install(data->isfactor[i] == 1 ? "factor" : "ordered"), target, clevels));
       SET_VECTOR_ELT(ansvals, i, eval(factorLangSxp, R_GlobalEnv));
       UNPROTECT(2);  // clevels, factorLangSxp
     }
   }
-  UNPROTECT(protecti);
+  UNPROTECT(2);  // flevels, ansvals. Not using two protection counters (protecti and thisprotecti) to keep rchk happy.
   return(ansvals);
 }
 
@@ -653,13 +651,12 @@ SEXP fmelt(SEXP DT, SEXP id, SEXP measure, SEXP varfactor, SEXP valfactor, SEXP
     if (verbose) Rprintf("ncol(data) is 0. Nothing to melt. Returning original data.table.");
     return(DT);
   }
-  dtnames = getAttrib(DT, R_NamesSymbol);
+  dtnames = PROTECT(getAttrib(DT, R_NamesSymbol));
+  int protecti=1;
   if (isNull(dtnames)) error("names(data) is NULL. Please report to data.table-help");
   if (LOGICAL(narmArg)[0] == TRUE) narm = TRUE;
   if (LOGICAL(verboseArg)[0] == TRUE) verbose = TRUE;
-
   struct processData data;
-  int protecti=0;
   data.RCHK = PROTECT(allocVector(VECSXP, 2)); protecti++;
   preprocess(DT, id, measure, varnames, valnames, narm, verbose, &data);
   // edge case no measure.vars

src/freadR.c

@@ -224,7 +224,7 @@ _Bool userOverride(int8_t *type, lenOff *colNames, const char *anchor, int ncol)
     } else {
       if (!isNewList(colClassesSxp)) STOP("CfreadR: colClasses is not type list");
       if (!length(getAttrib(colClassesSxp, R_NamesSymbol))) STOP("CfreadR: colClasses is type list but has no names");
-      SEXP typeEnum_idx = PROTECT(chmatch(getAttrib(colClassesSxp, R_NamesSymbol), typeRName_sxp, NUT, FALSE));
+      SEXP typeEnum_idx = PROTECT(chmatch(PROTECT(getAttrib(colClassesSxp, R_NamesSymbol)), typeRName_sxp, NUT, FALSE));
       for (int i=0; i<LENGTH(colClassesSxp); i++) {
         SEXP items;
         signed char thisType = typeEnum[INTEGER(typeEnum_idx)[i]-1];
@@ -254,7 +254,7 @@ _Bool userOverride(int8_t *type, lenOff *colNames, const char *anchor, int ncol)
         UNPROTECT(1); // UNPROTECTing itemsInt inside loop to save protection stack
       }
       for (int i=0; i<ncol; i++) if (type[i]<0) type[i] *= -1;  // undo sign; was used to detect duplicates
-      UNPROTECT(1);  // typeEnum_idx
+      UNPROTECT(2);  // typeEnum_idx (+1 for its protect of getAttrib)
     }
     UNPROTECT(1);  // typeRName_sxp
   }

src/gsumm.c

@@ -233,9 +233,10 @@ SEXP gmin(SEXP x, SEXP narm)
   //clock_t start = clock();
   SEXP ans;
   if (grpn != n) error("grpn [%d] != length(x) [%d] in gmin", grpn, n);
+  int protecti=0;
   switch(TYPEOF(x)) {
   case LGLSXP: case INTSXP:
-    ans = PROTECT(allocVector(INTSXP, ngrp));
+    ans = PROTECT(allocVector(INTSXP, ngrp)); protecti++;
     if (!LOGICAL(narm)[0]) {
       for (i=0; i<ngrp; i++) INTEGER(ans)[i] = INT_MAX;
       for (i=0; i<n; i++) {
@@ -256,8 +257,7 @@ SEXP gmin(SEXP x, SEXP narm)
       for (i=0; i<ngrp; i++) {
         if (INTEGER(ans)[i] == NA_INTEGER) {
           warning("No non-missing values found in at least one group. Coercing to numeric type and returning 'Inf' for such groups to be consistent with base");
-          UNPROTECT(1);
-          ans = PROTECT(coerceVector(ans, REALSXP));
+          ans = PROTECT(coerceVector(ans, REALSXP)); protecti++;
           for (i=0; i<ngrp; i++) {
             if (ISNA(REAL(ans)[i])) REAL(ans)[i] = R_PosInf;
           }
@@ -267,7 +267,7 @@ SEXP gmin(SEXP x, SEXP narm)
     }
     break;
   case STRSXP:
-    ans = PROTECT(allocVector(STRSXP, ngrp));
+    ans = PROTECT(allocVector(STRSXP, ngrp)); protecti++;
     if (!LOGICAL(narm)[0]) {
       for (i=0; i<ngrp; i++) SET_STRING_ELT(ans, i, R_BlankString);
       for (i=0; i<n; i++) {
@@ -302,7 +302,7 @@ SEXP gmin(SEXP x, SEXP narm)
     }
     break;
   case REALSXP:
-    ans = PROTECT(allocVector(REALSXP, ngrp));
+    ans = PROTECT(allocVector(REALSXP, ngrp)); protecti++;
     if (!LOGICAL(narm)[0]) {
       for (i=0; i<ngrp; i++) REAL(ans)[i] = R_PosInf;
       for (i=0; i<n; i++) {
@@ -333,7 +333,7 @@ SEXP gmin(SEXP x, SEXP narm)
     error("Type '%s' not supported by GForce min (gmin). Either add the prefix base::min(.) or turn off GForce optimization using options(datatable.optimize=1)", type2char(TYPEOF(x)));
   }
   copyMostAttrib(x, ans); // all but names,dim and dimnames. And if so, we want a copy here, not keepattr's SET_ATTRIB.
-  UNPROTECT(1);
+  UNPROTECT(protecti);  // ans + maybe 1 coerced ans
   // Rprintf("this gmin took %8.3f\n", 1.0*(clock()-start)/CLOCKS_PER_SEC);
   return(ans);
 }
@@ -353,10 +353,10 @@ SEXP gmax(SEXP x, SEXP narm)
   // TODO rework gmax in the same way as gmin and remove this *update
   char *update = (char *)R_alloc(ngrp, sizeof(char));
   for (int i=0; i<ngrp; i++) update[i] = 0;
-
+  int protecti=0;
   switch(TYPEOF(x)) {
   case LGLSXP: case INTSXP:
-    ans = PROTECT(allocVector(INTSXP, ngrp));
+    ans = PROTECT(allocVector(INTSXP, ngrp)); protecti++;
     for (i=0; i<ngrp; i++) INTEGER(ans)[i] = 0;
     if (!LOGICAL(narm)[0]) { // simple case - deal in a straightforward manner first
       for (i=0; i<n; i++) {
@@ -387,8 +387,7 @@ SEXP gmax(SEXP x, SEXP narm)
       for (i=0; i<ngrp; i++) {
         if (update[i] != 1)  {// equivalent of INTEGER(ans)[thisgrp] == NA_INTEGER
           warning("No non-missing values found in at least one group. Coercing to numeric type and returning 'Inf' for such groups to be consistent with base");
-          UNPROTECT(1);
-          ans = PROTECT(coerceVector(ans, REALSXP));
+          ans = PROTECT(coerceVector(ans, REALSXP)); protecti++;
           for (i=0; i<ngrp; i++) {
             if (update[i] != 1) REAL(ans)[i] = -R_PosInf;
           }
@@ -398,7 +397,7 @@ SEXP gmax(SEXP x, SEXP narm)
     }
     break;
   case STRSXP:
-    ans = PROTECT(allocVector(STRSXP, ngrp));
+    ans = PROTECT(allocVector(STRSXP, ngrp)); protecti++;
     for (i=0; i<ngrp; i++) SET_STRING_ELT(ans, i, mkChar(""));
     if (!LOGICAL(narm)[0]) { // simple case - deal in a straightforward manner first
       for (i=0; i<n; i++) {
@@ -435,7 +434,7 @@ SEXP gmax(SEXP x, SEXP narm)
     }
     break;
   case REALSXP:
-    ans = PROTECT(allocVector(REALSXP, ngrp));
+    ans = PROTECT(allocVector(REALSXP, ngrp)); protecti++;
     for (i=0; i<ngrp; i++) REAL(ans)[i] = 0;
     if (!LOGICAL(narm)[0]) {
       for (i=0; i<n; i++) {
@@ -477,7 +476,7 @@ SEXP gmax(SEXP x, SEXP narm)
     error("Type '%s' not supported by GForce max (gmax). Either add the prefix base::max(.) or turn off GForce optimization using options(datatable.optimize=1)", type2char(TYPEOF(x)));
   }
   copyMostAttrib(x, ans); // all but names,dim and dimnames. And if so, we want a copy here, not keepattr's SET_ATTRIB.
-  UNPROTECT(1);
+  UNPROTECT(protecti);
   // Rprintf("this gmax took %8.3f\n", 1.0*(clock()-start)/CLOCKS_PER_SEC);
   return(ans);
 }

src/rbindlist.c

@@ -804,32 +804,30 @@ SEXP rbindlist(SEXP l, SEXP sexp_usenames, SEXP sexp_fill, SEXP idcol) {
 SEXP chmatch2_old(SEXP x, SEXP table, SEXP nomatch) {
 
   R_len_t i, j, k, nx, li, si, oi;
-  SEXP dt, l, ans, order, start, lens, grpid, index;
   if (TYPEOF(nomatch) != INTSXP || length(nomatch) != 1) error("'nomatch' must be an integer of length 1");
   if (!length(x) || isNull(x)) return(allocVector(INTSXP, 0));
   if (TYPEOF(x) != STRSXP) error("'x' must be a character vector");
   nx=length(x);
   if (!length(table) || isNull(table)) {
-    ans = PROTECT(allocVector(INTSXP, nx));
+    SEXP ans = PROTECT(allocVector(INTSXP, nx));
     for (i=0; i<nx; i++) INTEGER(ans)[i] = INTEGER(nomatch)[0];
     UNPROTECT(1);
     return(ans);
   }
   if (TYPEOF(table) != STRSXP) error("'table' must be a character vector");
   // Done with special cases. On to the real deal.
-  l = PROTECT(allocVector(VECSXP, 2));
-  SET_VECTOR_ELT(l, 0, x);
-  SET_VECTOR_ELT(l, 1, table);
 
-  UNPROTECT(1); // l
-  dt = PROTECT(unlist2(l));
+  SEXP tt = PROTECT(allocVector(VECSXP, 2));
+  SET_VECTOR_ELT(tt, 0, x);
+  SET_VECTOR_ELT(tt, 1, table);
+  SEXP dt = PROTECT(unlist2(tt));
 
   // order - first time
-  order = PROTECT(fast_order(dt, 2, 1));
-  start = getAttrib(order, sym_starts);
-  lens  = PROTECT(uniq_lengths(start, length(order))); // length(order) = nrow(dt)
-  grpid = VECTOR_ELT(dt, 1);
-  index = VECTOR_ELT(dt, 2);
+  SEXP order = PROTECT(fast_order(dt, 2, 1));
+  SEXP start = getAttrib(order, sym_starts);
+  SEXP lens  = PROTECT(uniq_lengths(start, length(order))); // length(order) = nrow(dt)
+  SEXP grpid = VECTOR_ELT(dt, 1);
+  SEXP index = VECTOR_ELT(dt, 2);
 
   // replace dt[1], we don't need it anymore
   k=0;
@@ -840,12 +838,11 @@ SEXP chmatch2_old(SEXP x, SEXP table, SEXP nomatch) {
     k += j;
   }
   // order - again
-  UNPROTECT(2); // order, lens
   order = PROTECT(fast_order(dt, 2, 1));
   start = getAttrib(order, sym_starts);
   lens  = PROTECT(uniq_lengths(start, length(order)));
 
-  ans = PROTECT(allocVector(INTSXP, nx));
+  SEXP ans = PROTECT(allocVector(INTSXP, nx));
   k = 0;
   for (i=0; i<length(lens); i++) {
     li = INTEGER(lens)[i];
@@ -854,7 +851,7 @@ SEXP chmatch2_old(SEXP x, SEXP table, SEXP nomatch) {
     if (oi > nx-1) continue;
     INTEGER(ans)[oi] = (li == 2) ? INTEGER(index)[INTEGER(order)[si+1]-1]+1 : INTEGER(nomatch)[0];
   }
-  UNPROTECT(4); // order, lens, ans
+  UNPROTECT(7);
   return(ans);
 }
 

src/reorder.c

@@ -37,7 +37,7 @@ SEXP reorder(SEXP x, SEXP order)
 
   R_len_t start = 0;
   while (start<nrow && INTEGER(order)[start] == start+1) start++;
-  if (start==nrow) return(R_NilValue);  // input is 1:n, nothing to do
+  if (start==nrow) { UNPROTECT(nprotect); return(R_NilValue); }  // input is 1:n, nothing to do
   R_len_t end = nrow-1;
   while (INTEGER(order)[end] == end+1) end--;
   for (R_len_t i=start; i<=end; i++) {