shielding #789 behind a new #define to effectively disable it now

eddelbuettel · eddelbuettel · commit 81c8339884b3 · 2018-01-15T14:41:44.000-06:00
diff --git a/ChangeLog b/ChangeLog
@@ -1,3 +1,15 @@
+2018-01-15  Dirk Eddelbuettel  <edd@debian.org>
+
+        * 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  <edd@debian.org>
 
         * 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
@@ -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
@@ -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
@@ -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
@@ -21,11 +21,14 @@
 #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
+// 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<SEXP> evalqCall(Rf_lang3(::Rf_install("evalq"), expr, env));
-    
+
     // define the call -- enclose with `tryCatch` so we can record and forward error messages
     Shield<SEXP> 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<SEXP> res(::Rf_eval(call, R_GlobalEnv))			// execute the call
+#else
     Shield<SEXP> 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<SEXP> conditionMessageCall(::Rf_lang2(::Rf_install("conditionMessage"), res));
-            
-            Shield<SEXP> conditionMessage(internal::Rcpp_eval_impl(conditionMessageCall, R_GlobalEnv));
+
+#if defined(RCPP_USE_UNWIND_PROTECT)
+            Shield<SEXP> conditionMessage(internal::Rcpp_eval_impl(conditionMessageCall,
+                                                                   R_GlobalEnv));
+#else
+            Shield<SEXP> 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
@@ -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
@@ -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,13 +67,42 @@
        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
 #define END_RCPP VOID_END_RCPP return R_NilValue;
 #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
@@ -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 <Rcpp/r/headers.h>
 
 /**
@@ -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
@@ -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
@@ -18,9 +18,15 @@
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 .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")
 

Original file line number	Diff line number	Diff line change
`@@ -145,10 +145,18 @@ namespace Rcpp{`
`145`	`145`	`}`
`146`	`146`
`147`	`147`	`SEXP fast_eval() const {`
`148`		`- return internal::Rcpp_eval_impl( Storage::get__(), R_GlobalEnv) ;`
	`148`	`+#if defined(RCPP_USE_UNWIND_PROTECT)`
	`149`	`+ return internal::Rcpp_eval_impl( Storage::get__(), R_GlobalEnv);`
	`150`	`+#else`
	`151`	`+ return Rf_eval(Storage::get__(), R_GlobalEnv);`
	`152`	`+#endif`
`149`	`153`	`}`
`150`	`154`	`SEXP fast_eval(SEXP env ) const {`
	`155`	`+#if defined(RCPP_USE_UNWIND_PROTECT)`
`151`	`156`	`return internal::Rcpp_eval_impl( Storage::get__(), env) ;`
	`157`	`+#else`
	`158`	`+ return Rf_eval(Storage::get__(), env);`
	`159`	`+#endif`
`152`	`160`	`}`
`153`	`161`
`154`	`162`	`void update( SEXP x){`
Original file line number	Diff line number	Diff line change
`@@ -48,6 +48,6 @@ SEXP testFastEval(RObject expr, Environment env, LogicalVector indicator) {`
`48`	`48`
`49`	`49`	`// [[Rcpp::export]]`
`50`	`50`	`SEXP testSendInterrupt() {`
`51`		`- Rf_onintr();`
`52`		`- return R_NilValue;`
	`51`	`+ Rf_onintr();`
	`52`	`+ return R_NilValue;`
`53`	`53`	`}`