Merge pull request #893 from krlmlr/f-no-init-protect

Rewrite no_init() and other functions to reduce false positives

Author: eddelbuettel

inst/include/Rcpp/api/meat/Rcpp_eval.h

@@ -75,7 +75,7 @@ inline SEXP Rcpp_fast_eval(SEXP expr, SEXP env) {
 inline SEXP Rcpp_eval(SEXP expr, SEXP env) {
 
     // 'identity' function used to capture errors, interrupts
-    SEXP identity = Rf_findFun(::Rf_install("identity"), R_BaseNamespace);
+    Shield<SEXP> identity(Rf_findFun(::Rf_install("identity"), R_BaseNamespace));
 
     if (identity == R_UnboundValue) {
         stop("Failed to find 'base::identity()'");

inst/include/Rcpp/exceptions.h

@@ -243,7 +243,7 @@ namespace internal {
     inline bool is_Rcpp_eval_call(SEXP expr) {
         SEXP sys_calls_symbol = Rf_install("sys.calls");
         SEXP identity_symbol = Rf_install("identity");
-        SEXP identity_fun = Rf_findFun(identity_symbol, R_BaseEnv);
+        Shield<SEXP> identity_fun(Rf_findFun(identity_symbol, R_BaseEnv));
         SEXP tryCatch_symbol = Rf_install("tryCatch");
         SEXP evalq_symbol = Rf_install("evalq");
 

inst/include/Rcpp/protection/Shelter.h

@@ -27,11 +27,11 @@ namespace Rcpp {
 
         inline SEXP operator()(SEXP x){
             nprotected++;
-            return PROTECT(x) ;
+            return Rcpp_protect(x) ;
         }
 
         ~Shelter(){
-            UNPROTECT(nprotected) ;
+            Rcpp_unprotect(nprotected) ;
             nprotected = 0 ;
         }
 

inst/include/Rcpp/protection/Shield.h

@@ -25,12 +25,18 @@ namespace Rcpp{
         return x ;
     }
 
+    inline void Rcpp_unprotect(int i){
+        // Prefer this function over UNPROTECT() in Rcpp so that all
+        // balance checks errors by rchk are contained at one location (#892)
+        UNPROTECT(i);
+    }
+
     template <typename T>
     class Shield{
     public:
         Shield( SEXP t_) : t(Rcpp_protect(t_)){}
         ~Shield(){
-            if( t != R_NilValue ) UNPROTECT(1) ;
+            if( t != R_NilValue ) Rcpp_unprotect(1) ;
         }
 
         operator SEXP() const { return t; }

inst/include/Rcpp/vector/no_init.h

@@ -37,7 +37,11 @@ class no_init_vector {
 
     template <int RTYPE, template <class> class StoragePolicy >
     operator Vector<RTYPE, StoragePolicy>() const {
-        return Rf_allocVector(RTYPE, size) ;
+        // Explicitly protect temporary vector to avoid false positive
+        // with rchk (#892)
+        Shield<SEXP> x(Rf_allocVector(RTYPE, size));
+        Vector<RTYPE, PreserveStorage> ret(x);
+        return ret;
     }
 
 private:
@@ -58,7 +62,11 @@ class no_init_matrix {
 
     template <int RTYPE, template <class> class StoragePolicy >
     operator Matrix<RTYPE, StoragePolicy>() const {
-        return Rf_allocMatrix(RTYPE, nr, nc);
+        // Explicitly protect temporary matrix to avoid false positive
+        // with rchk (#892)
+        Shield<SEXP> x(Rf_allocMatrix(RTYPE, nr, nc));
+        Matrix<RTYPE, PreserveStorage> ret(x);
+        return ret;
     }
 
 private: