[Rcpp-commits] r2678 - in pkg: Rcpp/inst/unitTests RcppClassic/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 2 21:14:37 CET 2010
Author: romain
Date: 2010-12-02 21:14:33 +0100 (Thu, 02 Dec 2010)
New Revision: 2678
Added:
pkg/RcppClassic/inst/unitTests/runit.RcppDate.R
pkg/RcppClassic/inst/unitTests/runit.RcppMatrix.R
pkg/RcppClassic/inst/unitTests/runit.RcppMisc.R
pkg/RcppClassic/inst/unitTests/runit.RcppResultSet.R
Removed:
pkg/Rcpp/inst/unitTests/runit.RcppDate.R
pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R
pkg/Rcpp/inst/unitTests/runit.RcppMisc.R
pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R
Log:
migrate unit tests about classic api into RcppClassic
Deleted: pkg/Rcpp/inst/unitTests/runit.RcppDate.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppDate.R 2010-12-02 20:08:42 UTC (rev 2677)
+++ pkg/Rcpp/inst/unitTests/runit.RcppDate.R 2010-12-02 20:14:33 UTC (rev 2678)
@@ -1,135 +0,0 @@
-#!/usr/bin/r -t
-# -*- mode: R; tab-width: 4 -*-
-#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
-#
-# This file is part of Rcpp.
-#
-# Rcpp is free software: you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 2 of the License, or
-# (at your option) any later version.
-#
-# Rcpp is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
-
-if( Rcpp:::capabilities()["classic api"] ){
-
-.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);
- RcppResultSet rs;
- rs.add("month", dt.getMonth());
- rs.add("day", dt.getDay());
- rs.add("year", dt.getYear());
- rs.add("julian",dt.getJulian());
- return rs.getReturnList();')
-
- ,"operators"=list(
- signature(),
- 'RcppDate d1 = RcppDate(12,31,1999);
- RcppDate d2 = d1 + 1;
- RcppResultSet rs;
- rs.add("diff", d2 - d1);
- rs.add("bigger", d2 > d1);
- rs.add("smaller", d2 < d1);
- rs.add("equal", d2 == d1);
- rs.add("ge", d2 >= d1);
- rs.add("le", d2 <= d1);
- return rs.getReturnList();')
-
- ,"wrap"=list(
- signature(),
- 'RcppDate dt = RcppDate(12,31,1999);
- return wrap(dt);')
-
- ,"RcppDatetime_functions"=list(
- signature(x="numeric"),
- 'RcppDatetime dt = RcppDatetime(x);
- RcppResultSet rs;
- rs.add("year", dt.getYear());
- rs.add("month", dt.getMonth());
- rs.add("day", dt.getDay());
- rs.add("wday", dt.getWeekday());
- rs.add("hour", dt.getHour());
- rs.add("minute", dt.getMinute());
- rs.add("second", dt.getSecond());
- rs.add("microsec", dt.getMicroSec());
- return rs.getReturnList();')
-
- ,"RcppDatetime_operators"=list(
- signature(x="numeric"),
- 'RcppDatetime d1 = RcppDatetime(946774923.123456);
- //RcppDatetime d1 = RcppDatetime(1152338523.456789);
- // as.POSIXct("2006-07-08 01:02:03.456789")
- RcppDatetime d2 = d1 + 60*60;
- RcppResultSet rs;
- rs.add("diff", d2 - d1);
- rs.add("bigger", d2 > d1);
- rs.add("smaller", d2 < d1);
- rs.add("equal", d2 == d1);
- rs.add("ge", d2 >= d1);
- rs.add("le", d2 <= d1);
- return rs.getReturnList();')
-
- ,"RcppDatetime_wrap"=list(
- signature(),
- 'RcppDatetime dt = RcppDatetime(981162123.123456);
- return wrap(dt);')
-
- )
-
- signatures <- lapply(functions, "[[", 1L)
- bodies <- lapply(functions, "[[", 2L)
- fun <- cxxfunction( signatures, bodies, plugin = "Rcpp")
- getDynLib( fun ) # just forcing loading the dll now
- assign( ".rcpp.RcppDate", fun, globalenv() )
- Sys.setenv("TZ"="UTC") # to ensure localtime is GMT
- }
-}
-
-test.RcppDate.get.functions <- function() {
- fun <- .rcpp.RcppDate$get_functions
- checkEquals(fun(), list(month=12, day=31, year=1999, julian=10956), msg = "RcppDate.get.functions")
-}
-
-test.RcppDate.operators <- function() {
- fun <- .rcpp.RcppDate$operators
- checkEquals(fun(), list(diff=1, bigger=TRUE, smaller=FALSE, equal=FALSE, ge=TRUE, le=FALSE),
- msg = "RcppDate.operators")
-}
-
-test.RcppDate.wrap <- function() {
- fun <- .rcpp.RcppDate$wrap
- checkEquals(fun(), as.Date("1999-12-31"), msg = "RcppDate.wrap")
-}
-
-#test.RcppDatetime.get.functions <- function() {
-# fun <- .rcpp.RcppDate$RcppDatetime_functions
-# checkEquals(#fun(as.numeric(as.POSIXct("2001-02-03 01:02:03.123456", tz="UTC"))),
-# fun(981162123.123456),
-# list(year=2001, month=2, day=3, wday=6, hour=1, minute=2, second=3, microsec=123456),
-# msg = "RcppDate.get.functions")
-#}
-
-test.RcppDatetime.operators <- function() {
- fun <- .rcpp.RcppDate$RcppDatetime_operators
- checkEquals(fun(as.numeric(as.POSIXct("2001-02-03 01:02:03.123456", tz="UTC"))),
- list(diff=3600, bigger=TRUE, smaller=FALSE, equal=FALSE, ge=TRUE, le=FALSE),
- msg = "RcppDatetime.operators")
-}
-
-test.RcppDatetime.wrap <- function() {
- fun <- .rcpp.RcppDate$RcppDatetime_wrap
- checkEquals(as.numeric(fun()), as.numeric(as.POSIXct("2001-02-03 01:02:03.123456", tz="UTC")),
- msg = "RcppDatetime.wrap")
-}
-}
Deleted: pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R 2010-12-02 20:08:42 UTC (rev 2677)
+++ pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R 2010-12-02 20:14:33 UTC (rev 2678)
@@ -1,265 +0,0 @@
-#!/usr/bin/r -t
-# -*- mode: R; tab-width: 4 -*-
-#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
-#
-# This file is part of Rcpp.
-#
-# Rcpp is free software: you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 2 of the License, or
-# (at your option) any later version.
-#
-# Rcpp is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
-
-if( Rcpp:::capabilities()["classic api"] ){
-
-.setUp <- function() {
-
- tests <- ".Rcpp.RcppMatrix"
- if ( ! exists(tests, globalenv() )) {
-
- ## definition of all the functions at once
- f <- list("RcppMatrix_int"=list(
- signature(x="numeric"),
- 'RcppMatrix<int> m(x);
- RcppResultSet rs;
- rs.add("dim1", m.getDim1());
- rs.add("dim2", m.getDim2());
- rs.add("rows", m.rows());
- rs.add("cols", m.cols());
- rs.add("p22", m(1,1));
- std::vector<std::vector<int> > mm = m.stlMatrix();
- rs.add("m", mm);
- return rs.getReturnList();')
-
- ,"RcppMatrix_double"=list(
- signature(x="numeric"),
- 'RcppMatrix<double> m(x);
- RcppResultSet rs;
- rs.add("dim1", m.getDim1());
- rs.add("dim2", m.getDim2());
- rs.add("rows", m.rows());
- rs.add("cols", m.cols());
- rs.add("p22", m(1,1));
- std::vector<std::vector<double> > mm = m.stlMatrix();
- rs.add("m", mm);
- return rs.getReturnList();')
-
- ,"RcppMatrix_double_na_nan"=list(
- signature(x="numeric"),
- 'RcppMatrix<double> m(x);
- RcppResultSet rs;
- rs.add("na_21", R_IsNA(m(1,0)));
- rs.add("na_22", R_IsNA(m(1,1)));
- rs.add("nan_31", R_IsNaN(m(2,0)));
- rs.add("nan_32", R_IsNaN(m(2,1)));
- return rs.getReturnList();')
-
- ,"RcppMatrixView_int"=list(
- signature(x="numeric"),
- 'RcppMatrixView<int> m(x);
- RcppResultSet rs;
- rs.add("dim1", m.dim1());
- rs.add("dim2", m.dim2());
- rs.add("rows", m.rows());
- rs.add("cols", m.cols());
- rs.add("p22", m(1,1));
- return rs.getReturnList();')
-
- ,"RcppMatrixView_double"=list(
- signature(x="numeric"),
- 'RcppMatrixView<double> m(x);
- RcppResultSet rs;
- rs.add("dim1", m.dim1());
- rs.add("dim2", m.dim2());
- rs.add("rows", m.rows());
- rs.add("cols", m.cols());
- rs.add("p22", m(1,1));
- return rs.getReturnList();')
-
- ,"RcppVector_int"=list(
- signature(x="numeric"),
- 'RcppVector<int> m(x);
- RcppResultSet rs;
- rs.add("size", m.size());
- rs.add("p2", m(1));
- std::vector<int> v = m.stlVector();
- rs.add("v", v);
- return rs.getReturnList();')
-
- ,"RcppVector_double"=list(
- signature(x="numeric"),
- 'RcppVector<double> m(x);
- RcppResultSet rs;
- rs.add("size", m.size());
- rs.add("p2", m(1));
- std::vector<double> v = m.stlVector();
- rs.add("v", v);
- return rs.getReturnList();')
-
- ,"RcppVector_double_na_nan"=list(
- signature(x="numeric"),
- 'RcppVector<double> m(x);
- RcppResultSet rs;
- rs.add("na_2", R_IsNA(m(1)));
- rs.add("na_3", R_IsNA(m(2)));
- rs.add("nan_4", R_IsNaN(m(3)));
- rs.add("nan_5", R_IsNaN(m(4)));
- return rs.getReturnList();')
-
- ,"RcppVectorView_int"=list(
- signature(x="numeric"),
- 'RcppVectorView<int> m(x);
- RcppResultSet rs;
- rs.add("size", m.size());
- rs.add("p2", m(1));
- return rs.getReturnList();')
-
- ,"RcppVectorView_double"=list(
- signature(x="numeric"),
- 'RcppVectorView<double> m(x);
- RcppResultSet rs;
- rs.add("size", m.size());
- rs.add("p2", m(1));
- return rs.getReturnList();')
-
- ,"RcppStringVector_classic"=list(
- signature(x="character"),
- 'RcppStringVector s = RcppStringVector(x);
- RcppResultSet rs;
- rs.add("string", s);
- return rs.getReturnList();')
-
- ,"RcppStringVector_wrap"=list(
- signature(x="character"),
- 'RcppStringVector s = RcppStringVector(x);
- return wrap(s);')
-
- ,"RcppStringVector_begin"=list(
- signature(x="character"),
- 'RcppStringVector s = RcppStringVector(x);
- return wrap(*s.begin());')
-
- ,"RcppStringVector_end"=list(
- signature(x="character"),
- 'RcppStringVector s = RcppStringVector(x);
- return wrap(s(s.size()-1));')
- )
-
- signatures <- lapply(f, "[[", 1L)
- bodies <- lapply(f, "[[", 2L)
- fun <- cxxfunction( signatures, bodies, plugin = "Rcpp")
- getDynLib( fun ) # just forcing loading the dll now
- assign( tests, fun, globalenv() )
- }
-}
-
-test.RcppMatrix.int <- function() {
- funx <- .Rcpp.RcppMatrix$RcppMatrix_int
- M <- matrix(1:6, 2, 3, byrow=TRUE)
- checkEquals(funx(x=M), list(dim1=2, dim2=3, rows=2, cols=3, p22=5, m=M),
- msg = "RcppMatrix.int")
-}
-
-test.RcppMatrix.double <- function() {
- funx <- .Rcpp.RcppMatrix$RcppMatrix_double
- M <- matrix(1:6,2,3,byrow=TRUE)
- checkEquals(funx(x=M), list(dim1=2, dim2=3, rows=2, cols=3, p22=5, m=M),
- msg = "RcppMatrix.double")
-}
-
-test.RcppMatrix.double.na.nan <- function() {
- funx <- .Rcpp.RcppMatrix$RcppMatrix_double_na_nan
- M <- matrix(1:6,3,2,byrow=TRUE)
- M[2,1] <- NA
- M[3,1] <- NaN
- checkEquals(funx(x=M),
- list(na_21=1, na_22=0, nan_31=1, nan_32=0),
- msg = "RcppMatrix.double.na.nan")
-}
-
-
-
-test.RcppMatrixView.int <- function() {
- funx <- .Rcpp.RcppMatrix$RcppMatrixView_int
- checkEquals(funx(x=matrix(1:6,2,3,byrow=TRUE)),
- list(dim1=2, dim2=3, rows=2, cols=3, p22=5),
- msg = "RcppViewMatrix.int")
-}
-
-test.RcppMatrixView.double <- function() {
- funx <- .Rcpp.RcppMatrix$RcppMatrixView_double
- checkEquals(funx(x=matrix(1.0*(1:6),2,3,byrow=TRUE)),
- list(dim1=2, dim2=3, rows=2, cols=3, p22=5),
- msg = "RcppMatrixView.double")
-}
-
-
-
-
-test.RcppVector.int <- function() {
- funx <- .Rcpp.RcppMatrix$RcppVector_int
- checkEquals(funx(x=c(1:6)), list(size=6, p2=2, v=c(1:6)), msg="RcppVector.int")
-}
-
-test.RcppVector.double <- function() {
- funx <- .Rcpp.RcppMatrix$RcppVector_double
- checkEquals(funx(x=c(1:6)), list(size=6, p2=2, v=c(1:6)), msg="RcppVector.double")
-}
-
-test.RcppVector.double.na.nan <- function() {
- funx <- .Rcpp.RcppMatrix$RcppVector_double_na_nan
- x <- 1:6
- x[2] <- NA
- x[4] <- NaN
- checkEquals(funx(x=x),
- list(na_2=1, na_3=0, nan_4=1, nan_5=0),
- msg = "RcppMatrix.double.na.nan")
-}
-
-
-
-test.RcppVectorView.int <- function() {
- funx <- .Rcpp.RcppMatrix$RcppVectorView_int
- checkEquals(funx(x=c(1:6)), list(size=6, p2=2), msg="RcppVectorView.int")
-}
-
-test.RcppVectorView.double <- function() {
- funx <- .Rcpp.RcppMatrix$RcppVectorView_double
- checkEquals(funx(x=1.0*c(1:6)), list(size=6, p2=2), msg="RcppVectorView.double")
-}
-
-
-
-test.RcppStringVector.classic <- function() {
- fun <- .Rcpp.RcppMatrix$RcppStringVector_classic
- sv <- c("tic", "tac", "toe")
- checkEquals(fun(sv), list(string=sv), msg = "RcppStringVector.classic")
-}
-
-test.RcppStringVector.wrap <- function() {
- fun <- .Rcpp.RcppMatrix$RcppStringVector_wrap
- sv <- c("tic", "tac", "toe")
- checkEquals(fun(sv), sv, msg = "RcppStringVector.wrap")
-}
-
-test.RcppStringVector.begin <- function() {
- fun <- .Rcpp.RcppMatrix$RcppStringVector_begin
- sv <- c("tic", "tac", "toe")
- checkEquals(fun(sv), sv[1], msg = "RcppStringVector.begin")
-}
-
-test.RcppStringVector.end <- function() {
- fun <- .Rcpp.RcppMatrix$RcppStringVector_end
- sv <- c("tic", "tac", "toe")
- checkEquals(fun(sv), sv[3], msg = "RcppStringVector.begin")
-}
-
-}
Deleted: pkg/Rcpp/inst/unitTests/runit.RcppMisc.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppMisc.R 2010-12-02 20:08:42 UTC (rev 2677)
+++ pkg/Rcpp/inst/unitTests/runit.RcppMisc.R 2010-12-02 20:14:33 UTC (rev 2678)
@@ -1,149 +0,0 @@
-#!/usr/bin/r -t
-# -*- mode: R; tab-width: 4 -*-
-#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
-#
-# This file is part of Rcpp.
-#
-# Rcpp is free software: you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 2 of the License, or
-# (at your option) any later version.
-#
-# Rcpp is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
-
-if( Rcpp:::capabilities()["classic api"] ){
-
-.setUp <- function() {
-
- tests <- ".Rcpp.RcppMisc"
- if ( ! exists(tests, globalenv() )) {
-
- ## definition of all the functions at once
- f <- list("RcppFrame_"=list(
- signature(),
- 'std::vector<std::string> names;
- names.push_back("A");
- names.push_back("B");
- names.push_back("C");
- RcppFrame fr(names);
-
- std::vector<ColDatum> colDatumVector(3);
- colDatumVector[0].setDoubleValue(1.23);
- colDatumVector[1].setIntValue(42);
- colDatumVector[2].setLogicalValue(0);
- fr.addRow(colDatumVector);
-
- colDatumVector[0].setDoubleValue(4.56);
- colDatumVector[1].setIntValue(21);
- colDatumVector[2].setLogicalValue(1);
- fr.addRow(colDatumVector);
-
- RcppResultSet rs;
- rs.add("data.frame", fr);
- return rs.getReturnList();')
-
- ,"RcppList_"=list(
- signature(),
- 'RcppList l;
- l.setSize(3);
- l.append("foo", 1);
- l.append("bar", 2.0);
- l.append("biz", "xyz");
- return l.getList();')
-
- ,"RcppParams_Double"=list(
- signature(x="ANY"),
- 'double y = 2 * RcppParams(x).getDoubleValue("val");
- return Rcpp::wrap(y);')
-
- ,"RcppParams_Int"=list(
- signature(x="ANY"),
- 'int y = 2 * RcppParams(x).getIntValue("val");
- return Rcpp::wrap(y);')
-
- ,"RcppParams_String"=list(
- signature(x="ANY"),
- 'std::string y = RcppParams(x).getStringValue("val");
- y = y + y; // trivial string operation
- return Rcpp::wrap(y);')
-
- ,"RcppParams_Bool"=list(
- signature(x="ANY"),
- 'bool y = RcppParams(x).getBoolValue("val");
- return Rcpp::wrap(y);')
-
- ,"RcppParams_Date"=list(
- signature(x="ANY"),
- 'RcppDate y = RcppParams(x).getDateValue("val");
- RcppResultSet rs;
- rs.add("date", y);
- return rs.getReturnList();')
-
- ,"RcppParams_Datetime"=list(
- signature(x="ANY"),
- 'RcppDatetime y = RcppParams(x).getDatetimeValue("val");
- RcppResultSet rs;
- rs.add("datetime", y);
- 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( tests, fun, globalenv() )
- }
-}
-
-test.RcppFrame <- function() {
- fun <- .Rcpp.RcppMisc$RcppFrame_
- dframe <- data.frame(fun()[[1]]) ## needs a data.frame() call on first list elem
- checkEquals(dframe, data.frame(A=c(1.23,4.56), B=c(42,21), C=c(FALSE,TRUE)), msg = "RcppFrame")
-}
-
-test.RcppList <- function() {
- fun <- .Rcpp.RcppMisc$RcppList_
- checkEquals(fun(), list(foo=1L, bar=2, biz="xyz"), msg="RcppList")
-}
-
-test.RcppParams.Double <- function() {
- fun <- .Rcpp.RcppMisc$RcppParams_Double
- checkEquals(fun(list(val=1.234)), 2*1.234, msg="RcppParams.getDoubleValue")
-}
-
-test.RcppParams.Int <- function() {
- fun <- .Rcpp.RcppMisc$RcppParams_Int
- checkEquals(fun(list(val=42)), 2*42, msg="RcppParams.getIntValue")
-}
-
-test.RcppParams.String <- function() {
- fun <- .Rcpp.RcppMisc$RcppParams_String
- checkEquals(fun(list(val="a test string")), "a test stringa test string", msg = "RcppParams.getStringValue")
-}
-
-test.RcppParams.Bool <- function() {
- fun <- .Rcpp.RcppMisc$RcppParams_Bool
- checkEquals(fun(list(val=FALSE)), FALSE, msg = "RcppParams.getBoolValue")
-}
-
-test.RcppParams.Date <- function() {
- fun <- .Rcpp.RcppMisc$RcppParams_Date
- checkEquals(fun(list(val=as.Date("2000-01-01")))[[1]], as.Date("2000-01-01"), msg = "RcppParams.getDateValue")
-}
-
-test.RcppParams.Datetime <- function() {
- fun <- .Rcpp.RcppMisc$RcppParams_Datetime
- posixt <- as.POSIXct(strptime("2000-01-02 03:04:05.678", "%Y-%m-%d %H:%M:%OS"))
- attr(posixt, "tzone") <- NULL ## because we don't set a tzone attribute in C++
- result <- fun(list(val=posixt))[[1]]
- checkTrue( (result-posixt) == 0.0 , msg = "RcppParams.getDatetimeValue")
-}
-}
Deleted: pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R 2010-12-02 20:08:42 UTC (rev 2677)
+++ pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R 2010-12-02 20:14:33 UTC (rev 2678)
@@ -1,370 +0,0 @@
-#!/usr/bin/r -t
-#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
-#
-# This file is part of Rcpp.
-#
-# Rcpp is free software: you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 2 of the License, or
-# (at your option) any later version.
-#
-# Rcpp is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
-
-if( Rcpp:::capabilities()["classic api"] ){
-
-.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() {
- fun <- .rcpp.RcppResultSet$double_
- checkEquals(fun()[[1]], 1.23456, msg = "RcppResultRet.double")
-}
-
-test.RcppResultSet.int <- function() {
- fun <- .rcpp.RcppResultSet$int_
- checkEquals(fun()[[1]], 42, msg = "RcppResultSet.int")
-}
-
-test.RcppResultSet.string <- function() {
- fun <- .rcpp.RcppResultSet$string_
- checkEquals(fun()[[1]], "hello unit tests", msg = "RcppResultSet.string")
-}
-
-test.RcppResultSet.double.vector <- function() {
- fun <- .rcpp.RcppResultSet$double_vector
- checkEquals(fun()[[1]], c(1.1, 2.2, 3.3), msg = "RcppResultSet.double.vector")
-}
-
-test.RcppResultSet.int.vector <- function() {
- fun <- .rcpp.RcppResultSet$int_vector
- checkEquals(fun()[[1]], c(11, 22, 33), msg = "RcppResultSet.int.vector")
-}
-
-test.RcppResultSet.double.matrix <- function() {
- 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() {
- 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() {
- fun <- .rcpp.RcppResultSet$RcppDate_
- checkEquals(fun()[[1]], as.Date("2000-01-01"), msg = "RcppResultSet.RcppDate")
-}
-
-test.RcppResultSet.RcppDateVector <- function() {
- fun <- .rcpp.RcppResultSet$RcppDateVector_
- v <- c(as.Date("2000-01-01"), as.Date("2001-01-01"))
- checkEquals(fun(v)[[1]], v, msg = "RcppResultSet.RcppDateVector")
-}
-
-test.RcppResultSet.RcppDatetime <- function() {
- 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() {
- 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( fun(v)[[1]] - v ) == 0.0 , msg = "RcppResultSet.RcppDatetimeVector")
-}
-
-test.RcppResultSet.RcppStringVector <- function() {
- fun <- .rcpp.RcppResultSet$RcppStringVector_
- v <- c("hello", "goodbye")
- checkEquals(fun(v)[[1]], v, msg = "RcppResultSet.RcppStringVector")
-}
-
-test.RcppResultSet.std.vector.double <- function() {
- 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() {
- 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() {
- 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() {
- 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.string <- function() {
- fun <- .rcpp.RcppResultSet$std_vector_std_vector_string
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rcpp -r 2678
More information about the Rcpp-commits
mailing list