[Rcpp-commits] r2883 - pkg/Rcpp/src

[noreply at r-forge.r-project.org]

Author: dmbates
Date: 2011-01-25 21:15:16 +0100 (Tue, 25 Jan 2011)
New Revision: 2883

Modified:
   pkg/Rcpp/src/Evaluator.cpp
   pkg/Rcpp/src/Reference.cpp
   pkg/Rcpp/src/S4.cpp
   pkg/Rcpp/src/exceptions.cpp
Log:
Evaluate Rf_install() expressions before usage.


Modified: pkg/Rcpp/src/Evaluator.cpp
===================================================================
--- pkg/Rcpp/src/Evaluator.cpp	2011-01-25 16:33:24 UTC (rev 2882)
+++ pkg/Rcpp/src/Evaluator.cpp	2011-01-25 20:15:16 UTC (rev 2883)
@@ -63,8 +63,9 @@
    defined */
     SEXP convert_using_rfunction(SEXP x, const char* const fun) throw(::Rcpp::not_compatible) {
     	SEXP res = R_NilValue ;
-    	try{    
-    		res = Evaluator::run( Rf_lang2( Rf_install(fun), x ) ) ;
+    	try{
+	    SEXP funSym = Rf_install(fun);
+    		res = Evaluator::run( Rf_lang2( funSym, x ) ) ;
     	} catch( eval_error& e){
     		throw ::Rcpp::not_compatible( std::string("could not convert using R function : ") + fun  ) ;
     	}

Modified: pkg/Rcpp/src/Reference.cpp
===================================================================
--- pkg/Rcpp/src/Reference.cpp	2011-01-25 16:33:24 UTC (rev 2882)
+++ pkg/Rcpp/src/Reference.cpp	2011-01-25 20:15:16 UTC (rev 2883)
@@ -54,7 +54,8 @@
 	
 	Reference::Reference( const std::string& klass ) throw(S4_creation_error,reference_creation_error) : S4(){
 	    // using callback to R as apparently R_do_new_object always makes the same environment
-	    SEXP call = PROTECT( Rf_lang2( Rf_install( "new" ), Rf_mkString( klass.c_str() ) ) ) ;
+		SEXP newSym = Rf_install("new");
+	    SEXP call = PROTECT( Rf_lang2( newSym, Rf_mkString( klass.c_str() ) ) ) ;
 	    setSEXP( Rcpp::internal::try_catch( call ) ) ;
 	    UNPROTECT(1) ; // call
 	}
@@ -91,8 +92,9 @@
     
     void Reference::FieldProxy::set( SEXP x) const {
 		PROTECT(x);
+		SEXP dollarGetsSym = Rf_install( "$<-");
         SEXP call = PROTECT( Rf_lang4( 
-            Rf_install( "$<-"), 
+								 dollarGetsSym,
             const_cast<Reference&>(parent).asSexp(), 
             Rf_mkString( field_name.c_str() ), 
             x

Modified: pkg/Rcpp/src/S4.cpp
===================================================================
--- pkg/Rcpp/src/S4.cpp	2011-01-25 16:33:24 UTC (rev 2882)
+++ pkg/Rcpp/src/S4.cpp	2011-01-25 20:15:16 UTC (rev 2883)
@@ -73,17 +73,19 @@
 			// mimic the R call: 
 			// names( slot( getClassDef( cl ), "contains" ) )
 			// 
-			CharacterVector res = internal::try_catch( 
-				Rf_lang2(
-					R_NamesSymbol,
-					Rf_lang3( 
-						Rf_install( "slot" ),
-						Rf_lang2( Rf_install( "getClassDef"), cl ), 
-						Rf_mkString( "contains" )
-					) 
-				)
+		    SEXP slotSym = Rf_install( "slot" ), // cannot cause gc() once in symbol table
+			getClassDefSym = Rf_install( "getClassDef" );
+		    CharacterVector res = internal::try_catch( 
+			Rf_lang2(
+			    R_NamesSymbol,
+			    Rf_lang3( 
+				slotSym,
+				Rf_lang2( getClassDefSym, cl ), 
+				Rf_mkString( "contains" )
+				) 
+			    )
 			) ;
-			return any( res.begin(), res.end(), clazz.c_str() ) ;
+		    return any( res.begin(), res.end(), clazz.c_str() ) ;
 		} catch( ... ){
 			// we catch eval_error and also not_compatible when 
 			// contains is NULL

Modified: pkg/Rcpp/src/exceptions.cpp
===================================================================
--- pkg/Rcpp/src/exceptions.cpp	2011-01-25 16:33:24 UTC (rev 2882)
+++ pkg/Rcpp/src/exceptions.cpp	2011-01-25 20:15:16 UTC (rev 2883)
@@ -121,9 +121,10 @@
     	exception_what = "unrecognized exception" ;
     }
     
+    SEXP cppExceptSym = Rf_install("cpp_exception"); 	// cannot cause a gc() once in symbol table
     Rf_eval( 
 	    Rf_lang3( 
-		     Rf_install("cpp_exception"), 
+		cppExceptSym,
 		     Rf_mkString(exception_what.c_str()), 
 		     has_exception_class ? Rf_mkString(exception_class.c_str()) : R_NilValue), 
 		R_FindNamespace(Rf_mkString("Rcpp"))
@@ -144,10 +145,11 @@
 		} else{
 			exception_class = name ; /* just using the mangled name */
 		}
-   }
-   Rf_eval( 
+	}
+	SEXP cppExceptSym = Rf_install("cpp_exception"); // cannot cause a gc() once in symbol table
+	Rf_eval( 
 	    Rf_lang3( 
-		     Rf_install("cpp_exception"), 
+		cppExceptSym,
 		     Rf_mkString(exception_what.c_str()), 
 		     Rf_mkString(exception_class.c_str())
 		), R_FindNamespace(Rf_mkString("Rcpp"))
@@ -155,18 +157,20 @@
 }
 #else
 void forward_uncaught_exceptions_to_r(){
+	SEXP cppExceptSym = Rf_install("cpp_exception"); // cannot cause a gc() once in symbol table
 	Rf_eval( 
 	    Rf_lang3( 
-		     Rf_install("cpp_exception"), 
+		cppExceptSym,
 		     Rf_mkString("exception : we don't know how to get the exception message with your compiler, patches welcome"), 
 		     R_NilValue), 
 		R_FindNamespace(Rf_mkString("Rcpp"))
 	     ) ; 
 }
 void forward_exception_to_r( const std::exception& ex){
+	SEXP cppExceptSym = Rf_install("cpp_exception"); // cannot cause a gc() once in symbol table
 	Rf_eval( 
 	    Rf_lang3( 
-		     Rf_install("cpp_exception"), 
+		cppExceptSym,
 		     Rf_mkString(ex.what()), 
 		     R_NilValue), 
 		R_FindNamespace(Rf_mkString("Rcpp"))