2
2
//
3
3
// rcast.h: Rcpp R/C++ interface class library -- cast from one SEXP type to another
4
4
//
5
- // Copyright (C) 2010 - 2013 Dirk Eddelbuettel and Romain Francois
5
+ // Copyright (C) 2010 - 2017 Dirk Eddelbuettel and Romain Francois
6
6
//
7
7
// This file is part of Rcpp.
8
8
//
24
24
25
25
#include < Rcpp/exceptions.h>
26
26
27
- namespace Rcpp {
27
+ namespace Rcpp {
28
28
namespace internal {
29
29
30
- inline SEXP convert_using_rfunction (SEXP x, const char * const fun){
31
- Armor<SEXP> res ;
30
+ inline SEXP convert_using_rfunction (SEXP x, const char * const fun) { // #nocov start
31
+ Armor<SEXP> res;
32
32
try {
33
33
SEXP funSym = Rf_install (fun);
34
- res = Rcpp_eval ( Rf_lang2 ( funSym, x ) ) ;
34
+ res = Rcpp_eval (Rf_lang2 (funSym, x)) ;
35
35
} catch ( eval_error& e){
36
- throw not_compatible ( std::string (" could not convert using R function : " ) + fun ) ;
36
+ throw not_compatible (std::string (" could not convert using R function : " ) + fun) ;
37
37
}
38
- return res;
38
+ return res; // #nocov end
39
39
}
40
40
41
41
// r_true_cast is only meant to be used when the target SEXP type
42
42
// is different from the SEXP type of x
43
43
template <int TARGET>
44
44
SEXP r_true_cast ( SEXP x) {
45
- throw not_compatible ( " not compatible" ) ;
46
- return x ; // makes solaris happy
45
+ throw not_compatible ( " not compatible" );
46
+ return x; // makes solaris happy
47
47
}
48
48
49
49
template <int RTYPE>
50
- SEXP basic_cast ( SEXP x){
51
- if ( TYPEOF (x) == RTYPE ) return x ;
50
+ SEXP basic_cast ( SEXP x) { // #nocov start
51
+ if ( TYPEOF (x) == RTYPE ) return x;
52
52
switch ( TYPEOF (x) ){
53
53
case REALSXP:
54
54
case RAWSXP:
55
55
case LGLSXP:
56
56
case CPLXSXP:
57
57
case INTSXP:
58
- return Rf_coerceVector ( x, RTYPE) ;
58
+ return Rf_coerceVector (x, RTYPE);
59
59
default :
60
- throw ::Rcpp::not_compatible ( " not compatible with requested type" ) ;
61
- }
62
- return R_NilValue ; /* -Wall */
60
+ throw ::Rcpp::not_compatible (" not compatible with requested type" ) ;
61
+ } // #nocov end
62
+ return R_NilValue; /* -Wall */
63
63
}
64
64
65
65
template <>
66
66
inline SEXP r_true_cast<INTSXP>(SEXP x){
67
- return basic_cast<INTSXP>(x) ;
67
+ return basic_cast<INTSXP>(x);
68
68
}
69
69
template <>
70
- inline SEXP r_true_cast<REALSXP>(SEXP x){
71
- return basic_cast<REALSXP>(x) ;
70
+ inline SEXP r_true_cast<REALSXP>(SEXP x){ // #nocov
71
+ return basic_cast<REALSXP>(x); // #nocov
72
72
}
73
73
template <>
74
74
inline SEXP r_true_cast<RAWSXP>(SEXP x){
75
- return basic_cast<RAWSXP>(x) ;
75
+ return basic_cast<RAWSXP>(x);
76
76
}
77
77
template <>
78
78
inline SEXP r_true_cast<CPLXSXP>(SEXP x){
79
- return basic_cast<CPLXSXP>(x) ;
79
+ return basic_cast<CPLXSXP>(x);
80
80
}
81
81
template <>
82
- inline SEXP r_true_cast<LGLSXP>(SEXP x){
83
- return basic_cast<LGLSXP>(x) ;
82
+ inline SEXP r_true_cast<LGLSXP>(SEXP x){ // #nocov
83
+ return basic_cast<LGLSXP>(x); // #nocov
84
84
}
85
85
86
86
template <>
87
- inline SEXP r_true_cast<STRSXP>(SEXP x){
88
- switch ( TYPEOF ( x ) ) {
87
+ inline SEXP r_true_cast<STRSXP>(SEXP x){ // #nocov start
88
+ switch ( TYPEOF (x)) {
89
89
case CPLXSXP:
90
90
case RAWSXP:
91
91
case LGLSXP:
@@ -94,43 +94,43 @@ namespace Rcpp{
94
94
{
95
95
// return Rf_coerceVector( x, STRSXP );
96
96
// coerceVector does not work for some reason
97
- Shield<SEXP> call ( Rf_lang2 ( Rf_install ( " as.character" ), x ) ) ;
98
- Shield<SEXP> res ( Rcpp_eval ( call, R_GlobalEnv ) ) ;
99
- return res ;
97
+ Shield<SEXP> call ( Rf_lang2 ( Rf_install ( " as.character" ), x ) );
98
+ Shield<SEXP> res ( Rcpp_eval ( call, R_GlobalEnv ) );
99
+ return res;
100
100
}
101
101
case CHARSXP:
102
- return Rf_ScalarString ( x ) ;
102
+ return Rf_ScalarString ( x );
103
103
case SYMSXP:
104
- return Rf_ScalarString ( PRINTNAME ( x ) ) ;
104
+ return Rf_ScalarString ( PRINTNAME ( x ) );
105
105
default :
106
- throw ::Rcpp::not_compatible ( " not compatible with STRSXP" ) ;
106
+ throw ::Rcpp::not_compatible (" not compatible with STRSXP" ) ;
107
107
}
108
- return R_NilValue ; /* -Wall */
108
+ return R_NilValue; /* -Wall */
109
109
}
110
110
template <>
111
111
inline SEXP r_true_cast<VECSXP>(SEXP x) {
112
- return convert_using_rfunction (x, " as.list" ) ;
112
+ return convert_using_rfunction (x, " as.list" ); // #nocov end
113
113
}
114
114
template <>
115
115
inline SEXP r_true_cast<EXPRSXP>(SEXP x) {
116
- return convert_using_rfunction (x, " as.expression" ) ;
116
+ return convert_using_rfunction (x, " as.expression" );
117
117
}
118
118
template <>
119
119
inline SEXP r_true_cast<LISTSXP>(SEXP x) {
120
120
switch ( TYPEOF (x) ){
121
121
case LANGSXP:
122
122
{
123
123
Shield<SEXP> y ( Rf_duplicate ( x ));
124
- SET_TYPEOF (y,LISTSXP) ;
125
- return y ;
124
+ SET_TYPEOF (y,LISTSXP);
125
+ return y;
126
126
}
127
127
default :
128
- return convert_using_rfunction (x, " as.pairlist" ) ;
128
+ return convert_using_rfunction (x, " as.pairlist" );
129
129
}
130
130
}
131
131
template <>
132
132
inline SEXP r_true_cast<LANGSXP>(SEXP x) {
133
- return convert_using_rfunction (x, " as.call" ) ;
133
+ return convert_using_rfunction (x, " as.call" );
134
134
}
135
135
136
136
} // namespace internal
@@ -147,7 +147,7 @@ namespace Rcpp{
147
147
);
148
148
return result;
149
149
#else
150
- return internal::r_true_cast<TARGET>(x);
150
+ return internal::r_true_cast<TARGET>(x); // #nocov
151
151
#endif
152
152
}
153
153
}
0 commit comments