handle warnings in Rcpp_eval

Author: jjallaire

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/include/Rcpp/api/meat/Rcpp_eval.h

@@ -23,38 +23,57 @@
 namespace Rcpp{
 
     struct EvalCall {
-        SEXP expr_;
+        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 expr_ = evalCall->expr_;
         SEXP env = evalCall->env;
 
-        Shield<SEXP> expr( expr_) ;
+        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> warnings(::Rf_eval(Rf_lang1(collectWarningsSym), 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)) ;
@@ -66,10 +85,21 @@ namespace Rcpp{
     }
 
     inline SEXP Rcpp_eval(SEXP expr_, SEXP env) {
+
+        // create the call object
         EvalCall call;
-        call.expr_ = expr_;
+        call.expr = expr_;
         call.env = env;
-        if (R_ToplevelExec(Rcpp_eval, (void*)&call)) {
+
+        // 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