Merge pull request #523 from thirdwing/master

Remove unsafe usage of Rf_eval (close #498)

Author: eddelbuettel

ChangeLog

@@ -1,3 +1,14 @@
+2016-07-31 Qiang Kou <[email protected]>
+
+        * inst/examples/SugarPerformance/sugarBenchmarks.R: Remove usage of Rf_eval
+        * inst/include/Rcpp/Environment.h: Idem
+        * inst/include/Rcpp/Module.h: Idem
+        * inst/include/Rcpp/exceptions.h: Idem
+        * inst/include/Rcpp/proxy/FieldProxy.h: Idem
+        * inst/include/Rcpp/r_cast.h: Idem
+        * inst/unitTests/cpp/language.cpp: Idem
+        * src/barrier.cpp: Idem
+
 2016-07-24  Dirk Eddelbuettel  <[email protected]>
 
         * inst/unitTests/cpp/rmath.cpp: Added RNG unit tests for sugar variants

inst/examples/SugarPerformance/sugarBenchmarks.R

@@ -53,7 +53,7 @@ src <- sprintf( '
 
     timer.Reset(); timer.Start();
     for (unsigned int i=0; i<runs; i++) {
-        NumericVector res2 = Rf_eval( call, e ) ;
+        NumericVector res2 = Rcpp_eval( call, e ) ;
     }
     timer.Stop();
     double t3 = timer.ElapsedTime();

inst/include/Rcpp/Environment.h

@@ -247,7 +247,7 @@ namespace Rcpp{
                     Shield<SEXP> call( Rf_lang2(internalSym,
                             Rf_lang4(removeSym, Rf_mkString(name.c_str()), Storage::get__(), Rf_ScalarLogical( FALSE ))
                         ) );
-                    Rf_eval( call, R_GlobalEnv ) ;
+                    Rcpp_eval( call, R_GlobalEnv ) ;
                 }
             } else{
                 throw no_such_binding(name) ;

inst/include/Rcpp/Module.h

@@ -454,7 +454,7 @@ static VARIABLE_IS_NOT_USED SEXP moduleSym = NULL;
 // this macro is called by code wanting to load a module -- see RInside's rinside_module_sample0.cpp
 #define LOAD_RCPP_MODULE(NAME) \
     Shield<SEXP> __load_module_call__( Rf_lang2( GET_MODULE_SYM, _rcpp_module_boot_##NAME() ); \
-    Rf_eval(__load_module_call__), R_GlobalEnv );
+    Rcpp_eval(__load_module_call__), R_GlobalEnv );
 
 #endif
 

inst/include/Rcpp/exceptions.h

@@ -129,7 +129,7 @@ namespace Rcpp{
 inline SEXP get_last_call(){
     SEXP sys_calls_symbol = Rf_install( "sys.calls" ) ;
     Rcpp::Shield<SEXP> sys_calls_expr( Rf_lang1(sys_calls_symbol) );
-    Rcpp::Shield<SEXP> calls( Rf_eval( sys_calls_expr, R_GlobalEnv ) );
+    Rcpp::Shield<SEXP> calls( Rcpp_eval( sys_calls_expr, R_GlobalEnv ) );
     SEXP res = calls ;
     while( !Rf_isNull(CDR(res)) ) res = CDR(res);
     return CAR(res) ;

inst/include/Rcpp/proxy/FieldProxy.h

@@ -42,12 +42,12 @@ class FieldProxyPolicy {
 
         SEXP get() const {
             Shield<SEXP> call( Rf_lang3( R_DollarSymbol, parent, Rf_mkString(field_name.c_str()) ) ) ;
-            return Rf_eval( call, R_GlobalEnv ) ;
+            return Rcpp_eval( call, R_GlobalEnv ) ;
         }
         void set(SEXP x ) {
             SEXP dollarGetsSym = Rf_install( "$<-");
             Shield<SEXP> call( Rf_lang4( dollarGetsSym, parent, Rf_mkString(field_name.c_str()) , x ) ) ;
-            parent.set__( Rf_eval( call, R_GlobalEnv ) );
+            parent.set__( Rcpp_eval( call, R_GlobalEnv ) );
         }
     } ;
 
@@ -67,7 +67,7 @@ class FieldProxyPolicy {
 
         SEXP get() const {
             Shield<SEXP> call( Rf_lang3( R_DollarSymbol, parent, Rf_mkString(field_name.c_str()) ) ) ;
-            return Rf_eval( call, R_GlobalEnv ) ;
+            return Rcpp_eval( call, R_GlobalEnv ) ;
         }
     } ;
 

inst/include/Rcpp/r_cast.h

@@ -95,7 +95,7 @@ namespace Rcpp{
                     // return Rf_coerceVector( x, STRSXP );
                     // coerceVector does not work for some reason
                     Shield<SEXP> call( Rf_lang2( Rf_install( "as.character" ), x ) ) ;
-                    Shield<SEXP> res( Rf_eval( call, R_GlobalEnv ) ) ;
+                    Shield<SEXP> res( Rcpp_eval( call, R_GlobalEnv ) ) ;
                     return res ;
                 }
             case CHARSXP:

inst/unitTests/cpp/language.cpp

@@ -68,7 +68,7 @@ Language runit_lang_square_lv(){
 SEXP runit_lang_fun( Function fun, IntegerVector x ){
     Language call( fun );
     call.push_back(x) ;
-    return Rf_eval( call, R_GlobalEnv ) ;
+    return Rcpp_eval( call, R_GlobalEnv ) ;
 }
 
 // [[Rcpp::export]]

src/barrier.cpp

@@ -28,6 +28,8 @@
 #include <algorithm>
 #include <Rcpp/protection/Shield.h>
 
+namespace Rcpp { SEXP Rcpp_eval(SEXP, SEXP); }
+
 // [[Rcpp::register]]
 SEXP get_string_elt(SEXP x, int i) {
     return STRING_ELT(x, i);
@@ -95,7 +97,7 @@ SEXP get_rcpp_cache() {
         SEXP getNamespaceSym = Rf_install("getNamespace"); // cannot be gc()'ed  once in symbol table
         Rcpp::Shield<SEXP> RcppString(Rf_mkString("Rcpp"));
         Rcpp::Shield<SEXP> call(Rf_lang2(getNamespaceSym, RcppString));
-        Rcpp::Shield<SEXP> RCPP(Rf_eval(call, R_GlobalEnv));
+        Rcpp::Shield<SEXP> RCPP(Rcpp_eval(call, R_GlobalEnv));
 
         Rcpp_cache = Rf_findVarInFrame(RCPP, Rf_install(".rcpp_cache"));
         Rcpp_cache_know = true;
@@ -137,7 +139,7 @@ SEXP init_Rcpp_cache() {
     SEXP getNamespaceSym = Rf_install("getNamespace"); // cannot be gc()'ed  once in symbol table
     Rcpp::Shield<SEXP> RcppString(Rf_mkString("Rcpp"));
     Rcpp::Shield<SEXP> call(Rf_lang2(getNamespaceSym, RcppString));
-    Rcpp::Shield<SEXP> RCPP(Rf_eval(call, R_GlobalEnv));
+    Rcpp::Shield<SEXP> RCPP(Rcpp_eval(call, R_GlobalEnv));
     Rcpp::Shield<SEXP> cache(Rf_allocVector(VECSXP, RCPP_CACHE_SIZE));
 
     // the Rcpp namespace