[Rcpp-commits] r1051 - in pkg/Rcpp: . inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Apr 15 12:49:52 CEST 2010
Author: romain
Date: 2010-04-15 12:49:52 +0200 (Thu, 15 Apr 2010)
New Revision: 1051
Modified:
pkg/Rcpp/DESCRIPTION
pkg/Rcpp/inst/unitTests/runit.Argument.R
pkg/Rcpp/inst/unitTests/runit.CharacterVector.R
pkg/Rcpp/inst/unitTests/runit.Column.R
pkg/Rcpp/inst/unitTests/runit.ComplexVector.R
pkg/Rcpp/inst/unitTests/runit.ExpressionVector.R
pkg/Rcpp/inst/unitTests/runit.Formula.R
pkg/Rcpp/inst/unitTests/runit.Function.R
pkg/Rcpp/inst/unitTests/runit.GenericVector.R
pkg/Rcpp/inst/unitTests/runit.IntegerVector.R
pkg/Rcpp/inst/unitTests/runit.Language.R
pkg/Rcpp/inst/unitTests/runit.Matrix.R
pkg/Rcpp/inst/unitTests/runit.NumericVector.R
pkg/Rcpp/inst/unitTests/runit.Pairlist.R
pkg/Rcpp/inst/unitTests/runit.RObject.R
pkg/Rcpp/inst/unitTests/runit.RawVector.R
pkg/Rcpp/inst/unitTests/runit.RcppDate.R
pkg/Rcpp/inst/unitTests/runit.RcppDatetime.R
pkg/Rcpp/inst/unitTests/runit.RcppFrame.R
pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R
pkg/Rcpp/inst/unitTests/runit.RcppMatrixView.R
pkg/Rcpp/inst/unitTests/runit.RcppParams.R
pkg/Rcpp/inst/unitTests/runit.RcppResultSet.R
pkg/Rcpp/inst/unitTests/runit.RcppVector.R
pkg/Rcpp/inst/unitTests/runit.RcppVectorView.R
pkg/Rcpp/inst/unitTests/runit.Row.R
pkg/Rcpp/inst/unitTests/runit.S4.R
pkg/Rcpp/inst/unitTests/runit.Symbol.R
pkg/Rcpp/inst/unitTests/runit.Vector.create.R
pkg/Rcpp/inst/unitTests/runit.XPTr.R
pkg/Rcpp/inst/unitTests/runit.as.R
pkg/Rcpp/inst/unitTests/runit.client.package.R
pkg/Rcpp/inst/unitTests/runit.clone.R
pkg/Rcpp/inst/unitTests/runit.dotCpp.R
pkg/Rcpp/inst/unitTests/runit.environments.R
pkg/Rcpp/inst/unitTests/runit.evaluator.R
pkg/Rcpp/inst/unitTests/runit.exceptions.R
pkg/Rcpp/inst/unitTests/runit.traits.R
pkg/Rcpp/inst/unitTests/runit.wrap.R
Log:
promote unit tests to cppfunction
Modified: pkg/Rcpp/DESCRIPTION
===================================================================
--- pkg/Rcpp/DESCRIPTION 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/DESCRIPTION 2010-04-15 10:49:52 UTC (rev 1051)
@@ -1,6 +1,6 @@
Package: Rcpp
Title: Rcpp R/C++ interface package
-Version: 0.7.11.4
+Version: 0.7.11.5
Date: $Date$
Author: Dirk Eddelbuettel and Romain Francois, with contributions
by Simon Urbanek, David Reiss and Douglas Bates; based on code written during
Modified: pkg/Rcpp/inst/unitTests/runit.Argument.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Argument.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.Argument.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -17,18 +17,13 @@
# 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(){
- suppressMessages( require( inline ) )
-}
-
runit.Argument <- function(){
- fx <- cfunction( signature(), '
+ fx <- cppfunction( signature(), '
Argument x("x") ;
Argument y("y") ;
return make_list( x = 2, y = 3 );
- ',
- Rcpp = TRUE, includes = "using namespace Rcpp; " )
+ ' )
checkEquals( fx(), list( x = 2L, y = 3L ) , msg = "Argument")
}
Modified: pkg/Rcpp/inst/unitTests/runit.CharacterVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.CharacterVector.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.CharacterVector.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -17,96 +17,87 @@
# 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(){
- suppressMessages( require( inline ) )
-}
-
test.CharacterVector <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
CharacterVector x(10) ;
for( int i=0; i<10; i++) x[i] = "foo" ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
checkEquals( funx(), rep("foo",10L), msg = "CharacterVector" )
}
test.CharacterVector.STRSXP <- function(){
- funx <- cfunction(signature(vec = "character" ), '
+ funx <- cppfunction(signature(vec = "character" ), '
CharacterVector x(vec) ;
std::string st = "" ;
for( int i=0; i<x.size(); i++) {
st += x[i] ;
}
- return wrap( st ) ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return wrap( st ) ;' )
checkEquals( funx(letters), paste(letters,collapse="" ),
msg = "CharacterVector( STRSXP) " )
}
test.CharacterVector.initializer.list <- function(){
if( Rcpp:::capabilities()[["initializer lists"]] ){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
CharacterVector x = {"foo", "bar"} ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE,
- includes = "using namespace Rcpp;",
- cxxargs = "-std=c++0x" )
+ return x ;', cxxargs = "-std=c++0x" )
checkEquals( funx(), c("foo","bar"), msg = "CharacterVector( initializer list) " )
}
}
test.CharacterVector.plusequals <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
CharacterVector x(2) ;
x[0] = "foo" ;
x[1] = "bar" ;
x[0] += "bar" ;
x[1] += x[0] ;
return x ;
- ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ ', )
checkEquals( funx(), c("foobar", "barfoobar"),
msg = "StringProxy::operator+=" )
}
test.CharacterVector.matrix.indexing <- function(){
- funx <- cfunction(signature(x = "character" ), '
+ funx <- cppfunction(signature(x = "character" ), '
CharacterVector m(x) ;
std::string trace ;
for( size_t i=0 ; i<4; i++){
trace += m(i,i) ;
}
return wrap( trace ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
x <- matrix( as.character(1:16), ncol = 4 )
checkEquals( funx(x), paste(diag(x), collapse = ""), msg = "matrix indexing" )
y <- as.vector( x )
checkException( funx(y) , msg = "not a matrix" )
- funx <- cfunction(signature(x = "integer" ), '
+ funx <- cppfunction(signature(x = "integer" ), '
CharacterVector m(x) ;
for( size_t i=0 ; i<4; i++){
m(i,i) = "foo" ;
}
return m ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( diag(funx(x)), rep("foo", 4) ,
msg = "matrix indexing lhs" )
}
test.CharacterVector.assign <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
const char* x[] = { "foo", "bar", "bling", "boom" } ;
CharacterVector y ;
y.assign( x, x+4 ) ;
return y;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(), c("foo", "bar", "bling", "boom"), msg = "assign(char**, char**)" )
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
std::vector<std::string> vec(4) ;
vec[0] = "foo";
vec[1] = "bar";
@@ -115,22 +106,22 @@
CharacterVector y ;
y.assign( vec.begin(), vec.end() ) ;
return y;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(), c("foo", "bar", "bling", "boom"), msg = "assign(char**, char**)" )
}
test.CharacterVector.range.constructors <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
const char* x[] = { "foo", "bar", "bling", "boom" } ;
CharacterVector y( x, x+4 ) ;
return y;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(), c("foo", "bar", "bling", "boom"), msg = "assign(char**, char**)" )
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
std::vector<std::string> vec(4) ;
vec[0] = "foo";
vec[1] = "bar";
@@ -138,36 +129,30 @@
vec[3] = "boom" ;
CharacterVector y( vec.begin(), vec.end() ) ;
return y;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(), c("foo", "bar", "bling", "boom"), msg = "assign(char**, char**)" )
}
test.CharacterVector.Dimension.constructor <- function(){
- funx <- cfunction(signature(), '
- return CharacterVector( Dimension( 5 ) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ funx <- cppfunction(signature(), 'return CharacterVector( Dimension( 5 ) ) ;' )
checkEquals( funx(),
character(5) ,
msg = "CharacterVector( Dimension(5))" )
- funx <- cfunction(signature(), '
- return CharacterVector( Dimension( 5, 5 ) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ funx <- cppfunction(signature(), 'return CharacterVector( Dimension( 5, 5 ) ) ;' )
checkEquals( funx(),
matrix( "", ncol = 5, nrow = 5) ,
msg = "CharacterVector( Dimension(5,5))" )
- funx <- cfunction(signature(), '
- return CharacterVector( Dimension( 2, 3, 4) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ funx <- cppfunction(signature(), 'return CharacterVector( Dimension( 2, 3, 4) ) ;' )
checkEquals( funx(),
array( "", dim = c(2,3,4) ) ,
msg = "CharacterVector( Dimension(2,3,4))" )
}
test.CharacterVector.iterator <- function(){
- funx <- cfunction(signature(x = "character"), '
+ funx <- cppfunction(signature(x = "character"), '
CharacterVector letters(x) ;
std::string res ;
CharacterVector::iterator first = letters.begin() ;
@@ -177,21 +162,19 @@
++first ;
}
return wrap(res) ;
- ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ;' )
checkEquals(
funx(letters),
paste(letters, collapse=""),
msg = "CharacterVector::iterator explicit looping" )
- funx <- cfunction(signature(x = "character"), '
+ funx <- cppfunction(signature(x = "character"), '
CharacterVector letters(x) ;
std::string res(
std::accumulate(
letters.begin(), letters.end(), std::string() ) ) ;
return wrap(res) ;
- ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ;' )
checkEquals(
funx(letters),
paste(letters, collapse=""),
@@ -200,12 +183,11 @@
}
test.CharacterVector.reverse <- function(){
- funx <- cfunction(signature(x = "character"), '
+ funx <- cppfunction(signature(x = "character"), '
CharacterVector y(x) ;
std::reverse( y.begin(), y.end() ) ;
return y ;
- ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ;' )
x <- c("foo", "bar", "bling")
funx(x)
checkEquals( x, c("bling", "bar", "foo"), msg = "reverse" )
@@ -214,21 +196,20 @@
}
test.CharacterVector.names.indexing <- function(){
- funx <- cfunction(signature(x = "character"), '
+ funx <- cppfunction(signature(x = "character"), '
CharacterVector y(x) ;
std::string foo( y["foo"] ) ;
return wrap(foo) ;
- ;', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ;' )
x <- c( foo = "foo", bar = "bar" )
checkEquals( funx(x), "foo", msg = "CharacterVector names based indexing" )
}
test.CharacterVector.comma <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
CharacterVector x(3) ;
x = "foo", "bar", "bling" ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
checkEquals( funx(), c("foo","bar", "bling" ), msg = "CharacterVector comma operator" )
}
@@ -241,7 +222,7 @@
std::string rv2 = std::string(cv2[0]) + cv2[1] + cv2[2];
return List::create(_["foo"] = rv1, _["bar"] = rv2);
'
- fun <- cfunction(signature(l = "list"), src, Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ fun <- cppfunction(signature(l = "list"), src )
checkEquals(fun(list(foo=c("tic","tac","toe"),
bar=c("Eenie","Meenie","Moe"))),
list(foo="tictactoe", bar="EenieMeenieMoe"),
Modified: pkg/Rcpp/inst/unitTests/runit.Column.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Column.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.Column.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -18,24 +18,24 @@
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
test.NumericMatrix.column <- function(){
- funx <- cfunction(signature(x = "matrix" ), '
+ funx <- cppfunction(signature(x = "matrix" ), '
NumericMatrix m(x) ;
NumericMatrix::Column col = m.column(0) ;
return wrap( std::accumulate( col.begin(), col.end(), 0.0 ) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
x <- matrix( 1:16 + .5, ncol = 4 )
checkEquals( funx( x ), sum( x[,1] ) , msg = "iterating over a column" )
}
test.CharacterMatrix.column <- function(){
- funx <- cfunction(signature(x = "matrix" ), '
+ funx <- cppfunction(signature(x = "matrix" ), '
CharacterVector m(x) ;
CharacterVector::Column col = m.column(0) ;
std::string res(
std::accumulate(
col.begin(), col.end(), std::string() ) ) ;
return wrap(res) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
m <- matrix( letters, ncol = 2 )
checkEquals( funx(m), paste( m[,1], collapse = "" ), msg = "CharacterVector::Column" )
@@ -43,7 +43,7 @@
test.List.column <- function(){
- funx <- cfunction(signature(x = "matrix" ), '
+ funx <- cppfunction(signature(x = "matrix" ), '
List m(x) ;
List::Column col = m.column(0) ;
IntegerVector out( col.size() ) ;
@@ -52,7 +52,7 @@
out.begin(),
unary_call<SEXP,int>( Function("length" ) ) ) ;
return wrap(out) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
m <- lapply( 1:16, function(i) seq(from=1, to = i ) )
dim( m ) <- c( 4, 4 )
Modified: pkg/Rcpp/inst/unitTests/runit.ComplexVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.ComplexVector.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.ComplexVector.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -17,45 +17,36 @@
# 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(){
- suppressMessages( require( inline ) )
-}
-
test.ComplexVector <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
ComplexVector x(10) ;
Rcomplex rc ;
for( int i=0; i<10; i++) {
rc.r = rc.i = i + 0.0 ;
x[i] = rc ;
}
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
checkEquals( funx(), 0:9*(1+1i), msg = "ComplexVector" )
}
test.ComplexVector.INTSXP <- function(){
- funx <- cfunction(signature(vec = "complex" ), '
+ funx <- cppfunction(signature(vec = "complex" ), '
ComplexVector x(vec) ;
for( int i=0; i<x.size(); i++) {
x[i].r = x[i].r*2 ;
x[i].i = x[i].i*2 ;
}
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
checkEquals( funx(0:9*(1+1i)), 2*0:9*(1+1i), msg = "ComplexVector( CPLXSXP) " )
}
test.ComplexVector.initializer.list <- function(){
if( Rcpp:::capabilities()[["initializer lists"]] ){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
Rcomplex c1 ; c1.r = c1.i = 0.0 ;
Rcomplex c2 ; c2.r = c2.i = 1.0 ;
ComplexVector x = { c1, c2 } ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE,
- includes = "using namespace Rcpp;",
- cxxargs = "-std=c++0x" )
+ return x ;', cxxargs = "-std=c++0x" )
checkEquals( funx(), c( 0:1*(1+1i)), msg = "ComplexVector( initializer list) " )
}
}
Modified: pkg/Rcpp/inst/unitTests/runit.ExpressionVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.ExpressionVector.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.ExpressionVector.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -17,17 +17,12 @@
# 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(){
- suppressMessages( require( inline ) )
-}
-
test.ExpressionVector <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
ExpressionVector x(2) ;
x[0] = Symbol( "rnorm" ) ;
x[1] = Rf_lcons( Symbol("rnorm"), Rf_cons( Rf_ScalarReal(10.0), R_NilValue) ) ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
ex <- parse( text = "rnorm; rnorm(10)" )
# get rid of the srcref stuff so that we can compare
# more easily
@@ -37,14 +32,11 @@
if( Rcpp:::capabilities()[["variadic templates"]] ){
test.ExpressionVector.variadic <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
ExpressionVector x(2) ;
x[0] = Symbol( "rnorm" ) ;
x[1] = Language( "rnorm", 10.0 ) ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE,
- includes = "using namespace Rcpp;",
- cxxargs = "-std=c++0x" )
+ return x ;', cxxargs = "-std=c++0x" )
ex <- parse( text = "rnorm; rnorm(10)" )
attributes(ex) <- NULL
checkEquals( funx(), ex , msg = "ExpressionVector (using variadic templates) " )
@@ -52,42 +44,35 @@
}
test.ExpressionVector.parse <- function( ){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
ExpressionVector code( "local( { y <- sample(1:10); sort(y) })" ) ;
- return code ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return code ;' )
code <- funx()
results <- eval( code )
checkEquals( results, 1:10, msg = "ExpressionVector parsing" )
}
test.ExpressionVector.parse.error <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
ExpressionVector code( "rnorm(" ) ;
- return code ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return code ;' )
checkException( funx(), msg = "parse error" )
}
test.ExpressionVector.eval <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
ExpressionVector code( "local( { y <- sample(1:10); sort(y) })" ) ;
- return code.eval() ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return code.eval() ;' )
checkEquals( funx(), 1:10, msg = "ExpressionVector::eval" )
}
test.ExpressionVector.eval.env <- function(){
- funx <- cfunction(signature(env = "environment"), '
+ funx <- cppfunction(signature(env = "environment"), '
ExpressionVector code( "sort(x)" ) ;
- return code.eval(env) ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return code.eval(env) ;' )
e <- new.env()
e[["x"]] <- sample(1:10)
checkEquals( funx(e), 1:10, msg = "ExpressionVector::eval" )
}
-
-
-
Modified: pkg/Rcpp/inst/unitTests/runit.Formula.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Formula.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.Formula.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -17,25 +17,19 @@
# 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(){
- suppressMessages( require( inline ) )
-}
-
test.Formula <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
Formula f( "x ~ y + z" ) ;
return f;
- ',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
+ ' )
checkEquals( funx(), x ~ y + z, msg = "Formula( string )" )
}
test.Formula.SEXP <- function(){
- funx <- cfunction(signature( form = "ANY" ), '
+ funx <- cppfunction(signature( form = "ANY" ), '
Formula f(form) ;
return f;
- ',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
+ ' )
checkEquals( funx( x ~ y + z), x ~ y + z, msg = "Formula( SEXP = formula )" )
checkEquals( funx( "x ~ y + z" ), x ~ y + z, msg = "Formula( SEXP = STRSXP )" )
checkEquals( funx( parse( text = "x ~ y + z") ), x ~ y + z, msg = "Formula( SEXP = EXPRSXP )" )
Modified: pkg/Rcpp/inst/unitTests/runit.Function.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Function.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.Function.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -18,13 +18,11 @@
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
.setUp <- function(){
- suppressMessages( require( inline ) )
suppressMessages( require( stats ) )
}
test.Function <- function(){
- funx <- cfunction(signature(x="ANY"), 'return Function(x) ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ funx <- cppfunction(signature(x="ANY"), 'return Function(x) ;' )
checkEquals( funx( rnorm ), rnorm, msg = "Function( CLOSXP )" )
checkEquals( funx( is.function ), is.function, msg = "Pairlist( BUILTINSXP )" )
@@ -38,11 +36,10 @@
test.Function.variadic <- function(){
if( Rcpp:::capabilities()[["variadic templates"]] ){
- funx <- cfunction(signature(x="function", y = "ANY"), '
+ funx <- cppfunction(signature(x="function", y = "ANY"), '
Function sort(x) ;
return sort( y, Named("decreasing", true) ) ;
- ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;",
- cxxargs = "-std=c++0x" )
+ ', cxxargs = "-std=c++0x" )
checkEquals( funx( sort, sample(1:20) ),
20:1, msg = "calling function" )
checkException( funx(sort, sort), msg = "Function, R error -> exception" )
@@ -50,11 +47,10 @@
}
test.Function.env <- function(){
- funx <- cfunction(signature(x="function"), '
+ funx <- cppfunction(signature(x="function"), '
Function fun(x) ;
return fun.environment() ;
- ', Rcpp=TRUE, verbose=FALSE,
- includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(rnorm), asNamespace("stats" ), msg = "Function::environment" )
checkException( funx(is.function),
msg = "Function::environment( builtin) : exception" )
@@ -64,7 +60,7 @@
test.Function.unary.call <- function(){
- funx <- cfunction(signature(y = "list" ), '
+ funx <- cppfunction(signature(y = "list" ), '
Function len( "length" ) ;
List x(y) ;
IntegerVector output( x.size() ) ;
@@ -74,7 +70,7 @@
unary_call<IntegerVector,int>(len)
) ;
return output ;
- ', Rcpp = TRUE, verbose = FALSE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals(
funx( lapply( 1:10, function(n) seq(from=n, to = 0 ) ) ),
@@ -85,7 +81,7 @@
test.Function.binary.call <- function(){
- funx <- cfunction(signature(x1 = "list", x2 = "integer" ), '
+ funx <- cppfunction(signature(x1 = "list", x2 = "integer" ), '
Function pmin( "pmin" ) ;
List list(x1) ;
IntegerVector vec(x2) ;
@@ -97,7 +93,7 @@
binary_call<IntegerVector,int,IntegerVector>(pmin)
) ;
return output ;
- ', Rcpp = TRUE, verbose = FALSE, includes = "using namespace Rcpp;" )
+ ' )
data <- lapply( 1:10, function(n) seq(from=n, to = 0 ) )
res <- funx( data , rep(5L,10) )
@@ -108,4 +104,3 @@
}
-
Modified: pkg/Rcpp/inst/unitTests/runit.GenericVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.GenericVector.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.GenericVector.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -17,77 +17,69 @@
# 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(){
- suppressMessages( require( inline ) )
-}
-
test.List <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
List x(10) ;
for( int i=0; i<10; i++) x[i] = Rf_ScalarInteger( i * 2) ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;')
checkEquals( funx(), as.list( 2*0:9), msg = "GenericVector" )
}
test.List.template <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
List x(4) ;
x[0] = "foo" ;
x[1] = 10 ;
x[2] = 10.2 ;
x[3] = false;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;')
checkEquals( funx(),
list( "foo", 10L, 10.2, FALSE),
msg = "GenericVector" )
}
test.List.VECSXP <- function(){
- funx <- cfunction(signature(vec = "list" ), '
+ funx <- cppfunction(signature(vec = "list" ), '
List x(vec) ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
checkEquals( funx(list(1,2)), list(1,2), msg = "GenericVector( VECSXP) " )
}
test.List.initializer.list <- function(){
if( Rcpp:::capabilities()[["initializer lists"]] ){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
SEXP x0 = PROTECT( Rf_ScalarInteger( 0 ) ) ;
SEXP x1 = PROTECT( Rf_ScalarInteger( 1 ) ) ;
SEXP x2 = PROTECT( Rf_ScalarInteger( 2 ) ) ;
List x = { x0, x1, x2} ;
UNPROTECT(3) ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;", cxxargs="-std=c++0x" )
+ return x ;', cxxargs="-std=c++0x" )
checkEquals( funx(), as.list(0:2), msg = "List( initializer list) " )
}
}
test.List.matrix.indexing <- function(){
- funx <- cfunction(signature(x = "character" ), '
+ funx <- cppfunction(signature(x = "character" ), '
GenericVector m(x) ;
GenericVector out(4) ;
for( size_t i=0 ; i<4; i++){
out[i] = m(i,i) ;
}
return out ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
# a matrix of integer vectors
x <- structure( lapply( 1:16, function(x) seq.int(x) ), dim = c( 4, 4) )
checkEquals( funx(x), diag(x), msg = "matrix indexing" )
- funx <- cfunction(signature(x = "integer" ), '
+ funx <- cppfunction(signature(x = "integer" ), '
GenericVector m(x) ;
for( size_t i=0 ; i<4; i++){
m(i,i) = "foo" ;
}
return m ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( diag(funx(x)), rep(list("foo"), 4) ,
msg = "matrix indexing lhs" )
@@ -98,23 +90,23 @@
test.List.Dimension.constructor <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
return List( Dimension( 5 ) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(),
rep(list(NULL),5) ,
msg = "List( Dimension(5))" )
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
return List( Dimension( 5, 5 ) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(),
structure( rep( list(NULL), 25), dim = c(5,5) ),
msg = "List( Dimension(5,5))" )
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
return List( Dimension( 2, 3, 4) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(),
array( rep(list(NULL)), dim = c(2,3,4) ) ,
msg = "List( Dimension(2,3,4))" )
@@ -122,7 +114,7 @@
test.List.iterator <- function(){
- cpp_lapply <- cfunction(signature(x = "list", g = "function" ), '
+ cpp_lapply <- cppfunction(signature(x = "list", g = "function" ), '
Function fun(g) ;
List input(x) ;
List output( input.size() ) ;
@@ -130,7 +122,7 @@
output.names() = input.names() ;
return output ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
data <- list( x = letters, y = LETTERS, z = 1:4 )
checkEquals(
@@ -142,26 +134,26 @@
test.List.name.indexing <- function(){
- funx <- cfunction( signature(x = "data.frame"),
+ funx <- cppfunction( signature(x = "data.frame"),
'
List df(x) ;
IntegerVector df_x = df["x"] ;
int res = std::accumulate( df_x.begin(), df_x.end(), 0 ) ;
return wrap(res);
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
d <- data.frame( x = 1:10, y = letters[1:10] )
checkEquals( funx( d ), sum(1:10), msg = "List names based indexing" )
}
test.List.push.back <- function(){
- funx <- cfunction( signature(x = "list"),
+ funx <- cppfunction( signature(x = "list"),
'
List list(x) ;
list.push_back( 10 ) ;
list.push_back( "bar", "foo" ) ;
return list ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
d <- list( x = 1:10, y = letters[1:10] )
res <- funx( d )
checkEquals( res,
@@ -171,13 +163,13 @@
test.List.push.front <- function(){
- funx <- cfunction( signature(x = "list"),
+ funx <- cppfunction( signature(x = "list"),
'
List list(x) ;
list.push_front( 10 ) ;
list.push_front( "bar", "foo" ) ;
return list ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
d <- list( x = 1:10, y = letters[1:10] )
res <- funx( d )
checkEquals( res,
@@ -187,13 +179,13 @@
# test.List.insert <- function(){
#
-# funx <- cfunction( signature(x = "list"),
+# funx <- cppfunction( signature(x = "list"),
# '
# List list(x) ;
# list.insert( list.begin(), 10 ) ;
# list.insert( list.end(), Named("foo", "bar" ) ) ;
# return list ;
-# ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+# ' )
# d <- list( x = 1:10, y = letters[1:10] )
# res <- funx( d )
# checkEquals( res,
@@ -203,12 +195,12 @@
test.List.erase <- function(){
- funx <- cfunction( signature(x = "list"),
+ funx <- cppfunction( signature(x = "list"),
'
List list(x) ;
list.erase( list.begin() ) ;
return list ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
d <- list( x = 1:10, y = letters[1:10] )
res <- funx( d )
checkEquals( res,
@@ -218,12 +210,12 @@
test.List.erase.range <- function(){
- funx <- cfunction( signature(x = "list"),
+ funx <- cppfunction( signature(x = "list"),
'
List list(x) ;
list.erase( 0, 1 ) ;
return list ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
d <- list( x = 1:10, y = letters[1:10], z = 1:10 )
res <- funx( d )
checkEquals( res,
@@ -233,13 +225,13 @@
test.List.implicit.push.back <- function(){
- funx <- cfunction( signature(),
+ funx <- cppfunction( signature(),
'
List list ;
list["foo"] = 10 ;
list["bar" ] = "foobar" ;
return list ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(), list( foo = 10, bar = "foobar" ), msg = "List implicit push back" )
}
Modified: pkg/Rcpp/inst/unitTests/runit.IntegerVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.IntegerVector.R 2010-04-15 10:00:10 UTC (rev 1050)
+++ pkg/Rcpp/inst/unitTests/runit.IntegerVector.R 2010-04-15 10:49:52 UTC (rev 1051)
@@ -17,62 +17,53 @@
# 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(){
- suppressMessages( require( inline ) )
-}
-
test.IntegerVector <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
IntegerVector x(10) ;
for( int i=0; i<10; i++) x[i] = i ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
checkEquals( funx(), 0:9, msg = "IntegerVector" )
}
test.IntegerVector.INTSXP <- function(){
- funx <- cfunction(signature(vec = "integer" ), '
+ funx <- cppfunction(signature(vec = "integer" ), '
IntegerVector x(vec) ;
for( int i=0; i<x.size(); i++) {
x[i] = x[i]*2 ;
}
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
checkEquals( funx(0:9), 2*0:9, msg = "IntegerVector( INTSXP) " )
}
test.IntegerVector.initializer.list <- function(){
if( Rcpp:::capabilities()[["initializer lists"]] ){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
IntegerVector x = {0,1,2,3} ;
for( int i=0; i<x.size(); i++) x[i] = x[i]*2 ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE,
- includes = "using namespace Rcpp;",
- cxxargs = "-std=c++0x" )
+ return x ;', cxxargs = "-std=c++0x" )
checkEquals( funx(), 2*0:3, msg = "IntegerVector( initializer list) " )
}
}
test.IntegerVector.matrix.indexing <- function(){
- funx <- cfunction(signature(x = "integer" ), '
+ funx <- cppfunction(signature(x = "integer" ), '
IntegerVector m(x) ;
int trace = 0.0 ;
for( size_t i=0 ; i<4; i++){
trace += m(i,i) ;
}
return wrap( trace ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
x <- matrix( 1:16, ncol = 4 )
checkEquals( funx(x), sum(diag(x)), msg = "matrix indexing" )
- funx <- cfunction(signature(x = "integer" ), '
+ funx <- cppfunction(signature(x = "integer" ), '
IntegerVector m(x) ;
for( size_t i=0 ; i<4; i++){
m(i,i) = 2 * i ;
}
return m ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( diag(funx(x)), 2*0:3, msg = "matrix indexing lhs" )
@@ -82,23 +73,23 @@
test.IntegerVector.Dimension.constructor <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
return IntegerVector( Dimension( 5 ) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(),
integer(5) ,
msg = "IntegerVector( Dimension(5))" )
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
return IntegerVector( Dimension( 5, 5 ) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(),
matrix( 0L, ncol = 5, nrow = 5) ,
msg = "IntegerVector( Dimension(5,5))" )
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
return IntegerVector( Dimension( 2, 3, 4) ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(),
array( 0L, dim = c(2,3,4) ) ,
msg = "IntegerVector( Dimension(2,3,4))" )
@@ -106,69 +97,67 @@
test.IntegerVector.range.constructors <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
int x[] = { 0, 1, 2, 3 } ;
IntegerVector y( x, x+4 ) ;
return y;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(), 0:3, msg = "assign(int*, int*)" )
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
std::vector<int> vec(4) ;
for( size_t i = 0; i<4; i++) vec[i] = i;
IntegerVector y( vec.begin(), vec.end() ) ;
return y;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx(), 0:3, msg = "assign(int*, int*)" )
}
test.IntegerVector.names.set <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
IntegerVector y(2) ;
std::vector<std::string> names(2) ;
names[0] = "foo" ;
names[1] = "bar" ;
y.names() = names ;
return y ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( names(funx()), c("foo", "bar"),
msg = "Vector::names" )
}
test.IntegerVector.names.get <- function(){
- funx <- cfunction(signature(x = "integer"), '
+ funx <- cppfunction(signature(x = "integer"), '
IntegerVector y(x) ;
return y.names() ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
checkEquals( funx( c("foo" = 1L, "bar" = 2L) ), c("foo", "bar"),
msg = "Vector::names get" )
}
test.IntegerVector.names.indexing <- function(){
- funx <- cfunction(signature(x = "integer"), '
+ funx <- cppfunction(signature(x = "integer"), '
IntegerVector y(x) ;
return wrap( y["foo"] ) ;
- ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ ' )
x <- c( "foo" = 1L, "bar" = 2L )
checkEquals( funx( x ), 1L, msg = "IntegerVector names based indexing" )
}
test.IntegerVector.comma <- function(){
- funx <- cfunction(signature(), '
+ funx <- cppfunction(signature(), '
IntegerVector x(4) ;
x = 0, 1, 2, 3 ;
- return x ;',
- Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ return x ;' )
checkEquals( funx(), 0:3, msg = "IntegerVector comma initialization" )
}
test.IntegerVector.push.back <- function(){
- funx <- cfunction(signature(x = "integer"), '
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rcpp -r 1051
More information about the Rcpp-commits
mailing list