[Rcpp-commits] r935 - in pkg/Rcpp/src: . Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 23 11:08:19 CET 2010
Author: romain
Date: 2010-03-23 11:08:19 +0100 (Tue, 23 Mar 2010)
New Revision: 935
Modified:
pkg/Rcpp/src/Rcpp/Vector.h
pkg/Rcpp/src/Rcpp/as.h
pkg/Rcpp/src/RcppCommon.cpp
pkg/Rcpp/src/RcppCommon.h
pkg/Rcpp/src/exceptions.cpp
Log:
attempt to fix bug reported by Doug
Modified: pkg/Rcpp/src/Rcpp/Vector.h
===================================================================
--- pkg/Rcpp/src/Rcpp/Vector.h 2010-03-20 22:09:10 UTC (rev 934)
+++ pkg/Rcpp/src/Rcpp/Vector.h 2010-03-23 10:08:19 UTC (rev 935)
@@ -149,7 +149,9 @@
public:
typedef ::Rcpp::Vector<RTYPE> VECTOR ;
generic_name_proxy( VECTOR& v, const std::string& name_) :
- parent(v), name(name_){} ;
+ parent(v), name(name_){
+ RCPP_DEBUG( "generic_name_proxy( VECTOR& = %p, const string& = %s)", v.asSexp(), name_.c_str() );
+ } ;
generic_name_proxy( const generic_name_proxy& other ) :
parent(other.parent), name(other.name){} ;
~generic_name_proxy(){} ;
@@ -177,7 +179,13 @@
template <typename T>
operator T(){
+ #if RCPP_DEBUG_LEVEL > 0
+ SEXP res = get() ;
+ RCPP_DEBUG( "generic_name_proxy::get() = <%p> ", res ) ;
+ return ::Rcpp::as<T>( res ) ;
+ #else
return ::Rcpp::as<T>( get() ) ;
+ #endif
}
private:
@@ -422,10 +430,20 @@
template <typename VECTOR>
class VectorBase : public RObject{
public:
- VectorBase() : RObject(){}
- VectorBase(SEXP x) : RObject(x){}
- ~VectorBase(){}
- VectorBase(const VectorBase& v) : RObject( v.asSexp() ){}
+ VectorBase() : RObject(){
+ RCPP_DEBUG( "VectorBase()" ) ;
+ }
+ VectorBase(SEXP x) : RObject(x){
+ update() ;
+ RCPP_DEBUG( "VectorBase( SEXP = <%p> ) = <%p>", x, asSexp() ) ;
+ }
+ ~VectorBase(){
+ RCPP_DEBUG( "~VectorBase" ) ;
+ }
+ VectorBase(const VectorBase& v) : RObject( v.asSexp() ){
+ update() ;
+ RCPP_DEBUG( "VectorBase( const VectorBase& = <%p> ) ) = <%p>", v.asSexp(), asSexp() ) ;
+ }
VectorBase& operator=(const VectorBase& v) {
setSEXP( v.asSexp() ) ;
return *this ;
@@ -434,6 +452,7 @@
return static_cast<VECTOR&>(*this) ;
}
virtual void update(){
+ RCPP_DEBUG( "%s::update", DEMANGLE(VectorBase) ) ;
(static_cast<VECTOR&>(*this)).update_vector() ;
}
} ;
@@ -455,13 +474,26 @@
struct r_type : traits::integral_constant<int,RTYPE>{} ;
Vector() : Base() {
+ RCPP_DEBUG( "Vector()" ) ;
Base::setSEXP( Rf_allocVector( RTYPE, 0 ) ) ;
init() ;
} ;
- ~Vector(){};
+ ~Vector(){
+ RCPP_DEBUG( "~Vector()" ) ;
+ };
+ Vector( const Vector& other) : Base(other.asSexp()) {
+ update() ;
+ }
+
+ Vector& operator=( const Vector& other ){
+ Base::setSEXP( other.asSexp() ) ;
+ }
+
Vector( SEXP x ) : Base() {
+ RCPP_DEBUG( "Vector<%d>( SEXP = <%p> )", RTYPE, x) ;
Base::setSEXP( r_cast<RTYPE>( x ) ) ;
+ RCPP_DEBUG( "===========") ;
}
Vector( const size_t& size ) : Base() {
@@ -725,7 +757,8 @@
return erase_range__impl( first, last ) ;
}
- void update_vector(){
+ void update_vector(){
+ RCPP_DEBUG( "update_vector, VECTOR = %s", DEMANGLE(Vector) ) ;
cache.update(*this) ;
}
@@ -2206,7 +2239,8 @@
internal::r_init_vector<RTYPE>(Base::m_sexp) ;
}
- virtual void update(){
+ virtual void update(){
+ RCPP_DEBUG( "%s::update", DEMANGLE(Vector) ) ;
update_vector() ;
}
@@ -2267,6 +2301,7 @@
private:
virtual void update(){
+ RCPP_DEBUG( "%s::update", DEMANGLE(Matrix) ) ;
VECTOR::update_vector() ;
}
@@ -2482,7 +2517,9 @@
* @param index index
*/
string_proxy( VECTOR& v, int index_ ) :
- parent(&v), index(index_){}
+ parent(&v), index(index_){
+ RCPP_DEBUG( "string_proxy( VECTOR& = <%p>, index_ = %d) ", v.asSexp(), index_ ) ;
+ }
string_proxy( const string_proxy& other ) :
parent(other.parent), index(other.index){} ;
@@ -2556,7 +2593,7 @@
* C string
*/
operator /*const */ char*() const {
- return const_cast<char*>( CHAR(STRING_ELT( *parent, index )) );
+ return const_cast<char*>( CHAR(get()) );
}
/**
Modified: pkg/Rcpp/src/Rcpp/as.h
===================================================================
--- pkg/Rcpp/src/Rcpp/as.h 2010-03-20 22:09:10 UTC (rev 934)
+++ pkg/Rcpp/src/Rcpp/as.h 2010-03-23 10:08:19 UTC (rev 935)
@@ -43,11 +43,13 @@
if (Rf_length(x) != 1) {
throw std::range_error( "expecting a single value");
}
- return T( CHAR( STRING_ELT(x,0 ) ) ) ;
+ return T( CHAR( STRING_ELT( ::Rcpp::r_cast<STRSXP>(x) ,0 ) ) ) ;
}
template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_generic_tag ){
+ RCPP_DEBUG( "as(SEXP = <%p>, r_type_generic_tag )", x ) ;
::Rcpp::traits::Exporter<T> exporter(x);
+ RCPP_DEBUG( "exporter type = %s", DEMANGLE(exporter) ) ;
return exporter.get() ;
}
Modified: pkg/Rcpp/src/RcppCommon.cpp
===================================================================
--- pkg/Rcpp/src/RcppCommon.cpp 2010-03-20 22:09:10 UTC (rev 934)
+++ pkg/Rcpp/src/RcppCommon.cpp 2010-03-23 10:08:19 UTC (rev 935)
@@ -37,7 +37,7 @@
return Rmesg;
}
-inline void logTxtFunction(const char* file, const int line, const char* expression) {
+void logTxtFunction(const char* file, const int line, const char* expression) {
Rprintf("%s:%d %s\n", file, line, expression);
}
Modified: pkg/Rcpp/src/RcppCommon.h
===================================================================
--- pkg/Rcpp/src/RcppCommon.h 2010-03-20 22:09:10 UTC (rev 934)
+++ pkg/Rcpp/src/RcppCommon.h 2010-03-23 10:08:19 UTC (rev 935)
@@ -24,6 +24,8 @@
#ifndef RcppCommon_h
#define RcppCommon_h
+void logTxtFunction(const char* file, const int line, const char* expression ) ;
+
#define ___RCPP_HANDLE_CASE___( ___RTYPE___ , ___FUN___ , ___OBJECT___ , ___RCPPTYPE___ ) \
case ___RTYPE___ : \
return ___FUN___( ::Rcpp::___RCPPTYPE___< ___RTYPE___ >( ___OBJECT___ ) ) ;
@@ -110,6 +112,9 @@
#include <tr1/unordered_set>
#endif
+std::string demangle( const char* name) ;
+#define DEMANGLE(__TYPE__) demangle( typeid(__TYPE__).name() ).c_str()
+
// include R headers, but set R_NO_REMAP and access everything via Rf_ prefixes
#define R_NO_REMAP
#include <R.h>
@@ -140,14 +145,6 @@
char *copyMessageToR(const char* const mesg);
-// simple logging help
-inline void logTxtFunction(const char* file, const int line, const char* expression);
-
-#ifndef logTxt
-//#define logTxt(x) logTxtFunction(__FILE__, __LINE__, x);
-#define logTxt(x)
-#endif
-
/* in exceptions.cpp */
void forward_uncaught_exceptions_to_r() ;
RcppExport SEXP initUncaughtExceptionHandler() ;
@@ -191,7 +188,19 @@
} // namespace Rcpp
+// simple logging help
+#define RCPP_DEBUG_LEVEL 0
+#ifndef logTxt
+ #if RCPP_DEBUG_LEVEL > 0
+ #define logTxt(x) ::logTxtFunction(__FILE__, __LINE__, x);
+ #define RCPP_DEBUG( fmt , ... ) Rprintf( "%s:%d " fmt "\n" , __FILE__, __LINE__,##__VA_ARGS__ ) ;
+ #else
+ #define logTxt(x)
+ #define RCPP_DEBUG( fmt , ... )
+ #endif
+#endif
+
// DO NOT CHANGE THE ORDER OF THESE INCLUDES
#include <Rcpp/traits/integral_constant.h>
#include <Rcpp/traits/same_type.h>
Modified: pkg/Rcpp/src/exceptions.cpp
===================================================================
--- pkg/Rcpp/src/exceptions.cpp 2010-03-20 22:09:10 UTC (rev 934)
+++ pkg/Rcpp/src/exceptions.cpp 2010-03-23 10:08:19 UTC (rev 935)
@@ -29,6 +29,20 @@
#include <exception_defines.h>
#include <cxxabi.h>
+std::string demangle( const char* name){
+ std::string real_class ;
+ int status =-1 ;
+ char *dem = 0;
+ dem = abi::__cxa_demangle(name, 0, 0, &status);
+ if( status == 0 ){
+ real_class = dem ;
+ free(dem);
+ } else {
+ real_class = name ;
+ }
+ return real_class ;
+}
+
/* much inspired from the __verbose_terminate_handler of the GCC */
void forward_uncaught_exceptions_to_r(){
@@ -87,6 +101,9 @@
R_NilValue ), R_FindNamespace(Rf_mkString("Rcpp"))
) ;
}
+std::string demangle( const char* name){
+ return std::string( name ) ;
+}
#endif
SEXP initUncaughtExceptionHandler(){
/* FIXME: we might want to restore the original handler as the package
More information about the Rcpp-commits
mailing list