merge from master

Merge remote-tracking branch 'origin/master' into feature/rcppexports-types

Conflicts:
	ChangeLog

Author: jjallaire

ChangeLog

@@ -5,6 +5,12 @@
         * src/attributes.cpp: Include pkg_types.h file in generated
         C++ interface file if it's present in inst/include or src
 
+2015-02-02  JJ Allaire  <jj@rstudio.org>
+
+        * R/exceptions.R: Evaluate R code within an R_toplevelExec block
+        * include/Rcpp/api/meat/Rcpp_eval.h: Evaluate R code within an
+        R_toplevelExec block
+
 2015-01-25  Kevin Ushey  <kevinushey@gmail.com>
 
         * inst/include/Rcpp/utils/tinyformat.h: define an error handler for

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: Rcpp
 Title: Seamless R and C++ Integration
-Version: 0.11.4
-Date: 2015-01-20
+Version: 0.11.4.1
+Date: 2015-02-03
 Author: Dirk Eddelbuettel, Romain Francois, JJ Allaire, Kevin Ushey, 
  Douglas Bates, and John Chambers
 Maintainer: Dirk Eddelbuettel <edd@debian.org>

R/exceptions.R

@@ -19,3 +19,18 @@
     invisible( .Call( rcpp_error_recorder, e ) )
 }
 
+.warningsEnv <- new.env()
+.warningsEnv$warnings <- character()
+
+.rcpp_warning_recorder <- function(w){
+    .warningsEnv$warnings <- append(.warningsEnv$warnings, w$message)
+    invokeRestart("muffleWarning")
+}
+
+.rcpp_collect_warnings <- function() {
+    warnings <- .warningsEnv$warnings
+    .warningsEnv$warnings <- character()
+    warnings
+}
+
+

inst/NEWS.Rd

@@ -8,6 +8,8 @@
     \itemize{
       \item Defining an error handler for tinyformat prevents \code{assert()}
       from spilling.
+      \item Evaluate R code within an \code{R_toplevelExec} block to prevent
+      user interrupts from bypassing C++ destructors on the stack.
     }
     \item Changes in Rcpp Attributes:
     \itemize{

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

@@ -18,38 +18,97 @@
 #ifndef Rcpp_api_meat_Rcpp_eval_h
 #define Rcpp_api_meat_Rcpp_eval_h
 
+#include <Rcpp/Interrupt.h>
+
 namespace Rcpp{
 
-    inline SEXP Rcpp_eval(SEXP expr_, SEXP env) {
-        Shield<SEXP> expr( expr_) ;
+    struct EvalCall {
+        SEXP expr;
+        SEXP env;
+        SEXP result;
+        std::vector<std::string> warnings;
+        std::string error_message;
+    };
+
+    inline void Rcpp_eval(void* data) {
+
+        EvalCall* evalCall = (EvalCall*)data;
+        SEXP env = evalCall->env;
+
+        Shield<SEXP> expr(evalCall->expr) ;
 
         reset_current_error() ;
 
         Environment RCPP = Environment::Rcpp_namespace();
+        SEXP withCallingHandlersSym    = ::Rf_install("withCallingHandlers");
         SEXP tryCatchSym               = ::Rf_install("tryCatch");
         SEXP evalqSym                  = ::Rf_install("evalq");
         SEXP conditionMessageSym       = ::Rf_install("conditionMessage");
         SEXP errorRecorderSym          = ::Rf_install(".rcpp_error_recorder");
+        SEXP warningRecorderSym        = ::Rf_install(".rcpp_warning_recorder");
+        SEXP collectWarningsSym        = ::Rf_install(".rcpp_collect_warnings");
         SEXP errorSym                  = ::Rf_install("error");
+        SEXP warningSym                = ::Rf_install("warning");
 
-        Shield<SEXP> call( Rf_lang3(
+        // define the tryCatchCall
+        Shield<SEXP> tryCatchCall( Rf_lang3(
             tryCatchSym,
             Rf_lang3( evalqSym, expr, env ),
             errorRecorderSym
         ) ) ;
-        SET_TAG( CDDR(call), errorSym ) ;
-        /* call the tryCatch call */
+        SET_TAG( CDDR(tryCatchCall), errorSym ) ;
+
+        // encose it in withCallingHandlers
+        Shield<SEXP> call( Rf_lang3(
+            withCallingHandlersSym,
+            tryCatchCall,
+            warningRecorderSym
+        ) ) ;
+        SET_TAG( CDDR(call), warningSym ) ;
+
+        // execute the call
         Shield<SEXP> res(::Rf_eval( call, RCPP ) );
 
+        // collect warnings
+        Shield<SEXP> warningCall(Rf_lang1(collectWarningsSym));
+        Shield<SEXP> warnings(::Rf_eval(warningCall, RCPP));
+        
+        evalCall->warnings = Rcpp::as<std::vector<std::string> >(warnings);
+
+        // check for error
         if( error_occured() ) {
             Shield<SEXP> current_error        ( rcpp_get_current_error() ) ;
             Shield<SEXP> conditionMessageCall (::Rf_lang2(conditionMessageSym, current_error)) ;
             Shield<SEXP> condition_message    (::Rf_eval(conditionMessageCall, R_GlobalEnv)) ;
-            std::string message(CHAR(::Rf_asChar(condition_message)));
-            throw eval_error(message) ;
+            evalCall->error_message = std::string(CHAR(::Rf_asChar(condition_message)));
+        } else {
+            evalCall->result = res;
         }
+    }
+
+    inline SEXP Rcpp_eval(SEXP expr_, SEXP env) {
 
-        return res ;
+        // create the call object
+        EvalCall call;
+        call.expr = expr_;
+        call.env = env;
+
+        // execute it
+        Rboolean completed = R_ToplevelExec(Rcpp_eval, (void*)&call);
+
+        // print warnings
+        for (size_t i = 0; i<call.warnings.size(); i++)
+            Rf_warning(call.warnings[i].c_str());
+
+        // handle error or result if it completed, else throw interrupt
+        if (completed) {
+            if (!call.error_message.empty())
+                throw eval_error(call.error_message);
+            else
+                return call.result;
+        } else {
+            throw internal::InterruptedException();
+        }
     }
 
 }