[Rcpp-devel] [Rcpp-commits] r232 - pkg/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 30 14:15:08 CET 2009
Author: romain
Date: 2009-12-30 14:15:08 +0100 (Wed, 30 Dec 2009)
New Revision: 232
Modified:
pkg/inst/unitTests/runit.RObject.R
pkg/inst/unitTests/runit.XPTr.R
Log:
complete reformatting of RSexpTests as unit tests
Modified: pkg/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/inst/unitTests/runit.RObject.R 2009-12-30 11:03:17 UTC (rev 231)
+++ pkg/inst/unitTests/runit.RObject.R 2009-12-30 13:15:08 UTC (rev 232)
@@ -19,6 +19,8 @@
.setUp <- function(){
suppressMessages( require( inline ) )
+ suppressMessages( require( datasets ) )
+ data( iris )
}
test.RObject.asDouble <- function(){
@@ -109,5 +111,183 @@
checkException( funx(raw(0)), msg = "RObject.asBool(0 raw) -> exception" )
}
+test.RObject.asStdVectorIntResultsSet <- function(){
+ foo <- '
+ std::vector<int> iv = Rcpp::RObject(x).asStdVectorInt();
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ RcppResultSet rs;
+ rs.add("", iv);
+ return(rs.getSEXP());'
+ funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+ checkEquals( funx(x=2:5), 2:5*2L, msg = "RObject(integer).asStdVectorInt via RcppResultSet" )
+ checkEquals( funx(x=2:5+.1), 2:5*2L, msg = "RObject(numeric).asStdVectorInt via RcppResultSet" )
+ checkEquals( funx(x=as.raw(2:5)), 2:5*2L, msg = "RObject(raw).asStdVectorInt via RcppResultSet" )
+ checkException( funx("foo"), msg = "RObject(character).asStdVectorInt -> exception" )
+
+}
+test.RObject.asStdVectorInt <- function(){
+ foo <- '
+ std::vector<int> iv = Rcpp::RObject(x).asStdVectorInt();
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ return(Rcpp::RObject( iv ) );'
+ funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+ checkEquals( funx(x=2:5), 2:5*2L, msg = "RObject(integer).asStdVectorInt" )
+ checkEquals( funx(x=2:5+.1), 2:5*2L, msg = "RObject(numeric).asStdVectorInt" )
+ checkEquals( funx(x=as.raw(2:5)), 2:5*2L, msg = "RObject(raw).asStdVectorInt" )
+ checkException( funx("foo"), msg = "RObject(character).asStdVectorInt -> exception" )
+ checkException( funx(NULL), msg = "RObject(NULL).asStdVectorInt -> exception" )
+
+}
+test.RObject.asStdVectorDouble <- function(){
+ foo <- '
+ std::vector<double> iv = Rcpp::RObject(x).asStdVectorDouble();
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ return(Rcpp::RObject( iv ));'
+ funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+ checkEquals( funx(x=0.1+2:5), 2*(0.1+2:5), msg = "RObject(numeric).asStdVectorDouble" )
+ checkEquals( funx(x=2:5), 2*(2:5), msg = "RObject(integer).asStdVectorDouble" )
+ checkEquals( funx(x=as.raw(2:5)), 2*(2:5), msg = "RObject(raw).asStdVectorDouble" )
+ checkException( funx("foo"), msg = "RObject(character).asStdVectorDouble -> exception" )
+ checkException( funx(NULL), msg = "RObject(NULL).asStdVectorDouble -> exception" )
+
+}
+
+test.RObject.asStdVectorRaw <- function(){
+ foo <- '
+ std::vector<Rbyte> iv = Rcpp::RObject(x).asStdVectorRaw();
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ return(Rcpp::RObject( iv ));'
+ funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+ checkEquals( funx(x=as.raw(0:9)), as.raw(2*(0:9)), msg = "RObject(raw).asStdVectorRaw" )
+ checkEquals( funx(x=0:9), as.raw(2*(0:9)), msg = "RObject(integer).asStdVectorRaw" )
+ checkEquals( funx(x=as.numeric(0:9)), as.raw(2*(0:9)), msg = "RObject(numeric).asStdVectorRaw" )
+ checkException( funx("foo"), msg = "RObject(character).asStdVectorRaw -> exception" )
+ checkException( funx(NULL), msg = "RObject(NULL).asStdVectorRaw -> exception" )
+
+}
+
+test.RObject.asStdVectorBool <- function(){
+ foo <- '
+ std::vector<bool> bv = Rcpp::RObject(x).asStdVectorBool();
+ for (size_t i=0; i<bv.size(); i++) {
+ bv[i].flip() ;
+ }
+ return(Rcpp::RObject( bv ));'
+ funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
+ checkEquals( funx(x=c(TRUE,FALSE)), c(FALSE, TRUE), msg = "RObject(logical).asStdVectorBool" )
+ checkEquals( funx(x=c(1L, 0L)), c(FALSE, TRUE), msg = "RObject(integer).asStdVectorBool" )
+ checkEquals( funx(x=c(1.0, 0.0)), c(FALSE, TRUE), msg = "RObject(numeric).asStdVectorBool" )
+ checkEquals( funx(x=as.raw(c(1,0))), c(FALSE, TRUE), msg = "RObject(raw).asStdVectorBool" )
+ checkException( funx("foo"), msg = "RObject(character).asStdVectorBool -> exception" )
+ checkException( funx(NULL), msg = "RObject(NULL).asStdVectorBool -> exception" )
+}
+
+test.RObject.asStdVectorString <- function(){
+ foo <- '
+ std::vector<std::string> iv = Rcpp::RObject(x).asStdVectorString();
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = iv[i] + iv[i];
+ }
+ return(Rcpp::RObject( iv ));'
+ funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
+ checkEquals( funx(c("foo", "bar")), c("foofoo", "barbar"), msg = "RObject(character).asStdVectorString" )
+ checkException( funx(1L), msg = "RObject(integer).asStdVectorString -> exception" )
+ checkException( funx(1.0), msg = "RObject(numeric).asStdVectorString -> exception" )
+ checkException( funx(as.raw(1)), msg = "RObject(raw).asStdVectorString -> exception" )
+ checkException( funx(TRUE), msg = "RObject(logical).asStdVectorString -> exception" )
+ checkException( funx(NULL), msg = "RObject(NULL).asStdVectorString -> exception" )
+}
+
+test.RObject.stdsetint <- function(){
+ foo <- '
+ std::set<int> iv ;
+ iv.insert( 0 ) ;
+ iv.insert( 1 ) ;
+ iv.insert( 0 ) ;
+ return Rcpp::RObject( iv );'
+ funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>" )
+ checkEquals( funx(), c(0L, 1L), msg = "RObject( set<int> )" )
+}
+
+test.RObject.stdsetdouble <- function(){
+ foo <- '
+ std::set<double> ds;
+ ds.insert( 0.0 );
+ ds.insert( 1.0 );
+ ds.insert( 0.0 );
+ return(Rcpp::RObject( ds )); '
+ funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>")
+ checkEquals( funx(), as.numeric(0:1), msg = "RObject( set<double>" )
+}
+
+test.RObject.stdsetraw <- function(){
+ foo <- '
+ std::set<Rbyte> bs ;
+ bs.insert( (Rbyte)0 ) ;
+ bs.insert( (Rbyte)1 ) ;
+ bs.insert( (Rbyte)0 ) ;
+ return(Rcpp::RObject( bs )); '
+ funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>")
+ checkEquals( funx(), as.raw(0:1), msg = "RObject(set<raw>)" )
+}
+
+test.RObject.stdsetstring <- function(){
+ foo <- '
+ std::set<std::string> ss ;
+ ss.insert( "foo" ) ;
+ ss.insert( "bar" ) ;
+ ss.insert( "foo" ) ;
+ return(Rcpp::RObject( ss )); '
+ funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, include = "#include <set>" )
+ checkEquals( funx(), c("bar", "foo"), msg = "RObject(set<string>)" )
+}
+
+test.RObject.attributeNames <- function(){
+ funx <- cfunction(signature(x="data.frame"), '
+ std::vector<std::string> iv = Rcpp::RObject(x).attributeNames();
+ return(Rcpp::RObject( iv ));',
+ Rcpp=TRUE, verbose=FALSE)
+ checkTrue( all( c("names","row.names","class") %in% funx(iris)), msg = "RObject.attributeNames" )
+}
+
+test.RObject.hasAttribute <- function(){
+ funx <- cfunction(signature(x="data.frame"), '
+ bool has_class = Rcpp::RObject(x).hasAttribute( "class" ) ;
+ return Rcpp::RObject( has_class ) ;',
+ Rcpp=TRUE, verbose=FALSE)
+ checkTrue( funx( iris ), msg = "RObject.hasAttribute" )
+}
+
+test.RObject.attr <- function(){
+ funx <- cfunction(signature(x="data.frame"), '
+ return Rcpp::RObject(x).attr( "row.names" ) ;
+ ', Rcpp=TRUE, verbose=FALSE)
+ checkEquals( funx( iris ), 1:150, msg = "RObject.attr" )
+}
+
+test.RObject.isNULL <- function(){
+ funx <- cfunction(signature(x="ANY"), '
+ bool is_null = Rcpp::RObject(x).isNULL() ;
+ return Rcpp::RObject( is_null ) ;
+ ', Rcpp=TRUE, verbose=FALSE)
+ checkTrue( !funx( iris ), msg = "RObject.isNULL(iris) -> false" )
+ checkTrue( funx(NULL), msg = "RObject.isNULL(NULL) -> true" )
+ checkTrue( !funx(1L), msg = "RObject.isNULL(integer) -> false" )
+ checkTrue( !funx(1.0), msg = "RObject.isNULL(numeric) -> false" )
+ checkTrue( !funx(as.raw(1)), msg = "RObject.isNULL(raw) -> false" )
+ checkTrue( !funx(letters), msg = "RObject.isNULL(character) -> false")
+ checkTrue( !funx(funx), msg = "RObject.isNULL(function) -> false" )
+ checkTrue( !funx(.GlobalEnv), msg = "RObject.isNULL(environment) -> false" )
+}
+
+
Modified: pkg/inst/unitTests/runit.XPTr.R
===================================================================
--- pkg/inst/unitTests/runit.XPTr.R 2009-12-30 11:03:17 UTC (rev 231)
+++ pkg/inst/unitTests/runit.XPTr.R 2009-12-30 13:15:08 UTC (rev 232)
@@ -59,7 +59,7 @@
', Rcpp=TRUE, verbose=FALSE)
front <- funx(xp)
checkEquals( front, 1L, msg = "check usage of external pointer" )
-Ma}
+}
# this is similar but without inline, the code is included in
# the dyn lib. One reason for this is to effectively instanciate one
_______________________________________________
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