[Rcpp-commits] r1770 - pkg/Rcpp/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jul 3 22:33:28 CEST 2010
Author: edd
Date: 2010-07-03 22:33:27 +0200 (Sat, 03 Jul 2010)
New Revision: 1770
Modified:
pkg/Rcpp/inst/unitTests/runit.Date.R
pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R
Log:
converted to 'one cxxfunction call of lists of sigs and bodies' scheme
Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R 2010-07-03 17:27:58 UTC (rev 1769)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R 2010-07-03 20:33:27 UTC (rev 1770)
@@ -1,6 +1,6 @@
#!/usr/bin/r -t
#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -17,10 +17,84 @@
# 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() {
+ if( ! exists( ".rcpp.Date", globalenv() )) {
+ ## definition of all the functions at once
+ f <- list("ctor_sexp"=list(
+ signature(d="Date"),
+ 'Date dt = Date(d);
+ return wrap(dt);')
+
+ ,"ctor_mdy"=list(
+ signature(),
+ 'Date dt = Date(12,31,2005);
+ return wrap(dt);')
+
+ ,"ctor_ymd"=list(
+ signature(),
+ 'Date dt = Date(2005,12,31);
+ return wrap(dt);')
+
+ ,"ctor_int"=list(
+ signature(d="numeric"),
+ 'Date dt = Date(Rcpp::as<int>(d));
+ return wrap(dt);')
+
+ ,"operators"=list(
+ signature(),
+ 'Date d1 = Date(2005,12,31);
+ Date d2 = d1 + 1;
+ return List::create(Named("diff") = d2 - d1,
+ Named("bigger") = d2 > d1,
+ Named("smaller") = d2 < d1,
+ Named("equal") = d2 == d1,
+ Named("ge") = d2 >= d1,
+ Named("le") = d2 <= d1,
+ Named("ne") = d2 != d1);')
+
+ ,"components"=list(
+ signature(),
+ 'Date d = Date(2005,12,31);
+ return List::create(Named("day") = d.getDay(),
+ Named("month") = d.getMonth(),
+ Named("year") = d.getYear(),
+ Named("weekday") = d.getWeekday(),
+ Named("yearday") = d.getYearday());')
+
+ ,"vector_Date"=list(
+ signature(),
+ 'std::vector<Date> v(2) ;
+ v[0] = Date(2005,12,31) ;
+ v[1] = Date(12,31,2005) ;
+ return wrap( v );')
+
+ ,"Datevector_wrap"=list(
+ signature(),
+ 'DateVector v(2) ;
+ v[0] = Date(2005,12,31) ;
+ v[1] = Date(12,31,2005) ;
+ return wrap( v );')
+
+ ,"operator_sexp"=list(
+ signature(),
+ 'DateVector v(2) ;
+ v[0] = Date(2005,12,31) ;
+ v[1] = Date(12,31,2005) ;
+ return wrap( v );')
+
+ )
+
+ signatures <- lapply(f, "[[", 1L)
+ bodies <- lapply(f, "[[", 2L)
+ fun <- cxxfunction( signatures, bodies, plugin = "Rcpp")
+ getDynLib( fun ) # just forcing loading the dll now
+ assign( ".rcpp.Date", fun, globalenv() )
+ }
+}
+
+
test.Date.ctor.sexp <- function() {
- src <- 'Date dt = Date(d);
- return wrap(dt);'
- fun <- cxxfunction(signature(d="Date"), src, plugin = "Rcpp" )
+ fun <- .rcpp.Date$ctor_sexp
d <- as.Date("2005-12-31"); checkEquals(fun(d), d, msg = "Date.ctor.sexp.1")
d <- as.Date("1970-01-01"); checkEquals(fun(d), d, msg = "Date.ctor.sexp.2")
d <- as.Date("1969-12-31"); checkEquals(fun(d), d, msg = "Date.ctor.sexp.3")
@@ -29,23 +103,17 @@
}
test.Date.ctor.mdy <- function() {
- src <- 'Date dt = Date(12,31,2005);
- return wrap(dt);'
- fun <- cxxfunction(signature(), src, plugin = "Rcpp" )
+ fun <- .rcpp.Date$ctor_mdy
checkEquals(fun(), as.Date("2005-12-31"), msg = "Date.ctor.mdy")
}
test.Date.ctor.ymd <- function() {
- src <- 'Date dt = Date(2005,12,31);
- return wrap(dt);'
- fun <- cxxfunction(signature(), src, plugin = "Rcpp" )
+ fun <- .rcpp.Date$ctor_ymd
checkEquals(fun(), as.Date("2005-12-31"), msg = "Date.ctor.ymd")
}
test.Date.ctor.int <- function() {
- src <- 'Date dt = Date(Rcpp::as<int>(d));
- return wrap(dt);'
- fun <- cxxfunction(signature(d="numeric"), src, plugin = "Rcpp")
+ fun <- .rcpp.Date$ctor_int
d <- as.Date("2005-12-31")
checkEquals(fun(as.numeric(d)), d, msg = "Date.ctor.int")
checkEquals(fun(-1), as.Date("1970-01-01")-1, msg = "Date.ctor.int")
@@ -53,61 +121,31 @@
}
test.Date.operators <- function() {
- src <- 'Date d1 = Date(2005,12,31);
- Date d2 = d1 + 1;
- return List::create(Named("diff") = d2 - d1,
- Named("bigger") = d2 > d1,
- Named("smaller") = d2 < d1,
- Named("equal") = d2 == d1,
- Named("ge") = d2 >= d1,
- Named("le") = d2 <= d1,
- Named("ne") = d2 != d1);'
- fun <- cxxfunction(signature(), src, plugin="Rcpp")
+ fun <- .rcpp.Date$operators
checkEquals(fun(),
list(diff=-1, bigger=TRUE, smaller=FALSE, equal=FALSE, ge=TRUE, le=FALSE, ne=TRUE),
msg = "Date.operators")
}
test.Date.components <- function() {
- src <- 'Date d = Date(2005,12,31);
- return List::create(Named("day") = d.getDay(),
- Named("month") = d.getMonth(),
- Named("year") = d.getYear(),
- Named("weekday") = d.getWeekday(),
- Named("yearday") = d.getYearday());'
- fun <- cxxfunction(signature(), src, plugin="Rcpp")
+ fun <- .rcpp.Date$components
checkEquals(fun(),
list(day=31, month=12, year=2005, weekday=7, yearday=365),
msg = "Date.components")
}
test.vector.Date <- function(){
- fx <- cxxfunction( , '
- std::vector<Date> v(2) ;
- v[0] = Date(2005,12,31) ;
- v[1] = Date(12,31,2005) ;
- return wrap( v ) ;
- ', plugin = "Rcpp" )
- checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "Date.vector.wrap")
+ fun <- .rcpp.Date$vector_Date
+ checkEquals(fun(), rep(as.Date("2005-12-31"),2), msg = "Date.vector.wrap")
}
test.DateVector.wrap <- function(){
- fx <- cxxfunction( , '
- DateVector v(2) ;
- v[0] = Date(2005,12,31) ;
- v[1] = Date(12,31,2005) ;
- return wrap( v ) ;
- ', plugin = "Rcpp" )
- checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "DateVector.wrap")
+ fun <- .rcpp.Date$Datevector_wrap
+ checkEquals(fun(), rep(as.Date("2005-12-31"),2), msg = "DateVector.wrap")
}
test.DateVector.operator.SEXP <- function(){
- fx <- cxxfunction( , '
- DateVector v(2) ;
- v[0] = Date(2005,12,31) ;
- v[1] = Date(12,31,2005) ;
- return wrap(v) ;
- ', plugin = "Rcpp" )
- checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "DateVector.SEXP")
+ fun <- .rcpp.Date$operator_sexp
+ checkEquals(fun(), rep(as.Date("2005-12-31"),2), msg = "DateVector.SEXP")
}
Modified: pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R 2010-07-03 17:27:58 UTC (rev 1769)
+++ pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R 2010-07-03 20:33:27 UTC (rev 1770)
@@ -25,186 +25,186 @@
'double y = 1.23456;
RcppResultSet rs;
rs.add("foo", y);
- return rs.getReturnList();'),
+ return rs.getReturnList();'),
"int_"=list(
signature(),
'int y = 42;
RcppResultSet rs;
rs.add("foo", y);
- return rs.getReturnList();'),
+ return rs.getReturnList();'),
"string_"=list(
signature(),
'std::string y = "hello unit tests";
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"double_vector"=list(
signature(),
'double y[3] = { 1.1, 2.2, 3.3 };
- RcppResultSet rs;
- rs.add("foo", y, 3);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y, 3);
+ return rs.getReturnList();'),
"int_vector"=list(
signature(),
'int y[3] = { 11, 22, 33 };
- RcppResultSet rs;
- rs.add("foo", y, 3);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y, 3);
+ return rs.getReturnList();'),
"double_matrix"=list(
signature(),
'double r1[2] = { 1.1, 2.2 };
- double r2[2] = { 3.3, 4.4 };
- double *y[2] = { r1, r2 };
- RcppResultSet rs;
- rs.add("foo", y, 2, 2);
- return rs.getReturnList();'),
+ double r2[2] = { 3.3, 4.4 };
+ double *y[2] = { r1, r2 };
+ RcppResultSet rs;
+ rs.add("foo", y, 2, 2);
+ return rs.getReturnList();'),
"int_matrix"=list(
signature(),
'int r1[2] = { 11, 22 };
- int r2[2] = { 33, 44 };
- int *y[2] = { r1, r2 };
- RcppResultSet rs;
- rs.add("foo", y, 2, 2);
- return rs.getReturnList();'),
+ int r2[2] = { 33, 44 };
+ int *y[2] = { r1, r2 };
+ RcppResultSet rs;
+ rs.add("foo", y, 2, 2);
+ return rs.getReturnList();'),
"RcppDate_"=list(
signature(),
'RcppDate y(01,01,2000); // silly North American mon-day-year
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppDateVector_"=list(
signature(x="any"),
'RcppDateVector y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppDatetime_"=list(
signature(x="any"),
'RcppDatetime y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppDatetimeVector_"=list(
signature(x="POSIXct"),
'RcppDatetimeVector y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppStringVector_"=list(
signature(x="character"),
'RcppStringVector y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"std_vector_double"=list(
signature(),
'std::vector<double> y;
- y.push_back(1.1);
- y.push_back(2.2);
- y.push_back(3.3);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ y.push_back(1.1);
+ y.push_back(2.2);
+ y.push_back(3.3);
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"std_vector_int"=list(
signature(),
'std::vector<int> y;
- y.push_back(11);
- y.push_back(22);
- y.push_back(33);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ y.push_back(11);
+ y.push_back(22);
+ y.push_back(33);
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"std_vector_std_vector_double"=list(
signature(),
'std::vector<double> yy;
- yy.push_back(1.1);
- yy.push_back(2.2);
- yy.push_back(3.3);
- std::vector< std::vector<double> > y;
- y.push_back(yy);
- y.push_back(yy);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ yy.push_back(1.1);
+ yy.push_back(2.2);
+ yy.push_back(3.3);
+ std::vector< std::vector<double> > y;
+ y.push_back(yy);
+ y.push_back(yy);
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"std_vector_std_vector_int"=list(
signature(),
'std::vector<int> yy;
- yy.push_back(11);
- yy.push_back(22);
- yy.push_back(33);
- std::vector< std::vector<int> > y;
- y.push_back(yy);
- y.push_back(yy);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ yy.push_back(11);
+ yy.push_back(22);
+ yy.push_back(33);
+ std::vector< std::vector<int> > y;
+ y.push_back(yy);
+ y.push_back(yy);
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"std_vector_std_vector_string"=list(
signature(),
'std::string a("hello");
- std::string b("goodbye");
- std::vector< std::string > y;
- y.push_back(a);
- y.push_back(b);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ std::string b("goodbye");
+ std::vector< std::string > y;
+ y.push_back(a);
+ y.push_back(b);
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppVector_int"=list(
signature(x="integer"),
'RcppVector<int> y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppVector_double"=list(
signature(x="double"),
'RcppVector<double> y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppMatrix_int"=list(
signature(x="integer"),
'RcppMatrix<int> y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppMatrix_double"=list(
signature(x="double"),
'RcppMatrix<double> y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
"RcppFrame_"=list(
signature(x="any"),
'RcppFrame y(x);
- RcppResultSet rs;
- rs.add("", y);
- return rs.getReturnList();'),
+ RcppResultSet rs;
+ rs.add("", y);
+ return rs.getReturnList();'),
"SEXP_"=list(
signature(x="any"),
'RcppResultSet rs;
- rs.add("", x, false);
- return rs.getReturnList();')
+ rs.add("", x, false);
+ return rs.getReturnList();')
)
More information about the Rcpp-commits
mailing list