[Rcpp-commits] r1768 - pkg/Rcpp/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jul 2 22:32:59 CEST 2010
Author: edd
Date: 2010-07-02 22:32:58 +0200 (Fri, 02 Jul 2010)
New Revision: 1768
Modified:
pkg/Rcpp/inst/unitTests/runit.RcppDate.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.RcppDate.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppDate.R 2010-07-02 18:42:41 UTC (rev 1767)
+++ pkg/Rcpp/inst/unitTests/runit.RcppDate.R 2010-07-02 20:32:58 UTC (rev 1768)
@@ -20,7 +20,6 @@
.setUp <- function() {
if( ! exists( ".rcpp.RcppDate", globalenv() )) {
## definition of all the functions at once
-
functions <- list("get_functions"=list(
signature(),
'RcppDate dt = RcppDate(12,31,1999);
Modified: pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R 2010-07-02 18:42:41 UTC (rev 1767)
+++ pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R 2010-07-02 20:32:58 UTC (rev 1768)
@@ -17,252 +17,334 @@
# 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.RcppResultSet", globalenv() )) {
+ ## definition of all the functions at once
+ f <- list("double_"=list(
+ signature(),
+ 'double y = 1.23456;
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
+
+ "int_"=list(
+ signature(),
+ 'int y = 42;
+ RcppResultSet rs;
+ rs.add("foo", y);
+ return rs.getReturnList();'),
+
+ "string_"=list(
+ signature(),
+ 'std::string y = "hello unit tests";
+ 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();'),
+
+ "int_vector"=list(
+ signature(),
+ 'int y[3] = { 11, 22, 33 };
+ 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();'),
+
+ "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();'),
+
+ "RcppDate_"=list(
+ signature(),
+ 'RcppDate y(01,01,2000); // silly North American mon-day-year
+ 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();'),
+
+ "RcppDatetime_"=list(
+ signature(x="any"),
+ 'RcppDatetime y(x);
+ 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();'),
+
+ "RcppStringVector_"=list(
+ signature(x="character"),
+ 'RcppStringVector y(x);
+ 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();'),
+
+ "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();'),
+
+ "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();'),
+
+ "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();'),
+
+ "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();'),
+
+ "RcppVector_int"=list(
+ signature(x="integer"),
+ 'RcppVector<int> y(x);
+ 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();'),
+
+ "RcppMatrix_int"=list(
+ signature(x="integer"),
+ 'RcppMatrix<int> y(x);
+ 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();'),
+
+ "RcppFrame_"=list(
+ signature(x="any"),
+ 'RcppFrame y(x);
+ RcppResultSet rs;
+ rs.add("", y);
+ return rs.getReturnList();'),
+
+ "SEXP_"=list(
+ signature(x="any"),
+ 'RcppResultSet rs;
+ rs.add("", x, false);
+ return rs.getReturnList();')
+
+ )
+
+ signatures <- lapply(f, "[[", 1L)
+ bodies <- lapply(f, "[[", 2L)
+ fun <- cxxfunction( signatures, bodies, plugin = "Rcpp")
+ getDynLib( fun ) # just forcing loading the dll now
+ assign( ".rcpp.RcppResultSet", fun, globalenv() )
+ }
+}
+
test.RcppResultSet.double <- function() {
- src <- 'double y = 1.23456;
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], 1.23456, msg = "RcppResultRet.double")
+ fun <- .rcpp.RcppResultSet$double_
+ checkEquals(fun()[[1]], 1.23456, msg = "RcppResultRet.double")
}
test.RcppResultSet.int <- function() {
- src <- 'int y = 42;
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], 42, msg = "RcppResultSet.int")
+ fun <- .rcpp.RcppResultSet$int_
+ checkEquals(fun()[[1]], 42, msg = "RcppResultSet.int")
}
test.RcppResultSet.string <- function() {
- src <- 'std::string y = "hello unit tests";
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], "hello unit tests", msg = "RcppResultSet.string")
+ fun <- .rcpp.RcppResultSet$string_
+ checkEquals(fun()[[1]], "hello unit tests", msg = "RcppResultSet.string")
}
test.RcppResultSet.double.vector <- function() {
- src <- 'double y[3] = { 1.1, 2.2, 3.3 };
- RcppResultSet rs;
- rs.add("foo", y, 3);
- return rs.getReturnList();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], c(1.1, 2.2, 3.3), msg = "RcppResultSet.double.vector")
+ fun <- .rcpp.RcppResultSet$double_vector
+ checkEquals(fun()[[1]], c(1.1, 2.2, 3.3), msg = "RcppResultSet.double.vector")
}
test.RcppResultSet.int.vector <- function() {
- src <- 'int y[3] = { 11, 22, 33 };
- RcppResultSet rs;
- rs.add("foo", y, 3);
- return rs.getReturnList();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], c(11, 22, 33), msg = "RcppResultSet.int.vector")
+ fun <- .rcpp.RcppResultSet$int_vector
+ checkEquals(fun()[[1]], c(11, 22, 33), msg = "RcppResultSet.int.vector")
}
test.RcppResultSet.double.matrix <- function() {
- src <- '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();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], matrix(c(1.1, 2.2, 3.3, 4.4), 2, byrow=TRUE), msg = "RcppResultSet.double.matrix")
+ fun <- .rcpp.RcppResultSet$double_matrix
+ checkEquals(fun()[[1]], matrix(c(1.1, 2.2, 3.3, 4.4), 2, byrow=TRUE), msg = "RcppResultSet.double.matrix")
}
test.RcppResultSet.int.matrix <- function() {
- src <- '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();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], matrix(c(11, 22, 33, 44), 2, byrow=TRUE), msg = "RcppResultSet.int.matrix")
+ fun <- .rcpp.RcppResultSet$int_matrix
+ checkEquals(fun()[[1]], matrix(c(11, 22, 33, 44), 2, byrow=TRUE), msg = "RcppResultSet.int.matrix")
}
test.RcppResultSet.RcppDate <- function() {
- src <- 'RcppDate y(01,01,2000); // silly North American mon-day-year
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], as.Date("2000-01-01"), msg = "RcppResultSet.RcppDate")
+ fun <- .rcpp.RcppResultSet$RcppDate_
+ checkEquals(fun()[[1]], as.Date("2000-01-01"), msg = "RcppResultSet.RcppDate")
}
test.RcppResultSet.RcppDateVector <- function() {
- src <- 'RcppDateVector y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="ANY"), src)
+ fun <- .rcpp.RcppResultSet$RcppDateVector_
v <- c(as.Date("2000-01-01"), as.Date("2001-01-01"))
- checkEquals(funx(v)[[1]], v, msg = "RcppResultSet.RcppDateVector")
+ checkEquals(fun(v)[[1]], v, msg = "RcppResultSet.RcppDateVector")
}
test.RcppResultSet.RcppDatetime <- function() {
- src <- 'RcppDatetime y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="numeric"), src)
- # setting tz = "UTC" because otherwise the format gets set as the tz
- posixt <- as.POSIXct("2000-01-01 01:02:03.456", "%Y-%m-%d %H:%M:%OS", tz = "UTC" )
- result <- funx(as.numeric(posixt))[[1]]
- # RcppDateTime discards the timezone, so we have to set it back
- # otherwise the comparison fails on the attributes
- attr( result, "tzone") <- "UTC"
- checkTrue( (result - posixt) == 0.0 , msg = "RcppResultSet.RcppDatetime")
+ fun <- .rcpp.RcppResultSet$RcppDatetime_
+ ## setting tz = "UTC" because otherwise the format gets set as the tz
+ posixt <- as.POSIXct("2000-01-01 01:02:03.456", "%Y-%m-%d %H:%M:%OS", tz = "UTC" )
+ result <- fun(as.numeric(posixt))[[1]]
+ ## RcppDateTime discards the timezone, so we have to set it back
+ ## otherwise the comparison fails on the attributes
+ attr( result, "tzone") <- "UTC"
+ checkTrue( (result - posixt) == 0.0 , msg = "RcppResultSet.RcppDatetime")
}
test.RcppResultSet.RcppDatetimeVector <- function() {
- src <- 'RcppDatetimeVector y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="ANY"), src)
+ fun <- .rcpp.RcppResultSet$RcppDatetimeVector_
now <- Sys.time()
attr(now, "tzone") <- NULL # no attribute gets set at the C++ level
v <- now + 0:9
- checkTrue( sum( funx(v)[[1]] - v ) == 0.0 , msg = "RcppResultSet.RcppDatetimeVector")
+ checkTrue( sum( fun(v)[[1]] - v ) == 0.0 , msg = "RcppResultSet.RcppDatetimeVector")
}
test.RcppResultSet.RcppStringVector <- function() {
- src <- 'RcppStringVector y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="ANY"), src)
+ fun <- .rcpp.RcppResultSet$RcppStringVector_
v <- c("hello", "goodbye")
- checkEquals(funx(v)[[1]], v, msg = "RcppResultSet.RcppStringVector")
+ checkEquals(fun(v)[[1]], v, msg = "RcppResultSet.RcppStringVector")
}
test.RcppResultSet.std.vector.double <- function() {
- src <- '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();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], c(1.1, 2.2, 3.3), msg = "RcppResultSet.std.vector.double")
+ fun <- .rcpp.RcppResultSet$std_vector_double
+ checkEquals(fun()[[1]], c(1.1, 2.2, 3.3), msg = "RcppResultSet.std.vector.double")
}
test.RcppResultSet.std.vector.int <- function() {
- src <- '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();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], c(11, 22, 33), msg = "RcppResultSet.std.vector.int")
+ fun <- .rcpp.RcppResultSet$std_vector_int
+ checkEquals(fun()[[1]], c(11, 22, 33), msg = "RcppResultSet.std.vector.int")
}
test.RcppResultSet.std.vector.std.vector.double <- function() {
- src <- '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();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], matrix(c(1.1, 2.2, 3.3, 1.1, 2.2, 3.3), nrow=2, ncol=3, byrow=TRUE), msg = "RcppResultSet.std.vector.std.vector.double")
+ fun <- .rcpp.RcppResultSet$std_vector_std_vector_double
+ checkEquals(fun()[[1]], matrix(c(1.1, 2.2, 3.3, 1.1, 2.2, 3.3), nrow=2, ncol=3, byrow=TRUE), msg = "RcppResultSet.std.vector.std.vector.double")
}
test.RcppResultSet.std.vector.std.vector.int <- function() {
- src <- '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();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], matrix(c(11, 22, 33, 11, 22, 33), nrow=2, ncol=3, byrow=TRUE), msg = "RcppResultSet.std.vector.std.vector.int")
+ fun <- .rcpp.RcppResultSet$std_vector_std_vector_int
+ checkEquals(fun()[[1]], matrix(c(11, 22, 33, 11, 22, 33), nrow=2, ncol=3, byrow=TRUE), msg = "RcppResultSet.std.vector.std.vector.int")
}
-test.RcppResultSet.std.vector.std.vector.int <- function() {
- src <- '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();';
- funx <- cppfunction(signature(), src)
- checkEquals(funx()[[1]], c("hello", "goodbye"), msg = "RcppResultSet.std.vector.std.string")
+test.RcppResultSet.std.vector.std.vector.string <- function() {
+ fun <- .rcpp.RcppResultSet$std_vector_std_vector_string
+ checkEquals(fun()[[1]], c("hello", "goodbye"), msg = "RcppResultSet.std.vector.std.string")
}
test.RcppResultSet.RcppVector.int <- function() {
- src <- 'RcppVector<int> y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="integer"), src)
+ fun <- .rcpp.RcppResultSet$RcppVector_int
x <- c(11,22,33)
- checkEquals(funx(x)[[1]], x, msg = "RcppResultSet.RcppVector.int")
+ checkEquals(fun(x)[[1]], x, msg = "RcppResultSet.RcppVector.int")
}
test.RcppResultSet.RcppVector.double <- function() {
- src <- 'RcppVector<double> y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="double"), src)
+ fun <- .rcpp.RcppResultSet$RcppVector_double
x <- c(1.1,2.2,3.3)
- checkEquals(funx(x)[[1]], x, msg = "RcppResultSet.RcppVector.double")
+ checkEquals(fun(x)[[1]], x, msg = "RcppResultSet.RcppVector.double")
}
test.RcppResultSet.RcppMatrix.int <- function() {
- src <- 'RcppMatrix<int> y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="integer"), src)
+ fun <- .rcpp.RcppResultSet$RcppMatrix_int
x <- matrix(1:9, 3, 3)
- checkEquals(funx(x)[[1]], x, msg = "RcppResultSet.RcppMatrix.int")
+ checkEquals(fun(x)[[1]], x, msg = "RcppResultSet.RcppMatrix.int")
}
test.RcppResultSet.RcppMatrix.double <- function() {
- src <- 'RcppMatrix<double> y(x);
- RcppResultSet rs;
- rs.add("foo", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="double"), src)
+ fun <- .rcpp.RcppResultSet$RcppMatrix_double
x <- matrix(1.1*c(1:9), 3, 3)
- checkEquals(funx(x)[[1]], x, msg = "RcppResultSet.RcppMatrix.double")
+ checkEquals(fun(x)[[1]], x, msg = "RcppResultSet.RcppMatrix.double")
}
test.RcppResultSet.RcppFrame <- function() {
- src <- 'RcppFrame y(x);
- RcppResultSet rs;
- rs.add("", y);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="ANY"), src)
+ fun <- .rcpp.RcppResultSet$RcppFrame_
x <- data.frame(x=1:9, y=LETTERS[1:9], z=sample(c(TRUE,FALSE), 9, replace=TRUE))
- checkEquals( as.data.frame(funx(x)[[1]]), x, msg = "RcppResultSet.RcppFrame")
+ checkEquals( as.data.frame(fun(x)[[1]]), x, msg = "RcppResultSet.RcppFrame")
}
test.RcppResultSet.SEXP <- function() {
- src <- 'RcppResultSet rs;
- rs.add("", x, false);
- return rs.getReturnList();';
- funx <- cppfunction(signature(x="ANY"), src)
+ fun <- .rcpp.RcppResultSet$SEXP_
x <- list(foo=1.23, bar=123, glim="glom")
- checkEquals( funx(x)[[1]], x, msg = "RcppResultSet.SEXP")
+ checkEquals( fun(x)[[1]], x, msg = "RcppResultSet.SEXP")
}
More information about the Rcpp-commits
mailing list