[Rcpp-commits] r3469 - in pkg/Rcpp: R src

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

Author: romain
Date: 2012-02-06 22:38:25 +0100 (Mon, 06 Feb 2012)
New Revision: 3469

Modified:
   pkg/Rcpp/R/exceptions.R
   pkg/Rcpp/src/Evaluator.cpp
   pkg/Rcpp/src/cache.cpp
Log:
using withCAllingHandlers

Modified: pkg/Rcpp/R/exceptions.R
===================================================================
--- pkg/Rcpp/R/exceptions.R	2012-02-06 15:50:32 UTC (rev 3468)
+++ pkg/Rcpp/R/exceptions.R	2012-02-06 21:38:25 UTC (rev 3469)
@@ -1,4 +1,4 @@
-# Copyright (C) 2009 - 2011 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2009 - 2012 Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -52,17 +52,32 @@
 	invisible( .Call( rcpp_error_recorder, e ) )
 }
 
-# simplified version of utils::tryCatch
-rcpp_tryCatch <- function(expr, unused){  # unused is kept for compatibility, but is indeed not used
-	.Call(reset_current_error)
-	rcpp_doTryCatch <- function(expr, env) {
-	    .Internal(.addCondHands("error", list(.rcpp_error_recorder), 
-	    	env, environment(), FALSE))
-	    expr
-	}
-	parentenv <- parent.frame()
-    value <- rcpp_doTryCatch( return(expr), parentenv )
-	if (is.null(value[[1L]])) {
+# # simplified version of utils::tryCatch
+# rcpp_tryCatch <- function(expr, unused){  # unused is kept for compatibility, but is indeed not used
+# 	.Call(reset_current_error)
+# 	rcpp_doTryCatch <- function(expr, env) {
+# 	    .Internal(.addCondHands("error", list(.rcpp_error_recorder), 
+# 	    	env, environment(), FALSE))
+# 	    expr
+# 	}
+# 	parentenv <- parent.frame()
+#     value <- rcpp_doTryCatch( return(expr), parentenv )
+# 	if (is.null(value[[1L]])) {
+# 	    # a simple error; message is stored internally
+# 	    # and call is in result; this defers all allocs until
+# 	    # after the jump
+# 	    msg <- geterrmessage()
+# 	    call <- value[[2L]]
+# 	    cond <- simpleError(msg, call)
+# 	}
+# 	else cond <- value[[1L]]
+# 	.rcpp_error_recorder(cond)
+# }
+
+rcpp_tryCatch <- function(expr){
+    .Call(reset_current_error)
+    value <- withCallingHandlers( return(expr), error = .rcpp_error_recorder )
+    if (is.null(value[[1L]])) {
 	    # a simple error; message is stored internally
 	    # and call is in result; this defers all allocs until
 	    # after the jump
@@ -74,3 +89,5 @@
 	.rcpp_error_recorder(cond)
 }
 
+
+

Modified: pkg/Rcpp/src/Evaluator.cpp
===================================================================
--- pkg/Rcpp/src/Evaluator.cpp	2012-02-06 15:50:32 UTC (rev 3468)
+++ pkg/Rcpp/src/Evaluator.cpp	2012-02-06 21:38:25 UTC (rev 3469)
@@ -2,7 +2,7 @@
 //
 // Evaluator.cpp: Rcpp R/C++ interface class library -- evaluator
 //
-// Copyright (C) 2009 - 2011 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2009 - 2012 Dirk Eddelbuettel and Romain Francois
 //
 // This file is part of Rcpp.
 //
@@ -21,17 +21,27 @@
 
 #include <Rcpp/Evaluator.h>
 
+void maybe_init() ;
+
 namespace Rcpp {
 
     SEXP Evaluator::run(SEXP expr, SEXP env) {
+        
+        maybe_init() ;
+        reset_current_error() ; 
+        Environment RCPP = Environment::Rcpp_namespace(); 
+        
         SEXP call = PROTECT( 
                             Rf_lang2( 
-                                     internal::get_rcpptrycatch() , 
+                                     // internal::get_rcpptrycatch() ,
+                                     Rf_install( "rcpp_tryCatch" ), 
                                      Rf_lang3( internal::get_evalq() , expr, env )
+                                     // , 
+                                     // Rf_eval( Rf_install(".rcpp_error_recorder"),  RCPP )
                                       )
                              ) ;
-        Environment RCPP = Environment::Rcpp_namespace(); 
-        
+        // SET_TAG( CDR(CDR(call)), Rf_install("error") ) ;
+    
         /* call the tryCatch call */
         SEXP res = PROTECT( Rf_eval( call, RCPP ) );
         

Modified: pkg/Rcpp/src/cache.cpp
===================================================================
--- pkg/Rcpp/src/cache.cpp	2012-02-06 15:50:32 UTC (rev 3468)
+++ pkg/Rcpp/src/cache.cpp	2012-02-06 21:38:25 UTC (rev 3469)
@@ -65,6 +65,7 @@
 }
 
 SEXP reset_current_error(){
+    
     // error occured
     SET_VECTOR_ELT( Rcpp_cache, 1, Rf_ScalarLogical(FALSE) ) ;