Improvements for unwind-protect (#877)

* Safer unwound indicator in unit tests

* Pass extra arguments from unitTestSetup() to sourceCpp()

For easier debugging

* Add `unwindProtect` plugin

* Rename `RCPP_PROTECTED_EVAL` to `RCPP_USE_UNWIND_PROTECT`

Because the new API is now more general than just evaluation of R code

* Move unwind.h from Rcpp/api/meat/ to Rcpp/unwindProtect.h

* Make LongjumpException public

* Remove default argument for Rcpp_fast_eval()

Author: lionel-

ChangeLog

@@ -1,3 +1,38 @@
+
+2018-07-10  Lionel Henry  <[email protected]>
+
+        * inst/include/Rcpp/exceptions.h: Move LongjumpException from the
+        Rcpp::internal namespace to the public Rcpp namespace. If you have a
+        catch-all statement like `catch (...)`, be sure to catch and rethrow
+        Rcpp::LongjumpException to prevent the R longjump from being ignored.
+        * inst/include/Rcpp/macros/macros.h (VOID_END_RCPP): idem
+        * src/attributes.cpp: idem
+
+2018-07-05  Lionel Henry  <[email protected]>
+
+        * inst/include/Rcpp/api/meat/Rcpp_eval.h: Rename `RCPP_PROTECTED_EVAL`
+        to `RCPP_USE_UNWIND_PROTECT` because the new API is now more general
+        than just evaluation of R code.
+        * inst/NEWS.Rd: idem
+        * inst/unitTests/runit.interface.R: idem
+
+2018-07-05  Lionel Henry  <[email protected]>
+
+        * R/unit.tests.R (unitTestSetup): Pass extra arguments to sourceCpp()
+        for easier debugging.
+
+2018-07-05  Lionel Henry  <[email protected]>
+
+        * R/Attributes.R (.plugins[["unwindProtect"]]): You can now add
+        `[[Rcpp::plugins(unwindProtect)]]` in one of your source file to enable
+        the new unwind-protect mechanism easily. It appends
+        `-DRCPP_USE_UNWIND_PROTECT` to `PKG_CPPFLAGS`.
+
+        This is safer than using a `#define` because it ensures unwind-protect
+        is enabled in all compilation units, including RcppExports.cpp.
+
+        * inst/unitTests/cpp/stack.cpp: Use new plugin to enable unwind-protect.
+
 2018-06-22  Kevin Ushey  <[email protected]>
 
         * inst/include/Rcpp/api/meat/Rcpp_eval.h: Ensure R_BaseEnv is used

R/Attributes.R

@@ -523,6 +523,10 @@ compileAttributes <- function(pkgdir = ".", verbose = getOption("verbose")) {
                     PKG_LIBS="-fopenmp"))
 }
 
