[Rcpp-commits] r1776 - pkg/Rcpp/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 4 15:23:24 CEST 2010
Author: edd
Date: 2010-07-04 15:23:24 +0200 (Sun, 04 Jul 2010)
New Revision: 1776
Modified:
pkg/Rcpp/inst/unitTests/runit.as.R
Log:
converted to 'one cxxfunction call of lists of sigs and bodies' scheme
Modified: pkg/Rcpp/inst/unitTests/runit.as.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.as.R 2010-07-04 08:05:29 UTC (rev 1775)
+++ pkg/Rcpp/inst/unitTests/runit.as.R 2010-07-04 13:23:24 UTC (rev 1776)
@@ -17,124 +17,163 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.setUp <- function() {
+ tests <- ".rcpp.as"
+ if( ! exists( tests, globalenv() )) {
+ ## definition of all the functions at once
+ f <- list("as_int"=list(
+ signature(x="numeric"),
+ 'int y = as<int>(x);
+ return wrap(y) ;')
+
+ ,"as_double"=list(
+ signature(x="numeric"),
+ 'double y = as<double>(x) ;
+ return wrap(y) ;')
+
+ ,"as_raw"=list(
+ signature(x="numeric"),
+ 'Rbyte y = as<Rbyte>(x) ;
+ return wrap(y) ;')
+
+ ,"as_bool"=list(
+ signature(x="numeric"),
+ 'bool y = as<bool>(x) ;
+ return wrap(y) ;')
+
+ ,"as_string"=list(
+ signature(x="character"),
+ 'std::string y = as<std::string>(x) ;
+ return wrap(y) ;')
+
+ ,"as_vector_int"=list(
+ signature(x="numeric"),
+ 'vector<int> y = as< vector<int> >(x) ;
+ return wrap(y) ;')
+
+ ,"as_vector_double"=list(
+ signature(x="numeric"),
+ 'vector<double> y = as< vector<double> >(x) ;
+ return wrap(y) ;')
+
+ ,"as_vector_raw"=list(
+ signature(x="numeric"),
+ 'vector<Rbyte> y = as< vector<Rbyte> >(x) ;
+ return wrap(y) ;')
+
+ ,"as_vector_bool"=list(
+ signature(x="numeric"),
+ 'vector<bool> y = as< vector<bool> >(x) ;
+ return wrap(y) ;')
+
+ ,"as_vector_string"=list(
+ signature(x="character"),
+ 'vector<string> y = as< vector<string> >(x) ;
+ return wrap(y) ;')
+
+ ,"as_deque_int"=list(
+ signature(x="integer"),
+ 'deque<int> y = as< deque<int> >(x) ;
+ return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;')
+
+ ,"as_list_int"=list(
+ signature(x="integer"),
+ 'list<int> y = as< list<int> >(x) ;
+ return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;')
+
+ )
+
+ signatures <- lapply(f, "[[", 1L)
+ bodies <- lapply(f, "[[", 2L)
+ fun <- cxxfunction( signatures, bodies, plugin = "Rcpp", includes = "using namespace std;")
+ getDynLib( fun ) # just forcing loading the dll now
+ assign( tests, fun, globalenv() )
+ }
+}
+
+
test.as.int <- function(){
- funx <- cppfunction(signature(x="numeric"), '
- int y = as<int>(x) ;
- return wrap(y) ;' )
- checkEquals( funx(10), 10L, msg = "as<int>( REALSXP ) " )
- checkEquals( funx(10L), 10L, msg = "as<int>( INTSXP ) " )
- checkEquals( funx(as.raw(10L)), 10L, msg = "as<int>( RAWSXP ) " )
- checkEquals( funx(TRUE), 1L, msg = "as<int>( LGLSXP ) " )
+ fun <- .rcpp.as$as_int
+ checkEquals( fun(10), 10L, msg = "as<int>( REALSXP ) " )
+ checkEquals( fun(10L), 10L, msg = "as<int>( INTSXP ) " )
+ checkEquals( fun(as.raw(10L)), 10L, msg = "as<int>( RAWSXP ) " )
+ checkEquals( fun(TRUE), 1L, msg = "as<int>( LGLSXP ) " )
}
test.as.double <- function(){
- funx <- cppfunction(signature(x="numeric"), '
- double y = as<double>(x) ;
- return wrap(y) ;
- ' )
- checkEquals( funx(10), 10.0, msg = "as<double>( REALSXP ) " )
- checkEquals( funx(10L), 10.0, msg = "as<double>( INTSXP ) " )
- checkEquals( funx(as.raw(10L)), 10.0, msg = "as<double>( RAWSXP ) " )
- checkEquals( funx(TRUE), 1.0, msg = "as<double>( LGLSXP ) " )
+ fun <- .rcpp.as$as_double
+ checkEquals( fun(10), 10.0, msg = "as<double>( REALSXP ) " )
+ checkEquals( fun(10L), 10.0, msg = "as<double>( INTSXP ) " )
+ checkEquals( fun(as.raw(10L)), 10.0, msg = "as<double>( RAWSXP ) " )
+ checkEquals( fun(TRUE), 1.0, msg = "as<double>( LGLSXP ) " )
}
test.as.raw <- function(){
- funx <- cppfunction(signature(x="numeric"), '
- Rbyte y = as<Rbyte>(x) ;
- return wrap(y) ;
- ' )
- checkEquals( funx(10), as.raw(10), msg = "as<Rbyte>( REALSXP ) " )
- checkEquals( funx(10L), as.raw(10), msg = "as<Rbyte>( INTSXP ) " )
- checkEquals( funx(as.raw(10L)), as.raw(10), msg = "as<Rbyte>( RAWSXP ) " )
- checkEquals( funx(TRUE), as.raw(1), msg = "as<Rbyte>( LGLSXP ) " )
+ fun <- .rcpp.as$as_raw
+ checkEquals( fun(10), as.raw(10), msg = "as<Rbyte>( REALSXP ) " )
+ checkEquals( fun(10L), as.raw(10), msg = "as<Rbyte>( INTSXP ) " )
+ checkEquals( fun(as.raw(10L)), as.raw(10), msg = "as<Rbyte>( RAWSXP ) " )
+ checkEquals( fun(TRUE), as.raw(1), msg = "as<Rbyte>( LGLSXP ) " )
}
test.as.bool <- function(){
- funx <- cppfunction(signature(x="numeric"), '
- bool y = as<bool>(x) ;
- return wrap(y) ;
- ' )
- checkEquals( funx(10), as.logical(10), msg = "as<bool>( REALSXP ) " )
- checkEquals( funx(10L), as.logical(10), msg = "as<bool>( INTSXP ) " )
- checkEquals( funx(as.raw(10L)), as.logical(10), msg = "as<bool>( RAWSXP ) " )
- checkEquals( funx(TRUE), as.logical(1), msg = "as<bool>( LGLSXP ) " )
+ fun <- .rcpp.as$as_bool
+ checkEquals( fun(10), as.logical(10), msg = "as<bool>( REALSXP ) " )
+ checkEquals( fun(10L), as.logical(10), msg = "as<bool>( INTSXP ) " )
+ checkEquals( fun(as.raw(10L)), as.logical(10), msg = "as<bool>( RAWSXP ) " )
+ checkEquals( fun(TRUE), as.logical(1), msg = "as<bool>( LGLSXP ) " )
}
test.as.string <- function(){
- funx <- cppfunction(signature(x="character"), '
- std::string y = as<std::string>(x) ;
- return wrap(y) ;
- ' )
- checkEquals( funx("foo"), "foo", msg = "as<string>( STRSXP ) " )
+ fun <- .rcpp.as$as_string
+ checkEquals( fun("foo"), "foo", msg = "as<string>( STRSXP ) " )
}
test.as.vector.int <- function(){
- funx <- cppfunction(signature(x="numeric"), '
- vector<int> y = as< vector<int> >(x) ;
- return wrap(y) ;
- ', includes = "using namespace std;" )
- checkEquals( funx(1:10), 1:10 , msg = "as<vector<int>>( INTSXP ) " )
- checkEquals( funx(as.numeric(1:10)), 1:10 , msg = "as<vector<int>>( REALSXP ) " )
- checkEquals( funx(as.raw(1:10)), 1:10 , msg = "as<vector<int>>( RAWSXP ) " )
- checkEquals( funx(c(TRUE,FALSE)), 1:0 , msg = "as<vector<int>>( LGLSXP ) " )
+ fun <- .rcpp.as$as_vector_int
+ checkEquals( fun(1:10), 1:10 , msg = "as<vector<int>>( INTSXP ) " )
+ checkEquals( fun(as.numeric(1:10)), 1:10 , msg = "as<vector<int>>( REALSXP ) " )
+ checkEquals( fun(as.raw(1:10)), 1:10 , msg = "as<vector<int>>( RAWSXP ) " )
+ checkEquals( fun(c(TRUE,FALSE)), 1:0 , msg = "as<vector<int>>( LGLSXP ) " )
}
test.as.vector.double <- function(){
- funx <- cppfunction(signature(x="numeric"), '
- vector<double> y = as< vector<double> >(x) ;
- return wrap(y) ;
- ', includes = "using namespace std;" )
- checkEquals( funx(1:10), as.numeric(1:10) , msg = "as<vector<double>>( INTSXP ) " )
- checkEquals( funx(as.numeric(1:10)), as.numeric(1:10) , msg = "as<vector<double>>( REALSXP ) " )
- checkEquals( funx(as.raw(1:10)), as.numeric(1:10), msg = "as<vector<double>>( RAWSXP ) " )
- checkEquals( funx(c(TRUE,FALSE)), c(1.0, 0.0) , msg = "as<vector<double>>( LGLSXP ) " )
+ fun <- .rcpp.as$as_vector_double
+ checkEquals( fun(1:10), as.numeric(1:10) , msg = "as<vector<double>>( INTSXP ) " )
+ checkEquals( fun(as.numeric(1:10)), as.numeric(1:10) , msg = "as<vector<double>>( REALSXP ) " )
+ checkEquals( fun(as.raw(1:10)), as.numeric(1:10), msg = "as<vector<double>>( RAWSXP ) " )
+ checkEquals( fun(c(TRUE,FALSE)), c(1.0, 0.0) , msg = "as<vector<double>>( LGLSXP ) " )
}
test.as.vector.raw <- function(){
- funx <- cppfunction(signature(x="numeric"), '
- vector<Rbyte> y = as< vector<Rbyte> >(x) ;
- return wrap(y) ;
- ', includes = "using namespace std;" )
- checkEquals( funx(1:10), as.raw(1:10) , msg = "as<vector<Rbyte>>( INTSXP ) " )
- checkEquals( funx(as.numeric(1:10)), as.raw(1:10) , msg = "as<vector<Rbyte>>( REALSXP ) " )
- checkEquals( funx(as.raw(1:10)), as.raw(1:10) , msg = "as<vector<Rbyte>>( RAWSXP ) " )
- checkEquals( funx(c(TRUE,FALSE)), as.raw(1:0) , msg = "as<vector<Rbyte>>( LGLSXP ) " )
+ fun <- .rcpp.as$as_vector_raw
+ checkEquals( fun(1:10), as.raw(1:10) , msg = "as<vector<Rbyte>>( INTSXP ) " )
+ checkEquals( fun(as.numeric(1:10)), as.raw(1:10) , msg = "as<vector<Rbyte>>( REALSXP ) " )
+ checkEquals( fun(as.raw(1:10)), as.raw(1:10) , msg = "as<vector<Rbyte>>( RAWSXP ) " )
+ checkEquals( fun(c(TRUE,FALSE)), as.raw(1:0) , msg = "as<vector<Rbyte>>( LGLSXP ) " )
}
test.as.vector.bool <- function(){
- funx <- cppfunction(signature(x="numeric"), '
- vector<bool> y = as< vector<bool> >(x) ;
- return wrap(y) ;
- ', includes = "using namespace std;" )
- checkEquals( funx(0:10), as.logical(0:10) , msg = "as<vector<bool>>( INTSXP ) " )
- checkEquals( funx(as.numeric(0:10)), as.logical(0:10) , msg = "as<vector<bool>>( REALSXP ) " )
- checkEquals( funx(as.raw(0:10)), as.logical(0:10) , msg = "as<vector<bool>>( RAWSXP ) " )
- checkEquals( funx(c(TRUE,FALSE)), as.logical(1:0) , msg = "as<vector<bool>>( LGLSXP ) " )
+ fun <- .rcpp.as$as_vector_bool
+ checkEquals( fun(0:10), as.logical(0:10) , msg = "as<vector<bool>>( INTSXP ) " )
+ checkEquals( fun(as.numeric(0:10)), as.logical(0:10) , msg = "as<vector<bool>>( REALSXP ) " )
+ checkEquals( fun(as.raw(0:10)), as.logical(0:10) , msg = "as<vector<bool>>( RAWSXP ) " )
+ checkEquals( fun(c(TRUE,FALSE)), as.logical(1:0) , msg = "as<vector<bool>>( LGLSXP ) " )
}
-test.as.vector.bool <- function(){
- funx <- cppfunction(signature(x="character"), '
- vector<string> y = as< vector<string> >(x) ;
- return wrap(y) ;
- ', includes = "using namespace std;" )
- checkEquals( funx(letters), letters , msg = "as<vector<string>>( STRSXP ) " )
-
+test.as.vector.string <- function(){
+ fun <- .rcpp.as$as_vector_string
+ checkEquals( fun(letters), letters , msg = "as<vector<string>>( STRSXP ) " )
}
test.as.deque.int <- function(){
- funx <- cppfunction(signature(x="integer"), '
- deque<int> y = as< deque<int> >(x) ;
- return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;
- ', includes = "using namespace std;" )
- checkEquals( funx(1:10), sum(1:10) , msg = "as<deque<int>>( INTSXP ) " )
+ fun <- .rcpp.as$as_deque_int
+ checkEquals( fun(1:10), sum(1:10) , msg = "as<deque<int>>( INTSXP ) " )
}
test.as.list.int <- function(){
- funx <- cppfunction(signature(x="integer"), '
- list<int> y = as< list<int> >(x) ;
- return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;
- ', includes = "using namespace std;" )
- checkEquals( funx(1:10), sum(1:10) , msg = "as<list<int>>( INTSXP ) " )
+ fun <- .rcpp.as$as_list_int
+ checkEquals( fun(1:10), sum(1:10) , msg = "as<list<int>>( INTSXP ) " )
}
More information about the Rcpp-commits
mailing list