[Rcpp-devel] [Rcpp-commits] r335 - in pkg: inst inst/unitTests src src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jan 10 22:00:18 CET 2010
Author: romain
Date: 2010-01-10 22:00:17 +0100 (Sun, 10 Jan 2010)
New Revision: 335
Modified:
pkg/inst/ChangeLog
pkg/inst/unitTests/runit.Language.R
pkg/inst/unitTests/runit.Pairlist.R
pkg/src/Language.cpp
pkg/src/Rcpp/Language.h
Log:
+Language::operator[]
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/inst/ChangeLog 2010-01-10 21:00:17 UTC (rev 335)
@@ -1,7 +1,13 @@
2010-01-10 Romain Francois <francoisromain at free.fr>
* src/Rcpp/Pairlist.h: operator[] for pairlist using proxies
-
+ * src/Pairlist.cpp : idem
+ * inst/unitTests/runit.Pairlist.R: new unit tests
+
+ * src/Rcpp/Language.h: same for Language
+ * src/Language.cpp : idem
+ * inst/unitTests/runit.Language.R: new unit tests
+
* inst/unitTests/runit.Function.R: added unit test for function
throwing exceptions
Modified: pkg/inst/unitTests/runit.Language.R
===================================================================
--- pkg/inst/unitTests/runit.Language.R 2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/inst/unitTests/runit.Language.R 2010-01-10 21:00:17 UTC (rev 335)
@@ -64,4 +64,25 @@
msg = "Language::push_back" )
}
+test.Language.square <- function(){
+ funx <- cfunction(signature(), '
+ Language p("rnorm") ;
+ p.push_back( 1 ) ;
+ p.push_back( 10.0 ) ;
+ p.push_back( 20.0 ) ;
+ return p[2] ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ checkEquals( funx(), 10.0, msg = "Language::operator[] used as rvalue" )
+ funx <- cfunction(signature(), '
+ Language p("rnorm") ;
+ p.push_back( 1 ) ;
+ p.push_back( 10.0 ) ;
+ p.push_back( 20.0 ) ;
+ p[1] = "foobar" ;
+ p[2] = p[3] ;
+ return p ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ checkEquals( funx(), call("rnorm", "foobar", 20.0, 20.0) , msg = "Pairlist::operator[] used as lvalue" )
+}
+
Modified: pkg/inst/unitTests/runit.Pairlist.R
===================================================================
--- pkg/inst/unitTests/runit.Pairlist.R 2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/inst/unitTests/runit.Pairlist.R 2010-01-10 21:00:17 UTC (rev 335)
@@ -162,7 +162,7 @@
}
-test.Pairlist.square.rvalue <- function(){
+test.Pairlist.square <- function(){
funx <- cfunction(signature(), '
Pairlist p ;
p.push_back( 1 ) ;
@@ -171,9 +171,7 @@
return p[1] ;
', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
checkEquals( funx(), 10.0, msg = "Pairlist::operator[] used as rvalue" )
-}
-test.Pairlist.square.rvalue <- function(){
funx <- cfunction(signature(), '
Pairlist p ;
p.push_back( 1 ) ;
@@ -183,7 +181,7 @@
p[2] = p[0] ;
return p ;
', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
- checkEquals( funx(), pairlist(1L, "foobar", 1L) , msg = "Pairlist::operator[] used as rvalue" )
+ checkEquals( funx(), pairlist(1L, "foobar", 1L) , msg = "Pairlist::operator[] used as lvalue" )
}
Modified: pkg/src/Language.cpp
===================================================================
--- pkg/src/Language.cpp 2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/src/Language.cpp 2010-01-10 21:00:17 UTC (rev 335)
@@ -96,6 +96,92 @@
}
}
-
+ /* proxy for operator[] */
+
+ Language::Proxy::Proxy(Language& v, const size_t& index) :
+ parent(v), index(index) {} ;
+
+ Language::Proxy& Language::Proxy::operator=(const Proxy& rhs){
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ if( rhs.index < 0 || rhs.index >= rhs.parent.length() ) throw index_out_of_bounds() ;
+
+ SEXP target = parent.asSexp() ;
+ SEXP origin = rhs.parent.asSexp();
+ size_t i=0;
+ while( i < index ){
+ target = CDR(target) ;
+ i++;
+ }
+ i=0;
+ while( i < rhs.index ){
+ origin = CDR(origin) ;
+ i++;
+ }
+ SETCAR( target, CAR(origin) );
+ if( index != 0 ) SET_TAG( target, TAG(origin) );
+ return *this ;
+ }
+
+ Language::Proxy& Language::Proxy::operator=(const Named& rhs){
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ size_t i = 0 ;
+ SEXP x = parent.asSexp() ;
+ while( i < index ) {
+ x = CDR(x) ;
+ i++ ;
+ }
+ SETCAR( x, rhs.getSEXP() ) ;
+ if( index != 0 ) SET_TAG( x, Symbol( rhs.getTag() ) ) ;
+ return *this ;
+ }
+
+ Language::Proxy& Language::Proxy::operator=(SEXP rhs){
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ SEXP x = parent.asSexp() ;
+ size_t i = 0 ;
+ while( i < index ) {
+ x = CDR(x) ;
+ i++ ;
+ }
+ SETCAR( x, rhs) ;
+ return *this ;
+ }
+
+
+ /* rvalue uses */
+
+ Language::Proxy::operator SEXP() const{
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ SEXP x = parent.asSexp() ;
+ size_t i = 0 ;
+ while( i < index ) {
+ x = CDR(x) ;
+ i++ ;
+ }
+ return CAR(x) ;
+ }
+
+ Language::Proxy::operator RObject() const{
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ SEXP x = parent.asSexp() ;
+ size_t i = 0 ;
+ while( i < index ) {
+ x = CDR(x) ;
+ i++ ;
+ }
+ return wrap( CAR(x) ) ;
+ }
+
+ const Language::Proxy Language::operator[](int i) const {
+ return Proxy( const_cast<Language&>(*this), i) ;
+ }
+
+ Language::Proxy Language::operator[](int i){
+ return Proxy( *this, i );
+ }
+
+
+
+
} // namespace Rcpp
Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h 2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/src/Rcpp/Language.h 2010-01-10 21:00:17 UTC (rev 335)
@@ -196,8 +196,8 @@
}
}
- inline size_t length(){ return Rf_length(m_sexp) ; }
- inline size_t size(){ return Rf_length(m_sexp) ; }
+ inline size_t length() const { return Rf_length(m_sexp) ; }
+ inline size_t size() const { return Rf_length(m_sexp) ; }
/**
* Remove the element at the given position
@@ -205,7 +205,38 @@
* @param index position where the element is to be removed
*/
void remove( const int& index ) throw(index_out_of_bounds) ;
+
+ class Proxy {
+ public:
+ Proxy( Language& v, const size_t& index ) ;
+
+ /* lvalue uses */
+ Proxy& operator=(const Proxy& rhs) ;
+ Proxy& operator=(SEXP rhs) ;
+
+ template <typename T>
+ Proxy& operator=(const T& rhs){
+ parent.replace( index, rhs ) ;
+ return *this ;
+ }
+
+ Proxy& operator=(const Named& rhs) ;
+
+ /* rvalue use */
+ operator SEXP() const ;
+ operator RObject() const ;
+
+ private:
+ Language& parent;
+ size_t index ;
+ } ;
+ const Proxy operator[]( int i ) const ;
+ Proxy operator[]( int i ) ;
+
+ friend class Proxy;
+
+
~Language() ;
};
_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits
More information about the Rcpp-devel
mailing list