+.plugins[["unwindProtect"]] <- function() {
+    list(env = list(PKG_CPPFLAGS = "-DRCPP_USE_UNWIND_PROTECT"))
+}
+
 # register a plugin
 registerPlugin <- function(name, plugin) {
     .plugins[[name]] <- plugin                                  # #nocov

R/unit.tests.R

@@ -88,14 +88,15 @@ test <- function(output=if(file.exists("/tmp")) "/tmp" else getwd(),
 }
 
 unitTestSetup <- function(file, packages=NULL,
-                          pathToRcppTests=system.file("unitTests", package = "Rcpp")) {
+                          pathToRcppTests=system.file("unitTests", package = "Rcpp"),
+                          ...) {
     function() {
         if (! is.null(packages)) {
             for (p in packages) {
                 suppressMessages(require(p, character.only=TRUE))
             }
         }
-        sourceCpp(file.path(pathToRcppTests, "cpp", file))
+        sourceCpp(file.path(pathToRcppTests, "cpp", file), ...)
     }
 }
 

inst/NEWS.Rd

@@ -28,7 +28,7 @@
       finely (Romain in \ghpr{868}).
       \item The new \code{Rcpp_fast_eval} is used instead of
       \code{Rcpp_eval} though this still requires setting
-      \code{RCPP_PROTECTED_EVAL} before including \code{Rcpp.h} (Qiang
+      \code{RCPP_USE_UNWIND_PROTECT} before including \code{Rcpp.h} (Qiang
       Kou in \ghpr{867} closing \ghit{866}).
       \item The \code{Rcpp::unwindProtect()} function extracts the
       unwinding from the \code{Rcpp_fast_eval()} function and makes it
@@ -110,7 +110,7 @@
       (Kevin in \ghpr{784}).
       \item Use public R APIs for \code{new_env} (Kevin in \ghpr{785}).
       \item Evaluation of R code is now safer when compiled against R
-      3.5 (you also need to explicitly define \code{RCPP_PROTECTED_EVAL}
+      3.5 (you also need to explicitly define \code{RCPP_USE_UNWIND_PROTECT}
       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

inst/include/Rcpp/DataFrame.h

@@ -132,7 +132,7 @@ namespace Rcpp{
             obj.attr( "names") = names ;
             Shield<SEXP> call( Rf_lang3(as_df_symb, obj, wrap( strings_as_factors ) ) ) ;
             SET_TAG( CDDR(call),  strings_as_factors_symb ) ;
-            Shield<SEXP> res( Rcpp_fast_eval( call ) ) ;
+            Shield<SEXP> res(Rcpp_fast_eval(call, R_GlobalEnv));
             DataFrame_Impl out( res ) ;
             return out ;
 

inst/include/Rcpp/Environment.h

@@ -33,7 +33,7 @@ namespace Rcpp{
             if( Rf_isEnvironment(x) ) return x ;
             SEXP asEnvironmentSym = Rf_install("as.environment");
             try {
-                Shield<SEXP> res( Rcpp_fast_eval( Rf_lang2( asEnvironmentSym, x ) ) );
+                Shield<SEXP> res(Rcpp_fast_eval(Rf_lang2(asEnvironmentSym, x), R_GlobalEnv));
                 return res ;
             } catch( const eval_error& ex) {
                 const char* fmt = "Cannot convert object to an environment: "
@@ -374,7 +374,7 @@ namespace Rcpp{
             try{
                 SEXP getNamespaceSym = Rf_install("getNamespace");
                 Shield<SEXP> package_str( Rf_mkString(package.c_str()) );
-                env = Rcpp_fast_eval( Rf_lang2(getNamespaceSym, package_str) ) ;
+                env = Rcpp_fast_eval(Rf_lang2(getNamespaceSym, package_str), R_GlobalEnv);
             } catch( ... ){
                 throw no_such_namespace( package  ) ;
             }
@@ -393,7 +393,7 @@ namespace Rcpp{
          */
         Environment_Impl new_child(bool hashed) const {
             SEXP newEnvSym = Rf_install("new.env");
-            return Environment_Impl( Rcpp_fast_eval(Rf_lang3( newEnvSym, Rf_ScalarLogical(hashed), Storage::get__() )) );
+            return Environment_Impl(Rcpp_fast_eval(Rf_lang3(newEnvSym, Rf_ScalarLogical(hashed), Storage::get__()), R_GlobalEnv));
         }
 
 

inst/include/Rcpp/Function.h

@@ -79,7 +79,7 @@ namespace Rcpp{
 
         SEXP operator()() const {
             Shield<SEXP> call(Rf_lang1(Storage::get__()));
-            return Rcpp_fast_eval(call);
+            return Rcpp_fast_eval(call, R_GlobalEnv);
         }
 
         #include <Rcpp/generated/Function__operator.h>

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

@@ -21,15 +21,10 @@
 #include <Rcpp/Interrupt.h>
 #include <Rversion.h>
 
-#if (defined(RCPP_PROTECTED_EVAL) && defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0))
-#define RCPP_USE_PROTECT_UNWIND
-#include <Rcpp/api/meat/unwind.h>
-#endif
-
 
 namespace Rcpp { namespace internal {
 
-#ifdef RCPP_USE_PROTECT_UNWIND
+#ifdef RCPP_USING_UNWIND_PROTECT
 
 struct EvalData {
     SEXP expr;
@@ -61,7 +56,7 @@ inline SEXP Rcpp_eval_impl(SEXP expr, SEXP env) {
 
 namespace Rcpp {
 
-#ifdef RCPP_USE_PROTECT_UNWIND
+#ifdef RCPP_USING_UNWIND_PROTECT
 
 inline SEXP Rcpp_fast_eval(SEXP expr, SEXP env) {
     internal::EvalData data(expr, env);

inst/include/Rcpp/exceptions.h

@@ -114,51 +114,57 @@ namespace Rcpp {
         throw Rcpp::exception(message.c_str());
     }                                                        // #nocov end
 
-    namespace internal {
+} // namespace Rcpp
 
-        inline SEXP longjumpSentinel(SEXP token) {
-            SEXP sentinel = PROTECT(Rf_allocVector(VECSXP, 1));
-            SET_VECTOR_ELT(sentinel, 0, token);
 
-            SEXP sentinelClass = PROTECT(Rf_mkString("Rcpp:longjumpSentinel"));
-            Rf_setAttrib(sentinel, R_ClassSymbol, sentinelClass) ;
+namespace Rcpp { namespace internal {
 
-            UNPROTECT(2);
-            return sentinel;
-        }
+inline SEXP longjumpSentinel(SEXP token) {
+    SEXP sentinel = PROTECT(Rf_allocVector(VECSXP, 1));
+    SET_VECTOR_ELT(sentinel, 0, token);
 
-        inline bool isLongjumpSentinel(SEXP x) {
-            return
-                Rf_inherits(x, "Rcpp:longjumpSentinel") &&
-                TYPEOF(x) == VECSXP &&
-                Rf_length(x) == 1;
-        }
+    SEXP sentinelClass = PROTECT(Rf_mkString("Rcpp:longjumpSentinel"));
+    Rf_setAttrib(sentinel, R_ClassSymbol, sentinelClass) ;
 
-        inline SEXP getLongjumpToken(SEXP sentinel) {
-            return VECTOR_ELT(sentinel, 0);
-        }
+    UNPROTECT(2);
+    return sentinel;
+}
+
+inline bool isLongjumpSentinel(SEXP x) {
+    return
+        Rf_inherits(x, "Rcpp:longjumpSentinel") &&
+        TYPEOF(x) == VECSXP &&
+        Rf_length(x) == 1;
+}
+
+inline SEXP getLongjumpToken(SEXP sentinel) {
+    return VECTOR_ELT(sentinel, 0);
+}
 
-        struct LongjumpException {
-            SEXP token;
-            LongjumpException(SEXP token_) : token(token_) {
-                if (isLongjumpSentinel(token)) {
-                    token = getLongjumpToken(token);
-                }
-            }
-        };
-
-        inline void resumeJump(SEXP token) {
-            if (isLongjumpSentinel(token)) {
-                token = getLongjumpToken(token);
-            }
-            ::R_ReleaseObject(token);
+inline void resumeJump(SEXP token) {
+    if (isLongjumpSentinel(token)) {
+        token = getLongjumpToken(token);
+    }
+    ::R_ReleaseObject(token);
 #if (defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0))
-            ::R_ContinueUnwind(token);
+    ::R_ContinueUnwind(token);
 #endif
-            Rf_error("Internal error: Rcpp longjump failed to resume");
-        }
+    Rf_error("Internal error: Rcpp longjump failed to resume");
+}
+
+}} // namespace Rcpp::internal
+
 
-    } // namespace internal
+namespace Rcpp {
+
+struct LongjumpException {
+    SEXP token;
+    LongjumpException(SEXP token_) : token(token_) {
+        if (internal::isLongjumpSentinel(token)) {
+            token = internal::getLongjumpToken(token);
+        }
+    }
+};
 
 } // namespace Rcpp