From 81c8339884b3703b52dbd16489d8f7d56a9e511c Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Mon, 15 Jan 2018 14:41:44 -0600 Subject: [PATCH] shielding #789 behind a new #define to effectively disable it now --- ChangeLog | 39 ++++++++-------------- inst/NEWS.Rd | 6 ++-- inst/include/Rcpp/Environment.h | 24 +++++++++++--- inst/include/Rcpp/Language.h | 10 +++++- inst/include/Rcpp/api/meat/Rcpp_eval.h | 36 +++++++++++++------- inst/include/Rcpp/exceptions.h | 2 ++ inst/include/Rcpp/macros/macros.h | 46 +++++++++++++++++++++++++- inst/include/RcppCommon.h | 12 ++++++- inst/unitTests/cpp/stack.cpp | 4 +-- inst/unitTests/runit.stack.R | 8 ++++- 10 files changed, 137 insertions(+), 50 deletions(-) diff --git a/ChangeLog b/ChangeLog index dddf5dcaf..612f56781 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2018-01-15 Dirk Eddelbuettel + + * inst/include/RcppCommon.h: Check for new #define RCPP_USE_UNWIND_PROTECT + and unset if defined, this is being be used to "park" code from #789 + * inst/include/Rcpp/Environment.h: Ifdef #789 via RCPP_USE_UNWIND_PROTECT + * inst/include/Rcpp/Language.h: Idem + * inst/include/Rcpp/api/meat/Rcpp_eval.h: Idem + * inst/include/Rcpp/exceptions.h: Idem + * inst/include/Rcpp/macros/macros.h: Idem + + * inst/unitTests/runit.stack.R: Ensure test is not running + 2018-01-14 Dirk Eddelbuettel * DESCRIPTION (Version, Date): New minor version 0.12.14.8 @@ -50,32 +62,7 @@ * inst/include/Rcpp/api/meat/Rcpp_eval.h: Add Rcpp_fast_eval() for safe and fast evaluation of R code using the new protect-unwind API in R 3.5. - Unlike Rcpp_eval(), this does not evaluate R code within tryCatch() in - order to avoid the catching overhead. R longjumps are now correctly - intercepted and rethrown. Following this change the C++ stack is now - safely unwound when a longjump is detected while calling into R code. - This includes the following cases: caught condition of any class, long - return, restart jump, debugger exit. - - Rcpp_eval() also uses the protect-unwind API in order to gain safety. - To maintain compatibility it still catches errors and interrupts in - order to rethrow them as typed C++ exceptions. If you don't need to - catch those, consider using Rcpp_fast_eval() instead to avoid the - overhead. - - These improvements are only available for R 3.5.0 and greater. You also - need to explicitly define `RCPP_PROTECTED_EVAL` before including Rcpp.h. - When compiled with old versions of R, Rcpp_fast_eval() always falls back - to Rcpp_eval(). This is in contrast to internal::Rcpp_eval_impl() which - falls back to Rf_eval() and which is used in performance-sensititive - places. - - Note that with this change, Rcpp_eval() now behaves like the C function - Rf_eval() whereas it used to behave like the R function base::eval(). - This has subtle implications for control flow. For instance evaluating a - return() expression within a frame environment now returns from that - frame rather than from the Rcpp_eval() call. The old semantics were a - consequence of using evalq() internally and were not documented. + [ This is however disabled for release 0.12.15. ] * inst/include/Rcpp/exceptions.h: Add LongjumpException and resumeJump() to support Rcpp_fast_eval(). diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index 81265fb39..7323b6b7d 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -19,7 +19,8 @@ before including \code{Rcpp.h}). Longjumps of all kinds (condition catching, returns, restarts, debugger exit) are appropriately detected and handled, e.g. the C++ stack unwinds correctly - (Lionel in \ghpr{789}). + (Lionel in \ghpr{789}). [ Committed but subsequently disabled in release + 0.12.15 ] \item The new function \code{Rcpp_fast_eval()} can be used for performance-sensitive evaluation of R code. Unlike \code{Rcpp_eval()}, it does not try to catch errors with @@ -29,7 +30,8 @@ you are relying on error rethrowing, you have to use the slower \code{Rcpp_eval()}. On old R versions \code{Rcpp_fast_eval()} falls back to \code{Rcpp_eval()} so it is safe to use against any - versions of R (Lionel in \ghpr{789}). + versions of R (Lionel in \ghpr{789}). [ Committed but subsequently + disabled in release 0.12.15 ] \item Overly-clever checks for \code{NA} have been removed (Kevin in \ghpr{790}). \item The included tinyformat has been updated to the current version, diff --git a/inst/include/Rcpp/Environment.h b/inst/include/Rcpp/Environment.h index 9e3851eae..f37e5bb06 100644 --- a/inst/include/Rcpp/Environment.h +++ b/inst/include/Rcpp/Environment.h @@ -109,7 +109,11 @@ namespace Rcpp{ /* We need to evaluate if it is a promise */ if( TYPEOF(res) == PROMSXP){ - res = internal::Rcpp_eval_impl( res, env ) ; +#if defined(RCPP_USE_UNWIND_PROTECT) + res = internal::Rcpp_eval_impl(res, env); +#else + res = Rf_eval(res, env); +#endif } return res ; } @@ -129,7 +133,11 @@ namespace Rcpp{ /* We need to evaluate if it is a promise */ if( TYPEOF(res) == PROMSXP){ - res = internal::Rcpp_eval_impl( res, env ) ; +#if defined(RCPP_USE_UNWIND_PROTECT) + res = internal::Rcpp_eval_impl(res, env); +#else + res = Rf_eval(res, env); +#endif } return res ; } @@ -151,7 +159,11 @@ namespace Rcpp{ /* We need to evaluate if it is a promise */ if( TYPEOF(res) == PROMSXP){ - res = internal::Rcpp_eval_impl( res, env ) ; +#if defined(RCPP_USE_UNWIND_PROTECT) + res = internal::Rcpp_eval_impl(res, env); +#else + res = Rf_eval(res, env); +#endif } return res ; } @@ -174,7 +186,11 @@ namespace Rcpp{ /* We need to evaluate if it is a promise */ if( TYPEOF(res) == PROMSXP){ - res = internal::Rcpp_eval_impl( res, env ) ; +#if defined(RCPP_USE_UNWIND_PROTECT) + res = internal::Rcpp_eval_impl(res, env); +#else + res = Rf_eval(res, env); +#endif } return res ; } diff --git a/inst/include/Rcpp/Language.h b/inst/include/Rcpp/Language.h index 34be7eaa7..fddb4d326 100644 --- a/inst/include/Rcpp/Language.h +++ b/inst/include/Rcpp/Language.h @@ -145,10 +145,18 @@ namespace Rcpp{ } SEXP fast_eval() const { - return internal::Rcpp_eval_impl( Storage::get__(), R_GlobalEnv) ; +#if defined(RCPP_USE_UNWIND_PROTECT) + return internal::Rcpp_eval_impl( Storage::get__(), R_GlobalEnv); +#else + return Rf_eval(Storage::get__(), R_GlobalEnv); +#endif } SEXP fast_eval(SEXP env ) const { +#if defined(RCPP_USE_UNWIND_PROTECT) return internal::Rcpp_eval_impl( Storage::get__(), env) ; +#else + return Rf_eval(Storage::get__(), env); +#endif } void update( SEXP x){ diff --git a/inst/include/Rcpp/api/meat/Rcpp_eval.h b/inst/include/Rcpp/api/meat/Rcpp_eval.h index dc4392639..68c3ba9f5 100644 --- a/inst/include/Rcpp/api/meat/Rcpp_eval.h +++ b/inst/include/Rcpp/api/meat/Rcpp_eval.h @@ -21,11 +21,14 @@ #include #include -#if (defined(RCPP_PROTECTED_EVAL) && defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0)) -#define RCPP_USE_PROTECT_UNWIND +// outer definition from RcppCommon.h +#if defined(RCPP_USE_UNWIND_PROTECT) + #if (defined(RCPP_PROTECTED_EVAL) && defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0)) + // file-local and only used here + #define RCPP_USE_PROTECT_UNWIND + #endif #endif - namespace Rcpp { namespace internal { @@ -96,39 +99,48 @@ inline SEXP Rcpp_eval(SEXP expr, SEXP env) { // 'identity' function used to capture errors, interrupts SEXP identity = Rf_findFun(::Rf_install("identity"), R_BaseNamespace); - + if (identity == R_UnboundValue) { stop("Failed to find 'base::identity()'"); } // define the evalq call -- the actual R evaluation we want to execute Shield evalqCall(Rf_lang3(::Rf_install("evalq"), expr, env)); - + // define the call -- enclose with `tryCatch` so we can record and forward error messages Shield call(Rf_lang4(::Rf_install("tryCatch"), evalqCall, identity, identity)); SET_TAG(CDDR(call), ::Rf_install("error")); SET_TAG(CDDR(CDR(call)), ::Rf_install("interrupt")); +#if defined(RCPP_USE_UNWIND_PROTECT) + Shield res(::Rf_eval(call, R_GlobalEnv)) // execute the call +#else Shield res(internal::Rcpp_eval_impl(call, R_GlobalEnv)); +#endif // check for condition results (errors, interrupts) if (Rf_inherits(res, "condition")) { - + if (Rf_inherits(res, "error")) { - + Shield conditionMessageCall(::Rf_lang2(::Rf_install("conditionMessage"), res)); - - Shield conditionMessage(internal::Rcpp_eval_impl(conditionMessageCall, R_GlobalEnv)); + +#if defined(RCPP_USE_UNWIND_PROTECT) + Shield conditionMessage(internal::Rcpp_eval_impl(conditionMessageCall, + R_GlobalEnv)); +#else + Shield conditionMessage(::Rf_eval(conditionMessageCall, R_GlobalEnv)); +#endif throw eval_error(CHAR(STRING_ELT(conditionMessage, 0))); } - + // check for interrupt if (Rf_inherits(res, "interrupt")) { throw internal::InterruptedException(); } - + } - + return res; } diff --git a/inst/include/Rcpp/exceptions.h b/inst/include/Rcpp/exceptions.h index a01297f9a..ba623f4bb 100644 --- a/inst/include/Rcpp/exceptions.h +++ b/inst/include/Rcpp/exceptions.h @@ -111,6 +111,7 @@ namespace Rcpp { throw Rcpp::exception(message.c_str()); } // #nocov end +#if defined(RCPP_USE_UNWIND_PROTECT) namespace internal { struct LongjumpException { @@ -126,6 +127,7 @@ namespace Rcpp { } } // namespace internal +#endif } // namespace Rcpp diff --git a/inst/include/Rcpp/macros/macros.h b/inst/include/Rcpp/macros/macros.h index 44a4d9d6f..3b07052fc 100644 --- a/inst/include/Rcpp/macros/macros.h +++ b/inst/include/Rcpp/macros/macros.h @@ -36,7 +36,8 @@ #endif #ifndef VOID_END_RCPP -#define VOID_END_RCPP \ +// longer form with Rcpp::internal::LongjumpException first, alternate below #else +#if defined(RCPP_USE_UNWIND_PROTECT) } \ catch( Rcpp::internal::InterruptedException &__ex__) { \ rcpp_output_type = 1 ; \ @@ -66,6 +67,33 @@ SEXP expr = PROTECT( Rf_lang2( stop_sym , rcpp_output_condition ) ) ; \ Rf_eval( expr, R_GlobalEnv ) ; \ } +#else +#define VOID_END_RCPP \ + } \ + catch( Rcpp::internal::InterruptedException &__ex__) { \ + rcpp_output_type = 1 ; \ + } \ + catch(Rcpp::exception& __ex__) { \ + rcpp_output_type = 2 ; \ + rcpp_output_condition = PROTECT(rcpp_exception_to_r_condition(__ex__)) ; \ + } \ + catch( std::exception& __ex__ ){ \ + rcpp_output_type = 2 ; \ + rcpp_output_condition = PROTECT(exception_to_r_condition(__ex__)) ; \ + } \ + catch( ... ){ \ + rcpp_output_type = 2 ; \ + rcpp_output_condition = PROTECT(string_to_try_error("c++ exception (unknown reason)")) ; \ + } \ + if( rcpp_output_type == 1 ){ \ + Rf_onintr() ; \ + } \ + if( rcpp_output_type == 2 ){ \ + SEXP stop_sym = Rf_install( "stop" ) ; \ + SEXP expr = PROTECT( Rf_lang2( stop_sym , rcpp_output_condition ) ) ; \ + Rf_eval( expr, R_GlobalEnv ) ; \ + } +#endif #endif #ifndef END_RCPP @@ -73,6 +101,8 @@ #endif #ifndef END_RCPP_RETURN_ERROR +// longer form with Rcpp::internal::LongjumpException first, alternate below #else +#if defined(RCPP_USE_UNWIND_PROTECT) #define END_RCPP_RETURN_ERROR \ } \ catch (Rcpp::internal::InterruptedException &__ex__) { \ @@ -89,6 +119,20 @@ return string_to_try_error("c++ exception (unknown reason)"); \ } \ return R_NilValue; +#else +#define END_RCPP_RETURN_ERROR \ + } \ + catch (Rcpp::internal::InterruptedException &__ex__) { \ + return Rcpp::internal::interruptedError(); \ + } \ + catch (std::exception &__ex__) { \ + return exception_to_try_error(__ex__); \ + } \ + catch (...) { \ + return string_to_try_error("c++ exception (unknown reason)"); \ + } \ + return R_NilValue; +#endif #endif #define Rcpp_error(MESSAGE) throw Rcpp::exception(MESSAGE, __FILE__, __LINE__) diff --git a/inst/include/RcppCommon.h b/inst/include/RcppCommon.h index fac9fbf36..48fd55c74 100644 --- a/inst/include/RcppCommon.h +++ b/inst/include/RcppCommon.h @@ -26,6 +26,15 @@ // #define RCPP_DEBUG_LEVEL 1 // #define RCPP_DEBUG_MODULE_LEVEL 1 +// PR #798 by Lionel seems to have created some side-effects possibly related to +// UnwinProtect is currently implement in R-devel. This #define needs to be set to +// enable it, in most cases you want to be disabled. +// #define RCPP_USE_UNWIND_PROTECT 1 +// so here _explicitly_ disable it for now +#ifdef RCPP_USE_UNWIND_PROTECT + #undef RCPP_USE_UNWIND_PROTECT +#endif + #include /** @@ -74,9 +83,10 @@ namespace Rcpp { namespace Rcpp { - SEXP Rcpp_fast_eval(SEXP expr_, SEXP env = R_GlobalEnv); SEXP Rcpp_eval(SEXP expr_, SEXP env = R_GlobalEnv); + // from PR#789 + SEXP Rcpp_fast_eval(SEXP expr_, SEXP env = R_GlobalEnv); namespace internal { SEXP Rcpp_eval_impl(SEXP expr, SEXP env = R_GlobalEnv); } diff --git a/inst/unitTests/cpp/stack.cpp b/inst/unitTests/cpp/stack.cpp index 2e707c293..016cd4065 100644 --- a/inst/unitTests/cpp/stack.cpp +++ b/inst/unitTests/cpp/stack.cpp @@ -48,6 +48,6 @@ SEXP testFastEval(RObject expr, Environment env, LogicalVector indicator) { // [[Rcpp::export]] SEXP testSendInterrupt() { - Rf_onintr(); - return R_NilValue; + Rf_onintr(); + return R_NilValue; } diff --git a/inst/unitTests/runit.stack.R b/inst/unitTests/runit.stack.R index 18361a821..3e72689b7 100644 --- a/inst/unitTests/runit.stack.R +++ b/inst/unitTests/runit.stack.R @@ -18,9 +18,15 @@ # along with Rcpp. If not, see . .runThisTest <- Sys.getenv("RunAllRcppTests") == "yes" +.onLinux <- .Platform$OS.type == "unix" && unname(Sys.info()["sysname"]) == "Linux" +## As of release 0.12.15, the stack unwinding is experimental and not used +## See the #define in RcppCommon.h to change it -if (FALSE && .runThisTest) { +.runThisTest <- FALSE + + +if (.runThisTest) { .setUp <- Rcpp:::unitTestSetup("stack.cpp")