Protect token while unwinding the stack

Because R code might run in C++ destructors

Author: lionel-

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

@@ -39,7 +39,15 @@ namespace internal {
 
     inline void Rcpp_maybe_throw(void* data, Rboolean jump) {
         if (jump) {
-            throw LongjumpException(static_cast<SEXP>(data));
+            SEXP token = static_cast<SEXP>(data);
+
+            // Keep the token protected while unwinding because R code might run
+            // in C++ destructors. Can't use PROTECT() for this because
+            // UNPROTECT() might be called in a destructor, for instance if a
+            // Shield<SEXP> is on the stack.
+            ::R_PreserveObject(token);
+
+            throw LongjumpException(token);
         }
     }
 

inst/include/Rcpp/exceptions.h

@@ -119,6 +119,7 @@ namespace Rcpp {
         };
 
         inline void resumeJump(SEXP token) {
+            ::R_ReleaseObject(token);
 #if (defined(RCPP_PROTECTED_EVAL) && defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0))
             ::R_ContinueUnwind(token);
 #endif

inst/unitTests/cpp/misc.cpp

@@ -249,12 +249,6 @@ SEXP testEvalUnwindImpl(RObject expr, Environment env, LogicalVector indicator)
     return Rcpp::Rcpp_fast_eval(expr, env);
 }
 
-// [[Rcpp::export]]
-SEXP testLongjumpException() {
-    throw Rcpp::internal::LongjumpException(R_NilValue);
-    return R_NilValue;
-}
-
 // [[Rcpp::export]]
 SEXP testSendInterrupt() {
   Rf_onintr();