[Rcpp-commits] r1189 - in pkg/Rcpp: inst/include/Rcpp inst/unitTests src

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-05-10 15:26:56 +0200 (Mon, 10 May 2010)
New Revision: 1189

Modified:
   pkg/Rcpp/inst/include/Rcpp/Dimension.h
   pkg/Rcpp/inst/include/Rcpp/preprocessor.h
   pkg/Rcpp/inst/unitTests/runit.macros.R
   pkg/Rcpp/src/Dimension.cpp
Log:
testing RCPP_CP_FIELD

Modified: pkg/Rcpp/inst/include/Rcpp/Dimension.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Dimension.h	2010-05-08 20:01:24 UTC (rev 1188)
+++ pkg/Rcpp/inst/include/Rcpp/Dimension.h	2010-05-10 13:26:56 UTC (rev 1189)
@@ -23,11 +23,14 @@
 #define Rcpp_Dimension_h
 
 #include <RcppCommon.h>
-
+ 
 namespace Rcpp{ 
 
 class Dimension {
 public:
+	typedef std::vector<int>::reference reference ;
+	typedef std::vector<int>::const_reference const_reference ;
+	
 	Dimension() ;
 	Dimension(SEXP dims);
 	Dimension( const Dimension& other ) ;
@@ -40,7 +43,8 @@
 	int size() const ;
 	int prod() const ;
 	
-	int& operator[](int i) throw(std::range_error) ;
+	reference operator[](int i) throw(std::range_error) ;
+	const_reference operator[](int i) const throw(std::range_error) ;
 	
 private:
 	std::vector<int> dims ;

Modified: pkg/Rcpp/inst/include/Rcpp/preprocessor.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/preprocessor.h	2010-05-08 20:01:24 UTC (rev 1188)
+++ pkg/Rcpp/inst/include/Rcpp/preprocessor.h	2010-05-10 13:26:56 UTC (rev 1189)
@@ -64,7 +64,7 @@
 	using Rcpp::_ ;                                            \
 	Rcpp::List info = Rcpp::List::create(                      \
         _["class"]  = #__CLASS__  ,                            \
-        _["field"]  = #__FIELD__ ,                             \
+        _["field"]  = #__FIELD__                              \
         )   ;                                                  \
     info.attr( "class" ) = "rcppxpfieldgetinfo" ;              \
     return info   ;                                            \
@@ -83,7 +83,7 @@
 	using Rcpp::_ ;                                            \
 	Rcpp::List info = Rcpp::List::create(                      \
         _["class"]  = #__CLASS__  ,                            \
-        _["field"]  = #__FIELD__ ,                             \
+        _["field"]  = #__FIELD__                              \
         )   ;                                                  \
     info.attr( "class" ) = "rcppxpfieldsetinfo" ;              \
     return info   ;                                            \

Modified: pkg/Rcpp/inst/unitTests/runit.macros.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.macros.R	2010-05-08 20:01:24 UTC (rev 1188)
+++ pkg/Rcpp/inst/unitTests/runit.macros.R	2010-05-10 13:26:56 UTC (rev 1189)
@@ -17,7 +17,8 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
-.getInfo <- function( symbol, fx ){
+
+.getDll <- function( fx ){
 	env <- environment( fx at .Data )
 	f <- get( "f", env )
 	dlls <- getLoadedDLLs()
@@ -26,6 +27,14 @@
 	} else{
 		dlls[[ match( f, names(dlls) ) ]]
 	}
+	dll
+}
+
+.getInfo <- function( symbol, fx ){
+	env <- environment( fx at .Data )
+	f <- get( "f", env )
+	dlls <- getLoadedDLLs()
+	dll <- .getDll( fx )
 	info_symbol <- paste( symbol, "__rcpp_info__", sep = "" )
 	routine <- getNativeSymbolInfo( info_symbol, dll )
 	info <- .Call( routine )
@@ -173,4 +182,38 @@
 	
 }
 
+test.RCPPXPFIELD <- function(){
+	
+	cl <- '
+	class Foo {
+		public:
+			int x ;
+			Foo( int x_) : x(x_){}
+	} ;
+	RCPP_XP_FIELD( Foo_x, Foo, x )
+	RCPP_FUNCTION_0(SEXP, newFoo){
+		return Rcpp::XPtr<Foo>( new Foo(2), true ) ; 
+	}
+	'
+	
+	fx <- cppfunction( signature(xp = "externalptr"), '', include = cl )
+	
+	get_info <- .getInfo( "Foo_x_get", fx )
+	set_info <- .getInfo( "Foo_x_set", fx )
+	checkEquals( get_info[["class"]], "Foo" )
+	checkEquals( set_info[["class"]], "Foo" )
+	checkEquals( get_info[["field"]], "x" )
+	checkEquals( set_info[["field"]], "x" )
+	checkEquals( class( get_info ), "rcppxpfieldgetinfo" )
+	checkEquals( class( set_info ), "rcppxpfieldsetinfo" )
+	
+	dll <- .getDll( fx )
+	xp <- .Call( dll$newFoo )
+	
+	checkEquals( .Call( dll$Foo_x_get, xp ), 2L )
+	.Call( dll$Foo_x_set, xp, 10L )
+	checkEquals( .Call( dll$Foo_x_get, xp ), 10L )
+	
+}
 
+

Modified: pkg/Rcpp/src/Dimension.cpp
===================================================================
--- pkg/Rcpp/src/Dimension.cpp	2010-05-08 20:01:24 UTC (rev 1188)
+++ pkg/Rcpp/src/Dimension.cpp	2010-05-10 13:26:56 UTC (rev 1189)
@@ -65,9 +65,14 @@
 		return std::accumulate( dims.begin(), dims.end(), 1, std::multiplies<int>() ) ;
 	}
 	
-	int& Dimension::operator[](int i) throw(std::range_error){
+	Dimension::reference Dimension::operator[](int i) throw(std::range_error){
 		if( i < 0 || i>=static_cast<int>(dims.size()) ) throw std::range_error("index out of bounds") ;
 		return dims.at(i) ;
 	}
 
+	Dimension::const_reference Dimension::operator[](int i) const throw(std::range_error){
+		if( i < 0 || i>=static_cast<int>(dims.size()) ) throw std::range_error("index out of bounds") ;
+		return dims.at(i) ;
+	}
+
 } // namespace Rcpp