[Rcpp-commits] r3894 - in pkg/Rcpp: . inst inst/unitTests tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Nov 4 20:57:04 CET 2012
Author: edd
Date: 2012-11-04 20:57:04 +0100 (Sun, 04 Nov 2012)
New Revision: 3894
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/NEWS.Rd
pkg/Rcpp/inst/unitTests/runit.DataFrame.R
pkg/Rcpp/inst/unitTests/runit.Date.R
pkg/Rcpp/inst/unitTests/runit.Matrix.R
pkg/Rcpp/inst/unitTests/runit.RObject.R
pkg/Rcpp/inst/unitTests/runit.S4.R
pkg/Rcpp/inst/unitTests/runit.Vector.R
pkg/Rcpp/inst/unitTests/runit.as.R
pkg/Rcpp/inst/unitTests/runit.misc.R
pkg/Rcpp/inst/unitTests/runit.stats.R
pkg/Rcpp/inst/unitTests/runit.sugar.R
pkg/Rcpp/inst/unitTests/runit.sugarOps.R
pkg/Rcpp/inst/unitTests/runit.wrap.R
pkg/Rcpp/tests/doRUnit.R
Log:
default test behaviour now set via a release number-based heuristic:
- when a fourth minor number is seen, tests are turned on
- that gives reasonable defaults for CRAN ("no expensive tests") and
development (maximum testing)
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/ChangeLog 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,3 +1,10 @@
+2012-11-04 Dirk Eddelbuettel <edd at debian.org>
+
+ * tests/doRUnit.R: In "development releases" (such as 0.9.15.5) we
+ now default to setting the required CRAN-test-workaround-kludge
+ "RunAllRcppTests" to "yes" as a default -- but not for actual
+ releases (with versions such as 0.9.15)
+
2012-11-04 Romain Francois <romain at r-enthusiasts.com>
* include/Rcpp/module/CppFunction.h: fixed module bug (virtual function
@@ -5,7 +12,7 @@
2012-11-03 JJ Allaire <jj at rstudio.org>
- * Use CLINK_CPPFLAGS rather than PKG_CXXFLAGS for LinkingTo
+ * Use CLINK_CPPFLAGS rather than PKG_CXXFLAGS for LinkingTo
include directories (identical behavior to inline)
2012-11-03 Romain Francois <romain at r-enthusiasts.com>
@@ -31,7 +38,7 @@
s/get_function_ptr/get_function/
2012-11-01 Dirk Eddelbuettel <edd at debian.org>
-
+
* inst/unitTests/runit.rmath.R: New unit test file added
2012-11-01 JJ Allaire <jj at rstudio.org>
Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/NEWS.Rd 2012-11-04 19:57:04 UTC (rev 3894)
@@ -12,6 +12,9 @@
compileAttributes() that use C++11 style attributes (embedded in
comments) to make declaring and using C++ functions in R much
more straightforward.
+ \item Development releases set RunAllRcppTests to yes to run all
+ tests (unless it was alredy set to 'no'), CRAN releases do not and
+ still require setting which helps with the desired CRAN default.
}
}
Modified: pkg/Rcpp/inst/unitTests/runit.DataFrame.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.DataFrame.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.DataFrame.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,7 +1,7 @@
#!/usr/bin/r -t
# -*- mode: R; tab-width: 4; -*-
#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -18,6 +18,10 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
list("FromSEXP"=list(
signature(x="ANY"),
@@ -156,3 +160,4 @@
checkEquals( fun(), DF, msg = "DataFrame create2 stringsAsFactors = false")
}
+}
Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,7 +1,7 @@
#!/usr/bin/r -t
# -*- mode: R; tab-width: 4; -*-
#
-# Copyright (C) 2010, 2012 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -18,6 +18,10 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function() {
list( "ctor_sexp"=list(
signature(d="Date"),
@@ -305,3 +309,5 @@
posixtNA <- as.POSIXct(NA, origin="1970-01-01")
checkEquals(fun(vec), c(now, rep(posixtNA, 3), now+2.345), msg = "Datetime.ctor.set")
}
+
+}
Modified: pkg/Rcpp/inst/unitTests/runit.Matrix.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Matrix.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.Matrix.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,6 +1,6 @@
#!/usr/bin/r -t
#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -17,9 +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/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
list(
- "matrix_numeric" = list(
+ "matrix_numeric" = list(
signature(x = "matrix" ), '
NumericMatrix m(x) ;
double trace = 0.0 ;
@@ -27,9 +31,9 @@
trace += m(i,i) ;
}
return wrap( trace ) ;
- '
- ),
- "matrix_character" = list(
+ '
+ ),
+ "matrix_character" = list(
signature(x = "matrix" ), '
CharacterMatrix m(x) ;
std::string trace ;
@@ -38,8 +42,8 @@
}
return wrap( trace ) ;
'
- ),
- "matrix_generic" = list(
+ ),
+ "matrix_generic" = list(
signature(x = "matrix" ), '
GenericMatrix m(x) ;
List output( m.ncol() ) ;
@@ -48,27 +52,27 @@
}
return output ;
'
- ),
- "matrix_integer_diag" = list(
- signature(),
- 'return IntegerMatrix::diag( 5, 1 ) ; '
- ),
- "matrix_character_diag" = list(
- signature(),
+ ),
+ "matrix_integer_diag" = list(
+ signature(),
+ 'return IntegerMatrix::diag( 5, 1 ) ; '
+ ),
+ "matrix_character_diag" = list(
+ signature(),
'return CharacterMatrix::diag( 5, "foo" ) ;'
- ),
- "matrix_numeric_ctor1" = list(
- signature(),
+ ),
+ "matrix_numeric_ctor1" = list(
+ signature(),
'
NumericMatrix m(3);
return m;
'
- ),
- "matrix_numeric_ctor2" = list(
+ ),
+ "matrix_numeric_ctor2" = list(
signature(), '
NumericMatrix m(3,3);
return m;
- '
+ '
),
"integer_matrix_indexing"=list(
signature(x = "integer" ),
@@ -86,55 +90,55 @@
m(i,i) = 2 * i ;
}
return m ; '
- ),
-
-
- "runit_NumericMatrix_row" = list(
- signature(x = "matrix" ),
+ ),
+
+
+ "runit_NumericMatrix_row" = list(
+ signature(x = "matrix" ),
'
NumericMatrix m(x) ;
NumericMatrix::Row first_row = m.row(0) ;
return wrap( std::accumulate( first_row.begin(), first_row.end(), 0.0 ) ) ;
- '),
- "runit_CharacterMatrix_row" = list(
- signature(x = "matrix" ),
+ '),
+ "runit_CharacterMatrix_row" = list(
+ signature(x = "matrix" ),
'
CharacterMatrix m(x) ;
CharacterMatrix::Row first_row = m.row(0) ;
- std::string res(
- std::accumulate(
+ std::string res(
+ std::accumulate(
first_row.begin(), first_row.end(), std::string() ) ) ;
return wrap(res) ;
- '
- ),
- "runit_GenericMatrix_row" = list(
- signature(x = "matrix" ),
'
+ ),
+ "runit_GenericMatrix_row" = list(
+ signature(x = "matrix" ),
+ '
GenericMatrix m(x) ;
GenericMatrix::Row first_row = m.row(0) ;
IntegerVector out( first_row.size() ) ;
- std::transform(
+ std::transform(
first_row.begin(), first_row.end(),
- out.begin(),
+ out.begin(),
unary_call<SEXP,int>( Function("length" ) ) ) ;
return wrap(out) ;
'
),
- "runit_NumericMatrix_column" = list(
- signature(x = "matrix" ),
+ "runit_NumericMatrix_column" = list(
+ signature(x = "matrix" ),
'
NumericMatrix m(x) ;
NumericMatrix::Column col = m.column(0) ;
return wrap( std::accumulate( col.begin(), col.end(), 0.0 ) ) ;
- '
- ),
- "runit_NumericMatrix_cumsum" = list(
- signature(x = "matrix" ),
'
+ ),
+ "runit_NumericMatrix_cumsum" = list(
+ signature(x = "matrix" ),
+ '
NumericMatrix input( x ) ;
int nr = input.nrow(), nc = input.ncol() ;
NumericMatrix output(nr, nc) ;
-
+
NumericVector tmp( nr );
for( int i=0; i<nc; i++){
tmp = tmp + input.column(i) ;
@@ -143,72 +147,72 @@
}
return output ;
'
- ),
- "runit_CharacterMatrix_column" = list(
+ ),
+ "runit_CharacterMatrix_column" = list(
signature(x = "matrix" ),
'
CharacterMatrix m(x) ;
CharacterMatrix::Column col = m.column(0) ;
- std::string res(
- std::accumulate(
+ std::string res(
+ std::accumulate(
col.begin(), col.end(), std::string() ) ) ;
return wrap(res) ;
- '
- ),
- "runit_GenericMatrix_column" = list(
- signature(x = "matrix" ),
+ '
+ ),
+ "runit_GenericMatrix_column" = list(
+ signature(x = "matrix" ),
'
GenericMatrix m(x) ;
GenericMatrix::Column col = m.column(0) ;
IntegerVector out( col.size() ) ;
- std::transform(
+ std::transform(
col.begin(), col.end(),
- out.begin(),
+ out.begin(),
unary_call<SEXP,int>( Function("length" ) ) ) ;
return wrap(out) ;
- '
- ),
- "runit_Row_Column_sugar" = list(
- signature( x_ = "matrix" ),
+ '
+ ),
+ "runit_Row_Column_sugar" = list(
+ signature( x_ = "matrix" ),
'
NumericMatrix x( x_) ;
NumericVector r0 = x.row(0) ;
NumericVector c0 = x.column(0) ;
- return List::create(
- r0,
- c0,
- x.row(1),
- x.column(1),
+ return List::create(
+ r0,
+ c0,
+ x.row(1),
+ x.column(1),
x.row(1) + x.column(1)
) ;
'
- ),
- "runit_NumericMatrix_colsum" = list(
- signature( x = "matrix" ),
+ ),
+ "runit_NumericMatrix_colsum" = list(
+ signature( x = "matrix" ),
'
NumericMatrix input( x ) ;
int nc = input.ncol() ;
NumericMatrix output = clone<NumericMatrix>( input ) ;
for( int i=1; i<nc; i++){
- output(_,i) = output(_,i-1) + input(_,i) ;
+ output(_,i) = output(_,i-1) + input(_,i) ;
}
return output ;
'
- ),
- "runit_NumericMatrix_rowsum" = list(
- signature( x = "matrix" ),
+ ),
+ "runit_NumericMatrix_rowsum" = list(
+ signature( x = "matrix" ),
'
NumericMatrix input( x ) ;
int nr = input.nrow();
NumericMatrix output = clone<NumericMatrix>( input ) ;
for( int i=1; i<nr; i++){
- output(i,_) = output(i-1,_) + input(i,_) ;
+ output(i,_) = output(i-1,_) + input(i,_) ;
}
return output ;
'
- ),
- "runit_SubMatrix" = list(
- signature(),
+ ),
+ "runit_SubMatrix" = list(
+ signature(),
'
NumericMatrix xx(4, 5);
xx(0,0) = 3;
@@ -231,8 +235,8 @@
.setUp <- function() {
tests <- ".rcpp.Matrix"
if( ! exists( tests, globalenv() )) {
- fun <- Rcpp:::compile_unit_tests(
- definitions(),
+ fun <- Rcpp:::compile_unit_tests(
+ definitions(),
cxxargs = cxxargs()
)
assign( tests, fun, globalenv() )
@@ -244,15 +248,15 @@
funx <- .rcpp.Matrix$runit_Row_Column_sugar
x <- matrix( 1:16+.5, nc = 4 )
res <- funx( x )
- target <- list(
- x[1,],
- x[,1],
+ target <- list(
+ x[1,],
+ x[,1],
x[2,],
- x[,2],
+ x[,2],
x[2,] + x[,2]
)
checkEquals( res, target, msg = "column and row as sugar" )
-
+
}
test.NumericMatrix <- function(){
@@ -317,7 +321,7 @@
}
-
+
test.NumericMatrix.row <- function(){
funx <- .rcpp.Matrix$runit_NumericMatrix_row
x <- matrix( 1:16 + .5, ncol = 4 )
@@ -335,7 +339,7 @@
m <- lapply( 1:16, function(i) seq(from=1, to = i ) )
dim( m ) <- c( 4, 4 )
checkEquals( funx( m ), 1 + 0:3*4, msg = "List::Row" )
-
+
}
test.NumericMatrix.column <- function(){
@@ -382,3 +386,4 @@
}
+}
Modified: pkg/Rcpp/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RObject.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.RObject.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,7 +1,7 @@
#!/usr/bin/r -t
# -*- mode: R; tab-width: 4; -*-
#
-# Copyright (C) 2009 - 2010 Romain Francois and Dirk Eddelbuettel
+# Copyright (C) 2009 - 2012 Romain Francois and Dirk Eddelbuettel
#
# This file is part of Rcpp.
#
@@ -18,6 +18,10 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
list("asDouble"=list(
signature(x="numeric"),
@@ -345,3 +349,5 @@
class(x) <- c("foo", "bar" )
checkTrue( fx(x) )
}
+
+}
Modified: pkg/Rcpp/inst/unitTests/runit.S4.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.S4.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.S4.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,6 +1,6 @@
#!/usr/bin/r -t
#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 -2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -17,9 +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/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
list(
- "S4_methods" = list(
+ "S4_methods" = list(
signature(x = "ANY" ), '
RObject y(x) ;
List res(5) ;
@@ -30,66 +34,66 @@
res[4] = y.slot("y") ;
return res ;
'
- ),
- "S4_getslots" = list(
+ ),
+ "S4_getslots" = list(
signature(x = "ANY" ), '
RObject y(x) ;
y.slot( "x" ) = 10.0 ;
y.slot( "y" ) = 20.0 ;
return R_NilValue ;
'
- ),
- "S4_setslots" = list(
+ ),
+ "S4_setslots" = list(
signature(x = "ANY" ), '
RObject y(x) ;
y.slot( "foo" ) = 10.0 ;
return R_NilValue ;
'
- ),
- "S4_setslots_2" = list(
+ ),
+ "S4_setslots_2" = list(
signature(x = "ANY" ), '
RObject y(x) ;
y.slot( "foo" ) ;
return R_NilValue ;
'
- ),
- "S4_ctor" = list(
- signature( clazz = "character" ),
+ ),
+ "S4_ctor" = list(
+ signature( clazz = "character" ),
'
std::string cl = as<std::string>( clazz );
- return S4( cl );
- '
- ),
- "S4_is" = list(
+ return S4( cl );
+ '
+ ),
+ "S4_is" = list(
signature(tr="ANY"), '
S4 o(tr) ;
return wrap( o.is( "track" ) ) ;
'
- ),
- "S4_is_2" = list(
+ ),
+ "S4_is_2" = list(
signature(tr="ANY"), '
S4 o(tr) ;
return wrap( o.is( "trackCurve" ) ) ;
'
- ),
+ ),
"S4_slotproxy" = list(
- signature(tr="ANY"),
+ signature(tr="ANY"),
' S4 o(tr); return NumericVector(o.slot("x")); '
- ),
- "S4_attrproxy" = list(
- signature(tr="ANY"),
+ ),
+ "S4_attrproxy" = list(
+ signature(tr="ANY"),
' IntegerVector o(tr); return CharacterVector(o.attr("foo")); '
- ),
- "S4_dotdata" = list(
- signature( x = "ANY" ),
+ ),
+ "S4_dotdata" = list(
+ signature( x = "ANY" ),
'
- S4 foo( x ) ;
- foo.slot( ".Data" ) = "foooo" ;
+ S4 foo( x ) ;
+ foo.slot( ".Data" ) = "foooo" ;
return foo ;
'
)
)
-
+
}
cxxargs <- function(){
@@ -99,9 +103,9 @@
.setUp <- function() {
tests <- ".rcpp.S4"
if( ! exists( tests, globalenv() )) {
- fun <- Rcpp:::compile_unit_tests(
- definitions(),
- cxxargs = cxxargs()
+ fun <- Rcpp:::compile_unit_tests(
+ definitions(),
+ cxxargs = cxxargs()
)
assign( tests, fun, globalenv() )
}
@@ -115,18 +119,18 @@
checkEquals( fx(tr),
list( TRUE, TRUE, FALSE, 2.0, 2.0 )
, msg = "slot management" )
-
+
fx <- .rcpp.S4$S4_getslots
fx( tr )
checkEquals( tr at x, 10.0 , msg = "slot('x') = 10" )
checkEquals( tr at y, 20.0 , msg = "slot('y') = 20" )
-
+
fx <- .rcpp.S4$S4_setslots
checkException( fx( tr ), msg = "slot does not exist" )
-
+
fx <- .rcpp.S4$S4_setslots_2
checkException( fx( tr ), msg = "slot does not exist" )
-
+
}
test.S4 <- function(){
@@ -136,7 +140,7 @@
fx <- cxxfunction( signature( x = "ANY" ),
'S4 o(x); return o.slot( "x" ) ;', plugin = "Rcpp" )
checkEquals( fx( tr ), 2, msg = "S4( SEXP )" )
-
+
checkException( fx( list( x = 2, y = 3 ) ), msg = "not S4" )
checkException( fx( structure( list( x = 2, y = 3 ), class = "track" ) ), msg = "S3 is not S4" )
@@ -152,43 +156,44 @@
test.S4.is <- function(){
setClass("track", representation(x="numeric", y="numeric"))
setClass("trackCurve", representation(smooth = "numeric"), contains = "track")
-
+
tr1 <- new( "track", x = 2, y = 3 )
tr2 <- new( "trackCurve", x = 2, y = 3, smooth = 5 )
-
+
fx <- .rcpp.S4$S4_is
checkTrue( fx( tr1 ), msg = 'track is track' )
checkTrue( fx( tr2 ), msg = 'trackCurve is track' )
-
+
fx <- .rcpp.S4$S4_is_2
checkTrue( !fx( tr1 ), msg = 'track is not trackCurve' )
checkTrue( fx( tr2 ), msg = 'trackCurve is trackCurve' )
-
+
}
test.Vector.SlotProxy.ambiguity <- function(){
setClass("track", representation(x="numeric", y="numeric"))
setClass("trackCurve", representation(smooth = "numeric"), contains = "track")
-
+
tr1 <- new( "track", x = 2, y = 3 )
fx <- .rcpp.S4$S4_slotproxy
checkEquals( fx(tr1), 2, "Vector( SlotProxy ) ambiguity" )
-
+
}
test.Vector.AttributeProxy.ambiguity <- function(){
x <- 1:10
attr( x, "foo" ) <- "bar"
-
+
fx <- .rcpp.S4$S4_attrproxy
checkEquals( fx(x), "bar", "Vector( AttributeProxy ) ambiguity" )
-
+
}
test.S4.dotdataslot <- function(){
setClass( "Foo", contains = "character", representation( x = "numeric" ) )
fx <- .rcpp.S4$S4_dotdata
foo <- fx( new( "Foo", "bla", x = 10 ) )
- checkEquals( as.character( foo) , "foooo" )
+ checkEquals( as.character( foo) , "foooo" )
}
+}
Modified: pkg/Rcpp/inst/unitTests/runit.Vector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -18,6 +18,10 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
f <- list(
"raw_" = list(
@@ -1360,3 +1364,5 @@
checkEquals(fun(x, "bar"), FALSE, msg = "containsElementNamed without element")
checkEquals(fun(x, ""), FALSE, msg = "containsElementNamed with empty element")
}
+
+}
Modified: pkg/Rcpp/inst/unitTests/runit.as.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.as.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.as.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,6 +1,6 @@
#!/usr/bin/r -t
#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -17,62 +17,66 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function() {
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) ;
@@ -173,3 +177,4 @@
checkEquals( fun(1:10), sum(1:10) , msg = "as<list<int>>( INTSXP ) " )
}
+}
Modified: pkg/Rcpp/inst/unitTests/runit.misc.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.misc.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.misc.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,6 +1,6 @@
#!/usr/bin/r -t
#
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -17,73 +17,77 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
list(
- "symbol_" = list(
- signature(),
+ "symbol_" = list(
+ signature(),
'
SEXP res = PROTECT( Rf_allocVector( LGLSXP, 4) ) ;
/* SYMSXP */
LOGICAL(res)[0] = Symbol( Rf_install("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
-
+
/* CHARSXP */
LOGICAL(res)[1] = Symbol( Rf_mkChar("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
-
+
/* STRSXP */
LOGICAL(res)[2] = Symbol( Rf_mkString("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
-
+
/* std::string */
LOGICAL(res)[3] = Symbol( "foobar" ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
-
+
UNPROTECT(1) ; /* res */
return res ;
'
- ),
- "symbol_ctor" = list(
- signature(x="ANY"),
- 'return Symbol(x);'
- ),
- "Argument_" = list(
- signature(),
+ ),
+ "symbol_ctor" = list(
+ signature(x="ANY"),
+ 'return Symbol(x);'
+ ),
+ "Argument_" = list(
+ signature(),
'
Argument x("x");
Argument y("y");
-
+
return List::create( x = 2, y = 3 );
'
- ),
- "Dimension_const" = list(
- signature( ia = "integer" ),
+ ),
+ "Dimension_const" = list(
+ signature( ia = "integer" ),
'
simple ss(ia);
return wrap(ss.nrow());
'
- ),
- "evaluator_error" = list(
- signature(),
+ ),
+ "evaluator_error" = list(
+ signature(),
'
return Rcpp::Evaluator::run( Rf_lang2( Rf_install("stop"), Rf_mkString( "boom" ) ) ) ;
'
- ),
- "evaluator_ok" = list(
+ ),
+ "evaluator_ok" = list(
signature(x="integer"), '
return Rcpp::Evaluator::run( Rf_lang2( Rf_install("sample"), x ) ) ;
'
- ),
- "exceptions_" = list(
+ ),
+ "exceptions_" = list(
signature(), '
throw std::range_error("boom") ;
return R_NilValue ;
'
)
- )
+ )
}
includes <- function(){
"
-
+
using namespace std;
-
+
class simple {
Rcpp::Dimension dd;
public:
@@ -101,8 +105,8 @@
.setUp <- function() {
tests <- ".rcpp.misc"
if( ! exists( tests, globalenv() )) {
- fun <- Rcpp:::compile_unit_tests(
- definitions(),
+ fun <- Rcpp:::compile_unit_tests(
+ definitions(),
includes = includes(),
cxxargs = cxxargs()
)
@@ -112,7 +116,7 @@
test.Symbol <- function(){
funx <- .rcpp.misc$symbol_
- res <- funx()
+ res <- funx()
checkTrue( res[1L], msg = "Symbol creation - SYMSXP " )
checkTrue( res[2L], msg = "Symbol creation - CHARSXP " )
checkTrue( res[3L], msg = "Symbol creation - STRSXP " )
@@ -140,7 +144,7 @@
# http://article.gmane.org/gmane.comp.lang.r.rcpp/327
funx <- .rcpp.misc$Dimension_const
checkEquals( funx( c(2L, 2L)) , 2L, msg = "testing const operator[]" )
-
+
}
test.evaluator.error <- function(){
@@ -152,19 +156,19 @@
funx <- .rcpp.misc$evaluator_ok
checkEquals( sort(funx(1:10)), 1:10, msg = "Evaluator running fine" )
}
-
+
test.exceptions <- function(){
can.demangle <- Rcpp:::capabilities()[["demangling"]]
-
+
funx <- .rcpp.misc$exceptions_
e <- tryCatch( funx(), "C++Error" = function(e) e )
checkTrue( "C++Error" %in% class(e), msg = "exception class C++Error" )
-
+
if( can.demangle ){
checkTrue( "std::range_error" %in% class(e), msg = "exception class std::range_error" )
}
checkEquals( e$message, "boom", msg = "exception message" )
-
+
if( can.demangle ){
# same with direct handler
e <- tryCatch( funx(), "std::range_error" = function(e) e )
@@ -174,19 +178,19 @@
}
f <- function(){
try( funx(), silent = TRUE)
- "hello world"
+ "hello world"
}
checkEquals( f(), "hello world", msg = "life continues after an exception" )
-
+
}
test.has.iterator <- function(){
-
- classes <- c( "std::vector<int>", "std::list<int>", "std::deque<int>",
- "std::set<int>", "std::map<std::string,int>",
- "std::pair<std::string,int>",
+
+ classes <- c( "std::vector<int>", "std::list<int>", "std::deque<int>",
+ "std::set<int>", "std::map<std::string,int>",
+ "std::pair<std::string,int>",
"Rcpp::Symbol"
)
code <- lapply( classes, function(.){
@@ -198,15 +202,16 @@
signatures <- rep( list(signature()), 7 )
names( code ) <- names( signatures ) <- sprintf( "runit_has_iterator_%d", 1:7 )
fx <- cxxfunction( signatures, code, plugin = "Rcpp" )
-
+
checkTrue( fx$runit_has_iterator_1() , msg = "has_iterator< std::vector<int> >" )
checkTrue( fx$runit_has_iterator_2() , msg = "has_iterator< std::ist<int> >" )
checkTrue( fx$runit_has_iterator_3() , msg = "has_iterator< std::deque<int> >" )
checkTrue( fx$runit_has_iterator_4() , msg = "has_iterator< std::set<int> >" )
checkTrue( fx$runit_has_iterator_5() , msg = "has_iterator< std::map<string,int> >" )
-
+
checkTrue( ! fx$runit_has_iterator_6(), msg = "has_iterator< std::pair<string,int> >" )
checkTrue( ! fx$runit_has_iterator_7(), msg = "Rcpp::Symbol" )
-
+
}
+}
Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,7 +1,7 @@
#!/usr/bin/r -t
# -*- mode: R; tab-width: 4; -*-
#
-# Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -18,6 +18,10 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
list(
"runit_dbeta" = list(
@@ -614,3 +618,4 @@
# TODO: test.stats.qgamma
# TODO: test.stats.(dq)chisq
+}
Modified: pkg/Rcpp/inst/unitTests/runit.sugar.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -18,6 +18,10 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
list(
"runit_abs" = list(
@@ -1376,3 +1380,5 @@
checkEquals( fx(x, 2), signif(x, 2) )
checkEquals( fx(x, 3), signif(x, 3) )
}
+
+}
Modified: pkg/Rcpp/inst/unitTests/runit.sugarOps.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugarOps.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.sugarOps.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -18,6 +18,10 @@
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function() {
list(
"vector_scalar_ops" = list(signature(x = "numeric"),
@@ -122,3 +126,5 @@
## checkEquals(fx(x) , x + 2)
## #checkEquals(fx(x) , x ) # DUMMY
## }
+
+}
Modified: pkg/Rcpp/inst/unitTests/runit.wrap.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.wrap.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/inst/unitTests/runit.wrap.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -1,6 +1,6 @@
#!/usr/bin/r -t
#
-# Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -17,8 +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/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
definitions <- function(){
-f <- list("map_string_int"=list(
+
+ f <- list("map_string_int"=list(
signature(),
'std::map< std::string, int > m ;
m["b"] = 100;
@@ -353,5 +358,5 @@
} # if( Rcpp:::capabilities("tr1 unordered maps") )
+}
-
Modified: pkg/Rcpp/tests/doRUnit.R
===================================================================
--- pkg/Rcpp/tests/doRUnit.R 2012-11-04 13:30:37 UTC (rev 3893)
+++ pkg/Rcpp/tests/doRUnit.R 2012-11-04 19:57:04 UTC (rev 3894)
@@ -40,20 +40,26 @@
if (require("RUnit", quietly = TRUE)) {
pkg <- "Rcpp" # code below for Rcpp
- require( pkg, character.only=TRUE)
+ require(pkg, character.only=TRUE)
path <- system.file("unitTests", package = pkg)
stopifnot(file.exists(path), file.info(path.expand(path))$isdir)
## without this, we get unit test failures
Sys.setenv( R_TESTS = "" )
- ## force all tests to be executed if commented-out
- #Sys.setenv("RunAllRcppTests"="yes")
+ ## force tests to be executed if in dev release which we define as
+ ## having a sub-release, eg 0.9.15.5 is one whereas 0.9.16 is not
+ if (length(strsplit(packageDescription(pkg)$Version, "\\.")[[1]]) > 3) { # dev release, and
+ if (Sys.getenv("RunAllRcppTests") != "no") { # if env.var not yet set
+ message("Setting \"RunAllRcppTests\"=\"yes\" for development release\n")
+ Sys.setenv("RunAllRcppTests"="yes")
+ }
+ }
Rcpp.unit.test.output.dir <- getwd()
source(file.path(path, "runTests.R"), echo = TRUE)
} else {
- print( "package RUnit not available, cannot run unit tests" )
+ print("package RUnit not available, cannot run unit tests")
}
More information about the Rcpp-commits
mailing list