@@ -28,7 +28,7 @@ namespace Rcpp{
28
28
29
29
class exception : public std ::exception {
30
30
public:
31
- explicit exception (const char * message_) : message(message_){}
31
+ explicit exception (const char * message_) : message(message_){ rcpp_set_stack_trace ( stack_trace ()); }
32
32
exception (const char * message_, const char * file, int line ) : message(message_){
33
33
rcpp_set_stack_trace ( stack_trace (file,line) ) ;
34
34
}
@@ -124,20 +124,58 @@ namespace Rcpp{
124
124
#undef RCPP_SIMPLE_EXCEPTION_CLASS
125
125
126
126
127
+ namespace internal {
128
+
129
+ inline SEXP nth (SEXP s, int n) {
130
+ return Rf_length (s) > n ? (n == 0 ? CAR (s) : CAR (Rf_nthcdr (s, n))) : R_NilValue;
131
+ }
132
+
133
+ // We want the call just prior to the call from Rcpp_eval
134
+ // This conditional matches
135
+ // tryCatch(evalq(sys.calls(), .GlobalEnv), error = identity, interrupt = identity)
136
+ inline bool is_Rcpp_eval_call (SEXP expr) {
137
+ SEXP sys_calls_symbol = Rf_install (" sys.calls" );
138
+ SEXP identity_symbol = Rf_install (" identity" );
139
+ SEXP identity_fun = Rf_findFun (identity_symbol, R_BaseEnv);
140
+ SEXP tryCatch_symbol = Rf_install (" tryCatch" );
141
+ SEXP evalq_symbol = Rf_install (" evalq" );
142
+
143
+ return TYPEOF (expr) == LANGSXP &&
144
+ Rf_length (expr) == 4 &&
145
+ nth (expr, 0 ) == tryCatch_symbol &&
146
+ CAR (nth (expr, 1 )) == evalq_symbol &&
147
+ CAR (nth (nth (expr, 1 ), 1 )) == sys_calls_symbol &&
148
+ nth (nth (expr, 1 ), 2 ) == R_GlobalEnv &&
149
+ nth (expr, 2 ) == identity_fun &&
150
+ nth (expr, 3 ) == identity_fun;
151
+ }
152
+ }
153
+
127
154
} // namespace Rcpp
128
155
129
156
inline SEXP get_last_call (){
130
- SEXP sys_calls_symbol = Rf_install ( " sys.calls" ) ;
131
- Rcpp::Shield<SEXP> sys_calls_expr ( Rf_lang1 (sys_calls_symbol) );
132
- Rcpp::Shield<SEXP> calls ( Rcpp_eval ( sys_calls_expr, R_GlobalEnv ) );
133
- SEXP res = calls ;
134
- while ( !Rf_isNull (CDR (res)) ) res = CDR (res);
135
- return CAR (res) ;
157
+ SEXP sys_calls_symbol = Rf_install (" sys.calls" );
158
+
159
+ Rcpp::Shield<SEXP> sys_calls_expr (Rf_lang1 (sys_calls_symbol));
160
+ Rcpp::Shield<SEXP> calls (Rcpp_eval (sys_calls_expr, R_GlobalEnv));
161
+
162
+ SEXP cur, prev;
163
+ prev = cur = calls;
164
+ while (CDR (cur) != R_NilValue) {
165
+ SEXP expr = CAR (cur);
166
+
167
+ if (Rcpp::internal::is_Rcpp_eval_call (expr)) {
168
+ break ;
169
+ }
170
+ prev = cur;
171
+ cur = CDR (cur);
172
+ }
173
+ return CAR (prev);
136
174
}
137
175
138
176
inline SEXP get_exception_classes ( const std::string& ex_class) {
139
177
Rcpp::Shield<SEXP> res ( Rf_allocVector ( STRSXP, 4 ) );
140
-
178
+
141
179
#ifndef RCPP_USING_UTF8_ERROR_STRING
142
180
SET_STRING_ELT ( res, 0 , Rf_mkChar ( ex_class.c_str () ) ) ;
143
181
#else
@@ -184,7 +222,7 @@ inline SEXP exception_to_r_condition( const std::exception& ex){
184
222
185
223
inline SEXP string_to_try_error ( const std::string& str){
186
224
using namespace Rcpp ;
187
-
225
+
188
226
#ifndef RCPP_USING_UTF8_ERROR_STRING
189
227
Rcpp::Shield<SEXP> simpleErrorExpr ( Rf_lang2 (::Rf_install (" simpleError" ), Rf_mkString (str.c_str ())) );
190
228
Rcpp::Shield<SEXP> tryError ( Rf_mkString ( str.c_str () ) );
@@ -193,7 +231,7 @@ inline SEXP string_to_try_error( const std::string& str){
193
231
SET_STRING_ELT ( tryError, 0 , Rf_mkCharLenCE ( str.c_str (), str.size (), CE_UTF8 ) );
194
232
Rcpp::Shield<SEXP> simpleErrorExpr ( Rf_lang2 (::Rf_install (" simpleError" ), tryError ));
195
233
#endif
196
-
234
+
197
235
Rcpp::Shield<SEXP> simpleError ( Rf_eval (simpleErrorExpr, R_GlobalEnv) );
198
236
Rf_setAttrib ( tryError, R_ClassSymbol, Rf_mkString (" try-error" ) ) ;
199
237
Rf_setAttrib ( tryError, Rf_install ( " condition" ) , simpleError ) ;
@@ -267,52 +305,52 @@ namespace Rcpp{
267
305
inline void NORET stop (const std::string& message) {
268
306
throw Rcpp::exception (message.c_str ());
269
307
}
270
-
308
+
271
309
template <typename T1>
272
310
inline void NORET stop (const char * fmt, const T1& arg1) {
273
311
throw Rcpp::exception ( tfm::format (fmt, arg1 ).c_str () );
274
312
}
275
-
313
+
276
314
template <typename T1, typename T2>
277
315
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2) {
278
316
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2 ).c_str () );
279
317
}
280
-
318
+
281
319
template <typename T1, typename T2, typename T3>
282
320
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2, const T3& arg3) {
283
321
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2, arg3).c_str () );
284
322
}
285
-
323
+
286
324
template <typename T1, typename T2, typename T3, typename T4>
287
325
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4) {
288
326
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2, arg3, arg4).c_str () );
289
327
}
290
-
328
+
291
329
template <typename T1, typename T2, typename T3, typename T4, typename T5>
292
330
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5) {
293
331
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2, arg3, arg4, arg5).c_str () );
294
332
}
295
-
333
+
296
334
template <typename T1, typename T2, typename T3, typename T4, typename T5, typename T6>
297
335
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6) {
298
336
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2, arg3, arg4, arg5, arg6).c_str () );
299
337
}
300
-
338
+
301
339
template <typename T1, typename T2, typename T3, typename T4, typename T5, typename T6, typename T7>
302
340
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6, const T7& arg7) {
303
341
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7).c_str () );
304
342
}
305
-
343
+
306
344
template <typename T1, typename T2, typename T3, typename T4, typename T5, typename T6, typename T7, typename T8>
307
345
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6, const T7& arg7, const T8& arg8) {
308
346
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8).c_str () );
309
347
}
310
-
348
+
311
349
template <typename T1, typename T2, typename T3, typename T4, typename T5, typename T6, typename T7, typename T8, typename T9>
312
350
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6, const T7& arg7, const T8& arg8, const T9& arg9) {
313
351
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9).c_str () );
314
352
}
315
-
353
+
316
354
template <typename T1, typename T2, typename T3, typename T4, typename T5, typename T6, typename T7, typename T8, typename T9, typename T10>
317
355
inline void NORET stop (const char * fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6, const T7& arg7, const T8& arg8, const T9& arg9, const T10& arg10) {
318
356
throw Rcpp::exception ( tfm::format (fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10).c_str () );
0 commit comments