[Rcpp-commits] r3479 - in pkg/Rcpp: . src

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

Author: dmbates
Date: 2012-02-16 20:55:28 +0100 (Thu, 16 Feb 2012)
New Revision: 3479

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/src/Evaluator.cpp
Log:
PROTECT the expr argument to Evaluator::Run.  Reorganized code in that method.


Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2012-02-15 16:34:46 UTC (rev 3478)
+++ pkg/Rcpp/ChangeLog	2012-02-16 19:55:28 UTC (rev 3479)
@@ -1,3 +1,8 @@
+2012-02-16  Douglas Bates  <bates at stat.wisc.edu>
+
+	* src/Evaluator.cpp: PROTECT the expr argument to Evaluator::Run.
+	Reorganize code.
+
 2012-02-15  Dirk Eddelbuettel  <edd at debian.org>
 
         * DESCRIPTION: Release 0.9.10

Modified: pkg/Rcpp/src/Evaluator.cpp
===================================================================
--- pkg/Rcpp/src/Evaluator.cpp	2012-02-15 16:34:46 UTC (rev 3478)
+++ pkg/Rcpp/src/Evaluator.cpp	2012-02-16 19:55:28 UTC (rev 3479)
@@ -26,45 +26,41 @@
 namespace Rcpp {
 
     SEXP Evaluator::run(SEXP expr, SEXP env) {
-        
+        PROTECT(expr);
+
         maybe_init() ;
         reset_current_error() ; 
+
         Environment RCPP = Environment::Rcpp_namespace(); 
-        static SEXP rcpp_tryCatch = NULL;
-        if (!rcpp_tryCatch) rcpp_tryCatch = ::Rf_install( "rcpp_tryCatch" );
-        
-        SEXP call = PROTECT( 
-                            Rf_lang2( 
-                                     // internal::get_rcpptrycatch() ,
-                                     rcpp_tryCatch,
-                                     Rf_lang3( internal::get_evalq() , expr, env )
-                                     // , 
-                                     // Rf_eval( Rf_install(".rcpp_error_recorder"),  RCPP )
-                                      )
-                             ) ;
-        // SET_TAG( CDR(CDR(call)), Rf_install("error") ) ;
-    
+        static SEXP rcpp_tryCatchSym = NULL, evalqSym, errorOccuredSym, getCurrentErrorMessageSym;
+        if (!rcpp_tryCatchSym) {
+            rcpp_tryCatchSym          = ::Rf_install("rcpp_tryCatch");
+            evalqSym                  = ::Rf_install("evalq");
+            errorOccuredSym           = ::Rf_install("errorOccured");
+            getCurrentErrorMessageSym = ::Rf_install("getCurrentErrorMessage");
+        }
+
+        SEXP call = PROTECT(::Rf_lang2(rcpp_tryCatchSym, PROTECT(::Rf_lang3(evalqSym, expr, env))));
         /* call the tryCatch call */
-        SEXP res = PROTECT( Rf_eval( call, RCPP ) );
+        SEXP res  = PROTECT(::Rf_eval( call, RCPP ) );
         
         /* was there an error ? */
-        SEXP errorOccuredSym = Rf_install("errorOccured");
-        SEXP err_call = PROTECT( Rf_lang1( errorOccuredSym ) ) ;
-        SEXP err_res  = PROTECT( Rf_eval( err_call, RCPP ) ) ;
-        int error = LOGICAL( err_res )[0];
+        int error = ::Rf_asLogical(PROTECT(::Rf_eval(PROTECT(::Rf_lang1(errorOccuredSym)), RCPP)));
         UNPROTECT(2) ;
         
         if( error ) {
-            SEXP getCurrentErrorMessageSym = Rf_install("getCurrentErrorMessage");
-            SEXP err_msg = PROTECT( Rf_eval( Rf_lang1(getCurrentErrorMessageSym),  RCPP ) );
-            std::string message = CHAR(STRING_ELT(err_msg,0)) ;
-            UNPROTECT( 3 ) ;
+            std::string 
+                message(CHAR(::Rf_asChar(PROTECT(::Rf_eval(
+                                                     PROTECT(::Rf_lang1(getCurrentErrorMessageSym)),
+                                                     RCPP)))));
+            UNPROTECT( 6 ) ;
             throw eval_error(message) ;
-        } else {
-            UNPROTECT(2) ;
-            return res ;
         }
+
+        UNPROTECT(4) ;
+        return res ;
     }
+
     
     SEXP Evaluator::run( SEXP expr) {
         return run(expr, R_GlobalEnv );