SCM

SCM Repository

[rcpp] Annotation of /pkg/Rcpp/src/exceptions.cpp
ViewVC logotype

Annotation of /pkg/Rcpp/src/exceptions.cpp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4207 - (view) (download) (as text)

1 : romain 219 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
2 :     //
3 : edd 238 // exceptions.cpp: R/C++ interface class library -- exception handling
4 : romain 219 //
5 : edd 3795 // Copyright (C) 2009 - 2012 Dirk Eddelbuettel and Romain Francois
6 : romain 219 //
7 :     // This file is part of Rcpp.
8 :     //
9 :     // Rcpp is free software: you can redistribute it and/or modify it
10 :     // under the terms of the GNU General Public License as published by
11 :     // the Free Software Foundation, either version 2 of the License, or
12 :     // (at your option) any later version.
13 :     //
14 :     // Rcpp is distributed in the hope that it will be useful, but
15 :     // WITHOUT ANY WARRANTY; without even the implied warranty of
16 :     // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 :     // GNU General Public License for more details.
18 :     //
19 :     // You should have received a copy of the GNU General Public License
20 :     // along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
21 :    
22 : romain 4163 #include <typeinfo>
23 : romain 4127 #include <Rcpp/platform/compiler.h>
24 : romain 4096 #define R_NO_REMAP
25 :     #include <Rinternals.h>
26 :     #include <Rcpp/exceptions.h>
27 : edd 4102 #include <cstdlib>
28 : romain 4128 #include "internal.h"
29 : romain 316
30 : romain 941 namespace Rcpp{
31 : romain 4096
32 : jjallaire 4026 exception::exception(const char* message_) : message(message_) {}
33 : edd 3795 exception::exception( const char* message_, const char* file, int line) : message(message_){
34 :     rcpp_set_stack_trace( stack_trace(file,line) ) ;
35 :     }
36 :     exception::~exception() throw(){}
37 : romain 1143
38 : edd 3795 #define RCPP_EXCEPTION_WHAT(__CLASS__) \
39 :     const char* __CLASS__::what() const throw(){ return message.c_str(); }
40 : romain 1143
41 : edd 3795 RCPP_EXCEPTION_WHAT(exception)
42 :     RCPP_EXCEPTION_WHAT(not_compatible)
43 :     RCPP_EXCEPTION_WHAT(S4_creation_error)
44 :     RCPP_EXCEPTION_WHAT(reference_creation_error)
45 :     RCPP_EXCEPTION_WHAT(no_such_binding)
46 :     RCPP_EXCEPTION_WHAT(binding_not_found)
47 :     RCPP_EXCEPTION_WHAT(binding_is_locked)
48 :     RCPP_EXCEPTION_WHAT(no_such_namespace)
49 : jjallaire 3910 RCPP_EXCEPTION_WHAT(function_not_exported)
50 : edd 3795 RCPP_EXCEPTION_WHAT(eval_error)
51 : romain 1143
52 :     #undef RCPP_EXCEPTION_WHAT
53 :    
54 : edd 3795 #define RCPP_SIMPLE_EXCEPTION_WHAT(__CLASS__,__MESSAGE__) \
55 : romain 1146 const char* __CLASS__::what() const throw(){ return __MESSAGE__ ; }
56 : romain 1143
57 : edd 3795 RCPP_SIMPLE_EXCEPTION_WHAT(not_a_matrix, "not a matrix" )
58 :     RCPP_SIMPLE_EXCEPTION_WHAT(index_out_of_bounds, "index out of bounds" )
59 :     RCPP_SIMPLE_EXCEPTION_WHAT(parse_error, "parse error")
60 :     RCPP_SIMPLE_EXCEPTION_WHAT(not_s4, "not an S4 object" )
61 :     RCPP_SIMPLE_EXCEPTION_WHAT(not_reference, "not a reference S4 object" )
62 :     RCPP_SIMPLE_EXCEPTION_WHAT(not_initialized, "C++ object not initialized" )
63 :     RCPP_SIMPLE_EXCEPTION_WHAT(no_such_slot, "no such slot" )
64 :     RCPP_SIMPLE_EXCEPTION_WHAT(no_such_field, "no such field" )
65 :     RCPP_SIMPLE_EXCEPTION_WHAT(not_a_closure, "not a closure" )
66 :     RCPP_SIMPLE_EXCEPTION_WHAT(no_such_function, "no such function" )
67 :     RCPP_SIMPLE_EXCEPTION_WHAT(unevaluated_promise, "promise not yet evaluated" )
68 : romain 1146
69 :     #undef RCPP_SIMPLE_EXCEPTION_WHAT
70 : romain 941 }
71 : romain 4158
72 :     SEXP get_last_call(){
73 :     SEXP sys_calls_symbol = Rf_install( "sys.calls" ) ;
74 :     SEXP sys_calls_expr = PROTECT( Rf_lang1(sys_calls_symbol) ) ;
75 :     SEXP calls = PROTECT( Rf_eval( sys_calls_expr, R_GlobalEnv ) ) ;
76 :     SEXP res = calls ;
77 :     while( !Rf_isNull(CDR(res)) ) res = CDR(res);
78 :     UNPROTECT(2);
79 :     return CAR(res) ;
80 :     }
81 : romain 941
82 : romain 4158 SEXP get_exception_classes( const std::string& ex_class) {
83 :     SEXP res = PROTECT( Rf_allocVector( STRSXP, 4 ) );
84 :     SET_STRING_ELT( res, 0, Rf_mkChar( ex_class.c_str() ) ) ;
85 :     SET_STRING_ELT( res, 1, Rf_mkChar( "C++Error" ) ) ;
86 :     SET_STRING_ELT( res, 2, Rf_mkChar( "error" ) ) ;
87 :     SET_STRING_ELT( res, 3, Rf_mkChar( "condition" ) ) ;
88 :     UNPROTECT(1) ;
89 :     return res;
90 :     }
91 : romain 219
92 : romain 4158 SEXP make_condition(const std::string& ex_msg, SEXP call, SEXP cppstack, SEXP classes){
93 :     SEXP res = PROTECT( Rf_allocVector( VECSXP, 3 ) ) ;
94 :     SEXP message = PROTECT( Rf_mkString( ex_msg.c_str() ) ) ;
95 :     SET_VECTOR_ELT( res, 0, message ) ;
96 :     SET_VECTOR_ELT( res, 1, call ) ;
97 :     SET_VECTOR_ELT( res, 2, cppstack ) ;
98 :     SEXP names = PROTECT( Rf_allocVector( STRSXP, 3 ) ) ;
99 :     SET_STRING_ELT( names, 0, Rf_mkChar( "message" ) ) ;
100 :     SET_STRING_ELT( names, 1, Rf_mkChar( "call" ) ) ;
101 :     SET_STRING_ELT( names, 2, Rf_mkChar( "cppstack" ) ) ;
102 :     Rf_setAttrib( res, R_NamesSymbol, names ) ;
103 :     Rf_setAttrib( res, R_ClassSymbol, classes ) ;
104 :     UNPROTECT(3) ;
105 :     return res ;
106 : romain 935 }
107 :    
108 : romain 4158 SEXP exception_to_r_condition( const std::exception& ex){
109 :     std::string ex_class = demangle( typeid(ex).name() ) ;
110 :     std::string ex_msg = ex.what() ;
111 :    
112 :     SEXP cppstack = PROTECT( rcpp_get_stack_trace() ) ;
113 :     SEXP call = PROTECT( get_last_call() ) ;
114 :     SEXP classes = PROTECT( get_exception_classes(ex_class) ) ;
115 :     SEXP condition = PROTECT( make_condition( ex_msg, call, cppstack, classes ) ) ;
116 :     rcpp_set_stack_trace( R_NilValue ) ;
117 :     UNPROTECT(4) ;
118 :     return condition ;
119 : romain 1040 }
120 :     void forward_exception_to_r( const std::exception& ex){
121 : romain 4158 SEXP condition = PROTECT(exception_to_r_condition(ex)) ;
122 :     SEXP stop_sym = Rf_install( "stop" ) ;
123 :     SEXP expr = PROTECT( Rf_lang2( stop_sym , condition ) );
124 :     UNPROTECT(2) ;
125 :     Rf_eval( expr, R_GlobalEnv ) ;
126 : romain 1040 }
127 : romain 219

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge