Skip to content

Commit 1c90562

Browse files
kevinusheykevinushey
committed
remove calling handlers from Rcpp_eval
1 parent 0010c56 commit 1c90562

File tree

1 file changed

+86
-85
lines changed

1 file changed

+86
-85
lines changed

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

Lines changed: 86 additions & 85 deletions
Original file line numberDiff line numberDiff line change
@@ -20,101 +20,102 @@
2020

2121
#include <Rcpp/Interrupt.h>
2222

23-
namespace Rcpp{
24-
25-
struct EvalCall {
26-
SEXP expr;
27-
SEXP env;
28-
SEXP result;
29-
std::vector<std::string> warnings;
30-
bool error_occurred;
31-
std::string error_message;
32-
};
33-
34-
inline void Rcpp_eval(void* data) {
35-
36-
EvalCall* evalCall = (EvalCall*)data;
37-
SEXP env = evalCall->env;
38-
39-
Shield<SEXP> expr(evalCall->expr) ;
40-
41-
Environment RCPP = Environment::Rcpp_namespace();
42-
SEXP withCallingHandlersSym = ::Rf_install("withCallingHandlers");
43-
SEXP tryCatchSym = ::Rf_install("tryCatch");
44-
SEXP evalqSym = ::Rf_install("evalq");
45-
SEXP conditionMessageSym = ::Rf_install("conditionMessage");
46-
SEXP errorRecorderSym = ::Rf_install(".rcpp_error_recorder");
47-
SEXP warningRecorderSym = ::Rf_install(".rcpp_warning_recorder");
48-
SEXP collectWarningsSym = ::Rf_install(".rcpp_collect_warnings");
49-
SEXP errorSym = ::Rf_install("error");
50-
SEXP warningSym = ::Rf_install("warning");
51-
52-
// define the tryCatchCall
53-
Shield<SEXP> tryCatchCall( Rf_lang3(
54-
tryCatchSym,
55-
Rf_lang3( evalqSym, expr, env ),
56-
errorRecorderSym
57-
) ) ;
58-
SET_TAG( CDDR(tryCatchCall), errorSym ) ;
59-
60-
// encose it in withCallingHandlers
61-
Shield<SEXP> call( Rf_lang3(
62-
withCallingHandlersSym,
63-
tryCatchCall,
64-
warningRecorderSym
65-
) ) ;
66-
SET_TAG( CDDR(call), warningSym ) ;
67-
68-
// execute the call
69-
Shield<SEXP> res(::Rf_eval( call, RCPP ) );
70-
71-
// collect warnings
72-
Shield<SEXP> warningCall(Rf_lang1(collectWarningsSym));
73-
Shield<SEXP> warnings(::Rf_eval(warningCall, RCPP));
74-
75-
evalCall->warnings = Rcpp::as<std::vector<std::string> >(warnings);
76-
77-
// check for error
78-
if( error_occured() ) {
79-
Shield<SEXP> current_error ( rcpp_get_current_error() ) ;
80-
Shield<SEXP> conditionMessageCall (::Rf_lang2(conditionMessageSym, current_error)) ;
81-
Shield<SEXP> condition_message (::Rf_eval(conditionMessageCall, R_GlobalEnv)) ;
82-
evalCall->error_occurred = true;
83-
evalCall->error_message = std::string(CHAR(::Rf_asChar(condition_message)));
84-
} else {
85-
evalCall->error_occurred = false;
86-
evalCall->result = res;
87-
}
88-
89-
reset_current_error() ;
23+
namespace Rcpp {
24+
25+
struct EvalCall {
26+
27+
// Related to call object
28+
SEXP expr;
29+
SEXP env;
30+
SEXP result;
31+
32+
// Related to error recording / forwarding
33+
bool error_occurred;
34+
std::string error_message;
35+
};
36+
37+
inline void Rcpp_eval(void* data) {
38+
39+
EvalCall* evalCall = (EvalCall*) data;
40+
41+
SEXP tryCatchSym = ::Rf_install("tryCatch");
42+
SEXP evalqSym = ::Rf_install("evalq");
43+
SEXP conditionMessageSym = ::Rf_install("conditionMessage");
44+
SEXP errorSym = ::Rf_install("error");
45+
46+
// get the Rcpp error recorder
47+
SEXP errorRecorder = Rf_findFun(
48+
Rf_install(".rcpp_error_recorder"),
49+
Environment::Rcpp_namespace()
50+
);
51+
52+
if (errorRecorder == R_UnboundValue) {
53+
evalCall->error_occurred = true;
54+
evalCall->error_message =
55+
"Failed to find Rcpp error recorder: please ensure\n"
56+
"you have the latest version of Rcpp installed.";
57+
return;
58+
}
9059

60+
// define the evalq call -- the actual R evaluation we
61+
// want to execute
62+
Shield<SEXP> evalqCall(Rf_lang3(
63+
evalqSym,
64+
evalCall->expr,
65+
evalCall->env
66+
));
67+
68+
// define the call -- enclose with `tryCatch` so we can record
69+
// and later forward error messages
70+
Shield<SEXP> call(Rf_lang3(
71+
tryCatchSym,
72+
evalqCall,
73+
errorRecorder
74+
));
75+
SET_TAG(CDDR(call), errorSym);
76+
77+
// execute the call
78+
Shield<SEXP> res(::Rf_eval(call, R_GlobalEnv));
79+
80+
// check for error
81+
if (error_occured()) {
82+
Shield<SEXP> current_error (rcpp_get_current_error());
83+
Shield<SEXP> conditionMessageCall (::Rf_lang2(conditionMessageSym, current_error));
84+
Shield<SEXP> condition_message (::Rf_eval(conditionMessageCall, R_GlobalEnv));
85+
evalCall->error_occurred = true;
86+
evalCall->error_message = std::string(CHAR(::Rf_asChar(condition_message)));
87+
} else {
88+
evalCall->error_occurred = false;
89+
evalCall->result = res;
9190
}
91+
92+
// Reset the current error for the next evaluation
93+
reset_current_error();
9294

93-
inline SEXP Rcpp_eval(SEXP expr_, SEXP env) {
95+
}
9496

95-
// create the call object
96-
EvalCall call;
97-
call.expr = expr_;
98-
call.env = env;
97+
inline SEXP Rcpp_eval(SEXP expr, SEXP env) {
9998

100-
// execute it
101-
Rboolean completed = R_ToplevelExec(Rcpp_eval, (void*)&call);
99+
// create the call object
100+
EvalCall call;
101+
call.expr = expr;
102+
call.env = env;
102103

103-
// print warnings
104-
for (size_t i = 0; i<call.warnings.size(); i++)
105-
Rf_warning(call.warnings[i].c_str());
104+
// execute it
105+
Rboolean completed = R_ToplevelExec(Rcpp_eval, (void*) &call);
106106

107-
// handle error or result if it completed, else throw interrupt
108-
if (completed) {
109-
if (call.error_occurred)
110-
throw eval_error(call.error_message);
111-
else
112-
return call.result;
107+
// handle error or result if it completed, else throw interrupt
108+
if (completed) {
109+
if (call.error_occurred) {
110+
throw eval_error(call.error_message);
113111
} else {
114-
throw internal::InterruptedException();
112+
return call.result;
115113
}
114+
} else {
115+
throw internal::InterruptedException();
116116
}
117-
118117
}
119118

119+
} // namespace Rcpp
120+
120121
#endif

0 commit comments

Comments
 (0)