[Rcpp-commits] r3647 - in pkg/Rcpp: inst/unitTests inst/unitTests/testRcppClass/R inst/unitTests/testRcppModule/R tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 29 05:38:12 CEST 2012
Author: edd
Date: 2012-06-29 05:38:12 +0200 (Fri, 29 Jun 2012)
New Revision: 3647
Modified:
pkg/Rcpp/inst/unitTests/runTests.R
pkg/Rcpp/inst/unitTests/runit.Function.R
pkg/Rcpp/inst/unitTests/runit.Language.R
pkg/Rcpp/inst/unitTests/runit.Module.client.package.R
pkg/Rcpp/inst/unitTests/runit.environments.R
pkg/Rcpp/inst/unitTests/runit.macros.R
pkg/Rcpp/inst/unitTests/runit.modref.R
pkg/Rcpp/inst/unitTests/runit.rcout.R
pkg/Rcpp/inst/unitTests/runit.support.R
pkg/Rcpp/inst/unitTests/testRcppClass/R/load.R
pkg/Rcpp/inst/unitTests/testRcppModule/R/zzz.R
pkg/Rcpp/tests/doRUnit.R
Log:
another overhault of unit tests in light of requirement to run fewer (!!) by default
Modified: pkg/Rcpp/inst/unitTests/runTests.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runTests.R 2012-06-27 15:06:04 UTC (rev 3646)
+++ pkg/Rcpp/inst/unitTests/runTests.R 2012-06-29 03:38:12 UTC (rev 3647)
@@ -57,7 +57,7 @@
## TODO: actually prioritize which ones we want
## for now, expensive tests (eg Modules, client packages) are skipped
- allTests <- function() {
+ checkForAllTests <- function() {
if (exists( "argv", globalenv() ) && "--allTests" %in% argv) {
Sys.setenv("RunAllRcppTests"="yes")
return(TRUE)
@@ -75,7 +75,9 @@
## testSuite$testFileRegexp <- "^runit\\.[D-Z].+\\.[rR]$"
## }
- allTests() # see if we want to set shortcut flag
+ if (Sys.getenv("RunAllRcppTests") == "") { # if env.var not yet set
+ checkForAllTests() # see if we want to set flag
+ }
if (interactive()) {
cat("Now have RUnit Test Suite 'testSuite' for package '", pkg,
Modified: pkg/Rcpp/inst/unitTests/runit.Function.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Function.R 2012-06-27 15:06:04 UTC (rev 3646)
+++ pkg/Rcpp/inst/unitTests/runit.Function.R 2012-06-29 03:38:12 UTC (rev 3647)
@@ -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(
"function_" = list(
@@ -148,3 +152,4 @@
checkEquals( stats:::.asSparse, exportedfunc, msg = "namespace_env(Function)" )
}
+}
Modified: pkg/Rcpp/inst/unitTests/runit.Language.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Language.R 2012-06-27 15:06:04 UTC (rev 3646)
+++ pkg/Rcpp/inst/unitTests/runit.Language.R 2012-06-29 03:38:12 UTC (rev 3647)
@@ -1,6 +1,7 @@
#!/usr/bin/r -t
+# hey emacs, please make this use -*- 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.
#
@@ -17,19 +18,23 @@
# 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_language" = list(
+ list(
+ "runit_language" = list(
signature(x="ANY"), 'return Language(x) ;'
- ),
- "runit_lang_variadic_1" = list(
+ ),
+ "runit_lang_variadic_1" = list(
signature(), 'return Language( "rnorm", 10, 0.0, 2.0 ) ; '
- ),
- "runit_lang_variadic_2" = list(
+ ),
+ "runit_lang_variadic_2" = list(
signature(), 'return Language( "rnorm", 10, Named("mean",0.0), 2.0 ) ; '
- ),
- "runit_lang_push_back" = list(
- signature(),
+ ),
+ "runit_lang_push_back" = list(
+ signature(),
'
Language call("rnorm") ;
call.push_back( 10 ) ;
@@ -37,19 +42,19 @@
call.push_back( 2.0 ) ;
return call ;
'
- ),
- "runit_lang_square_rv" = list(
- signature(),
+ ),
+ "runit_lang_square_rv" = list(
+ signature(),
'
Language p("rnorm") ;
p.push_back( 1 ) ;
p.push_back( 10.0 ) ;
p.push_back( 20.0 ) ;
return p[2] ;
- '
+ '
),
- "runit_lang_square_lv" = list(
- signature(),
+ "runit_lang_square_lv" = list(
+ signature(),
'
Language p("rnorm") ;
p.push_back( 1 ) ;
@@ -59,101 +64,101 @@
p[2] = p[3] ;
return p ;
'
- ),
- "runit_lang_fun" = list(
- signature(g = "function", x = "numeric"),
+ ),
+ "runit_lang_fun" = list(
+ signature(g = "function", x = "numeric"),
'
Function fun(g) ;
Language call( fun );
call.push_back(x) ;
return Rf_eval( call, R_GlobalEnv ) ;
'
- ),
- "runit_lang_inputop" = list(
- signature(),
+ ),
+ "runit_lang_inputop" = list(
+ signature(),
'
Language call( "rnorm" );
call << 10 << Named( "sd", 10 ) ;
return call ;
'
- ),
- "runit_lang_unarycall" = list(
- signature(y = "integer" ),
+ ),
+ "runit_lang_unarycall" = list(
+ signature(y = "integer" ),
'
Language call( "seq", Named("from", 10 ), Named("to", 0 ) ) ;
IntegerVector x(y) ;
List output( x.size() ) ;
- std::transform(
- x.begin(), x.end(),
+ std::transform(
+ x.begin(), x.end(),
output.begin(),
unary_call<int>(call)
) ;
return output ;
- '
- ),
- "runit_lang_unarycallindex" = list(
- signature(y = "integer" ),
'
+ ),
+ "runit_lang_unarycallindex" = list(
+ signature(y = "integer" ),
+ '
Language call( "seq", 10, 0 ) ;
IntegerVector x(y) ;
List output( x.size() ) ;
- std::transform(
- x.begin(), x.end(),
+ std::transform(
+ x.begin(), x.end(),
output.begin(),
unary_call<int>(call,2)
) ;
return output ;
'
- ),
- "runit_lang_binarycall" = list(
- signature(y1 = "integer", y2 = "integer" ),
+ ),
+ "runit_lang_binarycall" = list(
+ signature(y1 = "integer", y2 = "integer" ),
'
Language call( "seq", Named("from", 10 ), Named("to", 0 ) ) ;
IntegerVector x1(y1) ;
IntegerVector x2(y2) ;
List output( x1.size() ) ;
- std::transform(
+ std::transform(
x1.begin(), x1.end(), x2.begin(),
output.begin(),
binary_call<int,int>(call)
) ;
return output ;
- '
- ),
- "runit_lang_fixedcall" = list(
- signature(),
'
+ ),
+ "runit_lang_fixedcall" = list(
+ signature(),
+ '
Language call( Function("rnorm"), 10 ) ;
std::vector< std::vector<double> > result(10) ;
- std::generate(
- result.begin(), result.end(),
+ std::generate(
+ result.begin(), result.end(),
fixed_call< std::vector<double> >(call)
) ;
return wrap( result );
'
- ),
- "runit_lang_inenv" = list(
- signature(x = "environment" ),
+ ),
+ "runit_lang_inenv" = list(
+ signature(x = "environment" ),
'
Environment env(x) ;
Language call( "sum", Symbol("y") ) ;
return call.eval( env ) ;
'
- ),
- "runit_pairlist" = list(
+ ),
+ "runit_pairlist" = list(
signature(x="ANY"),
'return Pairlist(x) ;'
- ),
- "runit_pl_variadic_1" = list(
- signature(),
+ ),
+ "runit_pl_variadic_1" = list(
+ signature(),
'return Pairlist( "rnorm", 10, 0.0, 2.0 ) ;'
- ),
- "runit_pl_variadic_2" = list(
- signature(),
+ ),
+ "runit_pl_variadic_2" = list(
+ signature(),
'return Pairlist( "rnorm", 10, Named("mean",0.0), 2.0 ) ;'
- ),
- "runit_pl_push_front" = list(
- signature(),
+ ),
+ "runit_pl_push_front" = list(
+ signature(),
'
Pairlist p ;
p.push_front( 1 ) ;
@@ -162,9 +167,9 @@
p.push_front( Named( "foobar", 10) ) ;
return p ;
'
- ),
- "runit_pl_push_back" = list(
- signature(),
+ ),
+ "runit_pl_push_back" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
@@ -173,29 +178,29 @@
p.push_back( Named( "foobar", 10) ) ;
return p ;
'
- ),
- "runit_pl_insert" = list(
- signature(),
+ ),
+ "runit_pl_insert" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
p.push_back( 10.0 ) ;
p.push_back( 20.0 ) ;
-
+
/* insert in 2nd position */
p.insert( 1, Named( "bla", "bla" ) ) ;
-
+
/* insert in front */
p.insert( 0, 30.0 ) ;
-
+
/* insert in back */
p.insert( 5, "foobar" ) ;
-
+
return p ;
'
- ),
- "runit_pl_replace" = list(
- signature(),
+ ),
+ "runit_pl_replace" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
@@ -206,9 +211,9 @@
p.replace( 2, false ) ;
return p ;
'
- ),
- "runit_pl_size" = list(
- signature(),
+ ),
+ "runit_pl_size" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
@@ -216,9 +221,9 @@
p.push_back( 20.0 ) ;
return wrap( p.size() ) ;
'
- ),
- "runit_pl_remove_1" = list(
- signature(),
+ ),
+ "runit_pl_remove_1" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
@@ -227,9 +232,9 @@
p.remove( 0 ) ;
return p ;
'
- ),
- "runit_pl_remove_2" = list(
- signature(),
+ ),
+ "runit_pl_remove_2" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
@@ -238,9 +243,9 @@
p.remove( 2 ) ;
return p ;
'
- ),
- "runit_pl_remove_3" = list(
- signature(),
+ ),
+ "runit_pl_remove_3" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
@@ -249,9 +254,9 @@
p.remove( 1 ) ;
return p ;
'
- ),
- "runit_pl_square_1" = list(
- signature(),
+ ),
+ "runit_pl_square_1" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
@@ -259,9 +264,9 @@
p.push_back( 20.0 ) ;
return p[1] ;
'
- ),
- "runit_pl_square_2" = list(
- signature(),
+ ),
+ "runit_pl_square_2" = list(
+ signature(),
'
Pairlist p ;
p.push_back( 1 ) ;
@@ -271,21 +276,21 @@
p[2] = p[0] ;
return p ;
'
- ),
-
- "runit_formula_" = list(
+ ),
+
+ "runit_formula_" = list(
signature(), '
Formula f( "x ~ y + z" ) ;
return f;
- '
- ),
- "runit_formula_SEXP" = list(
+ '
+ ),
+ "runit_formula_SEXP" = list(
signature( form = "ANY" ), '
Formula f(form) ;
return f;
'
)
-
+
)
}
@@ -296,7 +301,7 @@
}
}
-
+
test.Language <- function(){
funx <- .rcpp.language$runit_language
checkEquals( funx( call("rnorm") ), call("rnorm" ), msg = "Language( LANGSXP )" )
@@ -310,19 +315,19 @@
test.Language.variadic <- function(){
funx <- .rcpp.language$runit_lang_variadic_1
- checkEquals( funx(), call("rnorm", 10L, 0.0, 2.0 ),
+ checkEquals( funx(), call("rnorm", 10L, 0.0, 2.0 ),
msg = "variadic templates" )
-
+
funx <- .rcpp.language$runit_lang_variadic_2
- checkEquals( funx(), call("rnorm", 10L, mean = 0.0, 2.0 ),
+ checkEquals( funx(), call("rnorm", 10L, mean = 0.0, 2.0 ),
msg = "variadic templates (with names)" )
}
# same as about but without variadic templates
test.Language.push.back <- function(){
funx <- .rcpp.language$runit_lang_push_back
- checkEquals( funx(),
- call("rnorm", 10L, mean = 0.0, 2.0 ),
+ checkEquals( funx(),
+ call("rnorm", 10L, mean = 0.0, 2.0 ),
msg = "Language::push_back" )
}
@@ -346,29 +351,29 @@
test.Language.unary.call <- function(){
funx <- .rcpp.language$runit_lang_unarycall
- checkEquals(
- funx( 1:10 ),
- lapply( 1:10, function(n) seq(from=n, to = 0 ) ),
+ checkEquals(
+ funx( 1:10 ),
+ lapply( 1:10, function(n) seq(from=n, to = 0 ) ),
msg = "c++ lapply using calls" )
-
+
}
test.Language.unary.call.index <- function(){
funx <- .rcpp.language$runit_lang_unarycallindex
- checkEquals(
- funx( 1:10 ),
- lapply( 1:10, function(n) seq(from=10, to = n ) ),
+ checkEquals(
+ funx( 1:10 ),
+ lapply( 1:10, function(n) seq(from=10, to = n ) ),
msg = "c++ lapply using calls" )
-
+
}
test.Language.binary.call <- function(){
funx <- .rcpp.language$runit_lang_binarycall
- checkEquals(
- funx( 1:10, 11:20 ),
- lapply( 1:10, function(n) seq(n, n+10) ),
+ checkEquals(
+ funx( 1:10, 11:20 ),
+ lapply( 1:10, function(n) seq(n, n+10) ),
msg = "c++ lapply using calls" )
-
+
}
test.Language.fixed.call <- function(){
@@ -395,47 +400,47 @@
checkEquals( funx(TRUE), as.pairlist( TRUE) , msg = "Pairlist( LGLSXP )" )
checkEquals( funx(1.3), as.pairlist(1.3), msg = "Pairlist( REALSXP) " )
checkEquals( funx(as.raw(1) ), as.pairlist(as.raw(1)), msg = "Pairlist( RAWSXP)" )
-
+
checkException( funx(funx), msg = "Pairlist not compatible with function" )
checkException( funx(new.env()), msg = "Pairlist not compatible with environment" )
-
+
}
test.Pairlist.variadic <- function(){
funx <- .rcpp.language$runit_pl_variadic_1
- checkEquals( funx(), pairlist("rnorm", 10L, 0.0, 2.0 ),
+ checkEquals( funx(), pairlist("rnorm", 10L, 0.0, 2.0 ),
msg = "variadic templates" )
-
+
funx <- .rcpp.language$runit_pl_variadic_2
- checkEquals( funx(), pairlist("rnorm", 10L, mean = 0.0, 2.0 ),
+ checkEquals( funx(), pairlist("rnorm", 10L, mean = 0.0, 2.0 ),
msg = "variadic templates (with names)" )
}
test.Pairlist.push.front <- function(){
funx <- .rcpp.language$runit_pl_push_front
- checkEquals( funx(),
- pairlist( foobar = 10, "foo", 10.0, 1L),
+ checkEquals( funx(),
+ pairlist( foobar = 10, "foo", 10.0, 1L),
msg = "Pairlist::push_front" )
}
test.Pairlist.push.back <- function(){
funx <- .rcpp.language$runit_pl_push_back
- checkEquals( funx(),
- pairlist( 1L, 10.0, "foo", foobar = 10),
+ checkEquals( funx(),
+ pairlist( 1L, 10.0, "foo", foobar = 10),
msg = "Pairlist::push_back" )
}
test.Pairlist.insert <- function(){
funx <- .rcpp.language$runit_pl_insert
- checkEquals( funx(),
- pairlist( 30.0, 1L, bla = "bla", 10.0, 20.0, "foobar" ),
+ checkEquals( funx(),
+ pairlist( 30.0, 1L, bla = "bla", 10.0, 20.0, "foobar" ),
msg = "Pairlist::replace" )
}
test.Pairlist.replace <- function(){
funx <- .rcpp.language$runit_pl_replace
checkEquals( funx(),
- pairlist( first = 1, 20.0 , FALSE), msg = "Pairlist::replace" )
+ pairlist( first = 1, 20.0 , FALSE), msg = "Pairlist::replace" )
}
test.Pairlist.size <- function(){
@@ -446,13 +451,13 @@
test.Pairlist.remove <- function(){
funx <- .rcpp.language$runit_pl_remove_1
checkEquals( funx(), pairlist(10.0, 20.0), msg = "Pairlist::remove(0)" )
-
+
funx <- .rcpp.language$runit_pl_remove_2
checkEquals( funx(), pairlist(1L, 10.0), msg = "Pairlist::remove(0)" )
-
+
funx <- .rcpp.language$runit_pl_remove_3
checkEquals( funx(), pairlist(1L, 20.0), msg = "Pairlist::remove(0)" )
-
+
}
test.Pairlist.square <- function(){
@@ -478,3 +483,4 @@
checkEquals( funx( list( x ~ y + z) ), x ~ y + z, msg = "Formula( SEXP = VECSXP(1 = formula) )" )
}
+}
Modified: pkg/Rcpp/inst/unitTests/runit.Module.client.package.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.client.package.R 2012-06-27 15:06:04 UTC (rev 3646)
+++ pkg/Rcpp/inst/unitTests/runit.Module.client.package.R 2012-06-29 03:38:12 UTC (rev 3647)
@@ -35,70 +35,76 @@
if (.runThisTest && Rcpp:::capabilities()[["Rcpp modules"]] && ! .badOSX && ! .onWindows) {
- test.Module.package <- function( ){
+ ## ## added test for 'testRcppClass' example of extending C++ classes via R
+ test.Class.package <- function( ){
td <- tempfile()
cwd <- getwd()
dir.create( td )
- file.copy( system.file( "unitTests", "testRcppModule", package = "Rcpp" ) , td, recursive = TRUE)
+ file.copy( system.file( "unitTests", "testRcppClass", package = "Rcpp" ) , td, recursive = TRUE)
setwd( td )
on.exit( { setwd( cwd) ; unlink( td, recursive = TRUE ) } )
R <- shQuote( file.path( R.home( component = "bin" ), "R" ))
- cmd <- paste( R , "CMD build testRcppModule" )
- system( cmd ) # quieten this by suppressing output
+ cmd <- paste( R , "CMD build testRcppClass" )
+ system( cmd )
dir.create( "templib" )
- install.packages( "testRcppModule_0.1.tar.gz",
- "templib", repos = NULL, type = "source" )
- require( "testRcppModule", "templib", character.only = TRUE )
+ install.packages( "testRcppClass_0.1.tar.gz", "templib", repos = NULL, type = "source" )
+ require( "testRcppClass", "templib", character.only = TRUE )
- v <- new(vec) # stdVector module
+ v <- stdNumeric$new()
data <- 1:10
v$assign(data)
- v[[3]] <- v[[3]] + 1
+ v$set(3L, v$at(3L) + 1)
+
data[[4]] <- data[[4]] +1
+
checkEquals( v$as.vector(), data )
- y <- new(World) # Yada module
- y$set("quick brown fox") # which y$greet() would
- checkEquals(y$greet(), "quick brown fox")
+ ## a few function calls
+ checkEquals( bar(2), 4)
+ checkEquals( foo(2,3), 6)
- checkEquals(bar(2), 4)
- checkEquals(foo(2,3), 6)
-
- nm <- new(Num) # NumEx module
- nm$x <- 3.14
- checkEquals(nm$x, 3.14)
}
- ## ## added test for 'testRcppClass' example of extending C++ classes via R
- ## test.Class.package <- function( ){
+ ## Module test disabled as it is essentially the same (minus the
+ ## Rcpp Class bit), and we get dynamic library mixups loading one
+ ## after the other
+
+ ## test.Module.package <- function( ){
+
## td <- tempfile()
## cwd <- getwd()
## dir.create( td )
- ## file.copy( system.file( "unitTests", "testRcppClass", package = "Rcpp" ) , td, recursive = TRUE)
+ ## file.copy( system.file( "unitTests", "testRcppModule", package = "Rcpp" ) , td, recursive = TRUE)
## setwd( td )
## on.exit( { setwd( cwd) ; unlink( td, recursive = TRUE ) } )
## R <- shQuote( file.path( R.home( component = "bin" ), "R" ))
- ## cmd <- paste( R , "CMD build testRcppClass" )
- ## system( cmd )
+ ## cmd <- paste( R , "CMD build testRcppModule" )
+ ## system( cmd ) # quieten this by suppressing output
## dir.create( "templib" )
- ## install.packages( "testRcppClass_0.1.tar.gz", "templib", repos = NULL, type = "source" )
- ## require( "testRcppClass", "templib", character.only = TRUE )
+ ## install.packages("testRcppModule_0.1.tar.gz", "templib") #, repos = NULL, type = "source" )
+ ## require( "testRcppModule", "templib", character.only = TRUE )
- ## v <- stdNumeric$new()
+ ## v <- new(vec) # stdVector module
## data <- 1:10
## v$assign(data)
- ## v$set(3L, v$at(3L) + 1)
-
+ ## v[[3]] <- v[[3]] + 1
## data[[4]] <- data[[4]] +1
-
## checkEquals( v$as.vector(), data )
- ## ## a few function calls
- ## checkEquals( bar(2), 4)
- ## checkEquals( foo(2,3), 6)
+ ## y <- new(World) # Yada module
+ ## y$set("quick brown fox") # which y$greet() would
+ ## checkEquals(y$greet(), "quick brown fox")
+ ## checkEquals(bar(2), 4)
+ ## checkEquals(foo(2,3), 6)
+
+ ## nm <- new(Num) # NumEx module
+ ## nm$x <- 3.14
+ ## checkEquals(nm$x, 3.14)
+
+ ## detach("package:testRcppModule")
## }
}
Modified: pkg/Rcpp/inst/unitTests/runit.environments.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.environments.R 2012-06-27 15:06:04 UTC (rev 3646)
+++ pkg/Rcpp/inst/unitTests/runit.environments.R 2012-06-29 03:38:12 UTC (rev 3647)
@@ -1,6 +1,7 @@
#!/usr/bin/r -t
+# hey emacs, please make this use -*- tab-width: 4 -*-
#
-# Copyright (C) 2009 - 2010 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2009 - 2012 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
@@ -17,47 +18,51 @@
# 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_ls" = list(
- signature(x="environment"),
+ list(
+ "runit_ls" = list(
+ signature(x="environment"),
'
- Rcpp::Environment env(x) ;
+ Rcpp::Environment env(x) ;
return env.ls(true) ;
- ' ),
- "runit_ls2" = list(
+ ' ),
+ "runit_ls2" = list(
signature(x="environment"),
'
- Rcpp::Environment env(x) ;
+ Rcpp::Environment env(x) ;
return env.ls(false) ;
- '
- ),
- "runit_get" = list(
+ '
+ ),
+ "runit_get" = list(
signature(x="environment", name = "character" ),
'
Environment env(x) ;
return env.get( as<std::string>(name) ) ;
'
- ),
- "runit_exists" = list(
- signature(x="environment", name = "character" ),
+ ),
+ "runit_exists" = list(
+ signature(x="environment", name = "character" ),
'
Environment env(x) ;
std::string st = as< std::string >(name) ;
return wrap( env.exists( st ) ) ;
'
- ),
- "runit_assign" =list(
- signature(x="environment", name = "character", object = "ANY" ),
+ ),
+ "runit_assign" =list(
+ signature(x="environment", name = "character", object = "ANY" ),
'
Environment env(x) ;
std::string st = as< std::string>(name) ;
return wrap( env.assign(st, object) ) ;
- '
- ),
- "runit_islocked" = list(
- signature(x="environment" ),
'
+ ),
+ "runit_islocked" = list(
+ signature(x="environment" ),
+ '
Environment env(x) ;
env.assign( "x1", 1 ) ;
env.assign( "x2", 10.0 ) ;
@@ -66,115 +71,115 @@
std::vector< std::string > aa(2) ; aa[0] = "foo" ; aa[1] = "bar" ;
env.assign( "x5", aa ) ;
return R_NilValue ;
- '
- ),
- "runit_bindingIsActive" = list(
- signature(x="environment", name = "character" ),
'
+ ),
+ "runit_bindingIsActive" = list(
+ signature(x="environment", name = "character" ),
+ '
Environment env(x) ;
std::string st = as<std::string>(name);
return wrap( env.bindingIsActive(st) ) ;
- '
- ),
- "runit_bindingIsLocked" = list(
- signature(x="environment", name = "character" ),
'
+ ),
+ "runit_bindingIsLocked" = list(
+ signature(x="environment", name = "character" ),
+ '
Environment env(x) ;
std::string st = as<std::string>(name) ;
return wrap( env.bindingIsLocked(st) ) ;
- '
- ),
- "runit_notanenv" = list(
- signature(x="ANY"),
+ '
+ ),
+ "runit_notanenv" = list(
+ signature(x="ANY"),
'Rcpp::Environment env(x) ;'
- ),
- "runit_lockbinding" = list(
- signature(x="environment", name = "character" ),
+ ),
+ "runit_lockbinding" = list(
+ signature(x="environment", name = "character" ),
'
Environment env(x) ;
std::string st = as<std::string>(name) ;
env.lockBinding( st ) ;
return R_NilValue ;
- '
- ),
- "runit_unlockbinding" = list(
- signature(x="environment", name = "character" ),
'
+ ),
+ "runit_unlockbinding" = list(
+ signature(x="environment", name = "character" ),
+ '
Environment env(x) ;
std::string st = as<std::string>(name) ;
env.unlockBinding( st ) ;
return R_NilValue ;
- '
- ),
- "runit_globenv" = list(
- signature(),
+ '
+ ),
+ "runit_globenv" = list(
+ signature(),
'return Rcpp::Environment::global_env(); '
- ),
- "runit_emptyenv" = list(
- signature(),
+ ),
+ "runit_emptyenv" = list(
+ signature(),
'return Rcpp::Environment::empty_env(); '
- ),
- "runit_baseenv" = list(
- signature(),
+ ),
+ "runit_baseenv" = list(
+ signature(),
'return Rcpp::Environment::base_env(); '
- ),
- "runit_namespace" = list(
- signature(env = "character" ),
+ ),
+ "runit_namespace" = list(
+ signature(env = "character" ),
'
std::string st = as<std::string>(env) ;
- return Environment::namespace_env(st);
- '
- ),
- "runit_env_SEXP" = list(
- signature( env = "ANY" ),
+ return Environment::namespace_env(st);
+ '
+ ),
+ "runit_env_SEXP" = list(
+ signature( env = "ANY" ),
'return Environment( env ) ;'
- ),
- "runit_env_string" = list(
- signature( env = "character" ),
+ ),
+ "runit_env_string" = list(
+ signature( env = "character" ),
'
std::string st = as<std::string>( env ) ;
return Environment( st ) ;
'
- ),
- "runit_env_int" = list(
- signature( env = "integer" ),
+ ),
+ "runit_env_int" = list(
+ signature( env = "integer" ),
'
int pos = as<int>(env) ;
return Environment( pos ) ;
'
- ),
- "runit_parent" = list(
- signature( env = "environment" ),
+ ),
+ "runit_parent" = list(
+ signature( env = "environment" ),
'
return Environment(env).parent() ;
- '
- ),
- "runit_remove" = list(
+ '
+ ),
+ "runit_remove" = list(
signature( env = "environment", name = "character" ),
'
bool res = Environment(env).remove( as<std::string>(name) ) ;
return wrap( res ) ;
'
- ),
- "runit_square" = list(
- signature( env = "environment" ),
+ ),
+ "runit_square" = list(
+ signature( env = "environment" ),
'
Environment e(env) ;
List out(3) ;
out[0] = e["x"] ;
e["y"] = 2 ;
out[1] = e["y"] ;
- e["x"] = "foo";
+ e["x"] = "foo";
out[2] = e["x"] ;
return out ;
- '
- ),
- "runit_Rcpp" = list(
- signature(),
+ '
+ ),
+ "runit_Rcpp" = list(
+ signature(),
'return Environment::Rcpp_namespace() ; '
- ),
- "runit_child" = list(
- signature(),
+ ),
+ "runit_child" = list(
+ signature(),
'
Environment global_env = Environment::global_env() ;
return global_env.new_child(false) ;
@@ -189,7 +194,7 @@
assign( ".rcpp.environments", fun, globalenv() )
}
}
-
+
test.environment.ls <- function(){
funx <- .rcpp.environments$runit_ls
e <- new.env( )
@@ -197,28 +202,28 @@
e$b <- "foo"
e$.c <- "hidden"
checkEquals( sort(funx(e)), sort(c("a","b", ".c")), msg = "Environment::ls(true)" )
- checkEquals( funx(asNamespace("Rcpp")), ls(envir=asNamespace("Rcpp"), all = TRUE),
+ checkEquals( funx(asNamespace("Rcpp")), ls(envir=asNamespace("Rcpp"), all = TRUE),
msg = "Environment(namespace)::ls()" )
-
+
funx <- .rcpp.environments$runit_ls2
checkEquals( funx(e), c("a","b"), msg = "Environment::ls(false)" )
- checkEquals( funx(asNamespace("Rcpp")), ls(envir=asNamespace("Rcpp"), all = FALSE),
+ checkEquals( funx(asNamespace("Rcpp")), ls(envir=asNamespace("Rcpp"), all = FALSE),
msg = "Environment(namespace)::ls()" )
-
+
}
test.environment.get <- function(){
funx <- .rcpp.environments$runit_get
-
+
e <- new.env( )
e$a <- 1:10
e$b <- "foo"
-
+
checkEquals( funx( e, "a" ), e$a, msg = "Environment::get()" )
checkEquals( funx( e, "foobar" ), NULL, msg = "Environment::get()" )
- checkEquals( funx( asNamespace("Rcpp"), "CxxFlags"), Rcpp:::CxxFlags,
+ checkEquals( funx( asNamespace("Rcpp"), "CxxFlags"), Rcpp:::CxxFlags,
msg = "Environment(namespace)::get() " )
-
+
}
test.environment.exists <- function(){
@@ -226,10 +231,10 @@
e <- new.env( )
e$a <- 1:10
e$b <- "foo"
-
+
checkTrue( funx( e, "a" ), msg = "Environment::get()" )
checkTrue( !funx( e, "foobar" ), msg = "Environment::get()" )
- checkTrue( funx( asNamespace("Rcpp"), "CxxFlags"),
+ checkTrue( funx( asNamespace("Rcpp"), "CxxFlags"),
msg = "Environment(namespace)::get() " )
}
@@ -241,16 +246,16 @@
checkEquals( ls(e), c("a", "b"), msg = "Environment::assign, checking names" )
checkEquals( e$a, 1:10, msg = "Environment::assign, checking value 1" )
checkEquals( e$b, Rcpp:::CxxFlags, msg = "Environment::assign, checking value 2" )
-
+
lockBinding( "a", e )
can.demangle <- Rcpp:::capabilities()[["demangling"]]
if( can.demangle ){
- checkTrue(
- tryCatch( { funx(e, "a", letters ) ; FALSE}, "Rcpp::binding_is_locked" = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "a", letters ) ; FALSE}, "Rcpp::binding_is_locked" = function(e) TRUE ),
msg = "cannot assign to locked binding (catch exception)" )
} else {
- checkTrue(
- tryCatch( { funx(e, "a", letters ) ; FALSE}, "error" = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "a", letters ) ; FALSE}, "error" = function(e) TRUE ),
msg = "cannot assign to locked binding (catch exception)" )
}
}
@@ -270,19 +275,19 @@
funx <- .rcpp.environments$runit_bindingIsActive
e <- new.env()
e$a <- 1:10
- makeActiveBinding( "b", function(x) 10, e )
+ makeActiveBinding( "b", function(x) 10, e )
checkTrue( !funx(e, "a" ), msg = "Environment::bindingIsActive( non active ) -> false" )
checkTrue( funx(e, "b" ), msg = "Environment::bindingIsActive( active ) -> true" )
can.demangle <- Rcpp:::capabilities()[["demangling"]]
if( can.demangle ){
- checkTrue(
- tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ),
msg = "Environment::bindingIsActive(no binding) -> exception)" )
} else {
- checkTrue(
- tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ),
msg = "Environment::bindingIsActive(no binding) -> exception)" )
}
}
@@ -293,18 +298,18 @@
e$a <- 1:10
e$b <- letters
lockBinding( "b", e )
-
+
checkTrue( !funx(e, "a" ), msg = "Environment::bindingIsActive( non active ) -> false" )
checkTrue( funx(e, "b" ), msg = "Environment::bindingIsActive( active ) -> true" )
can.demangle <- Rcpp:::capabilities()[["demangling"]]
if( can.demangle ){
- checkTrue(
- tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ),
msg = "Environment::bindingIsLocked(no binding) -> exception)" )
} else {
- checkTrue(
- tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ),
msg = "Environment::bindingIsLocked(no binding) -> exception)" )
}
}
@@ -327,12 +332,12 @@
can.demangle <- Rcpp:::capabilities()[["demangling"]]
if( can.demangle ){
- checkTrue(
- tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ),
msg = "Environment::lockBinding(no binding) -> exception)" )
} else {
- checkTrue(
- tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ),
msg = "Environment::lockBinding(no binding) -> exception)" )
}
}
@@ -348,12 +353,12 @@
can.demangle <- Rcpp:::capabilities()[["demangling"]]
if( can.demangle ){
- checkTrue(
- tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ),
msg = "Environment::unlockBinding(no binding) -> exception)" )
} else {
- checkTrue(
- tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ),
msg = "Environment::unlockBinding(no binding) -> exception)" )
}
}
@@ -384,12 +389,12 @@
can.demangle <- Rcpp:::capabilities()[["demangling"]]
if( can.demangle ){
- checkTrue(
- tryCatch( { funx("----" ) ; FALSE}, "Rcpp::no_such_namespace" = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx("----" ) ; FALSE}, "Rcpp::no_such_namespace" = function(e) TRUE ),
msg = "Environment::namespace_env(no namespace) -> exception)" )
} else {
- checkTrue(
- tryCatch( { funx("----" ) ; FALSE}, error = function(e) TRUE ),
+ checkTrue(
+ tryCatch( { funx("----" ) ; FALSE}, error = function(e) TRUE ),
msg = "Environment::namespace_env(no namespace) -> exception)" )
}
}
@@ -399,11 +404,11 @@
checkEquals( funx( globalenv() ), globalenv(), msg = "Environment( environment ) - 1" )
checkEquals( funx( baseenv() ), baseenv(), msg = "Environment( environment ) - 2" )
checkEquals( funx( asNamespace("Rcpp") ), asNamespace("Rcpp"), msg = "Environment( environment ) - 3" )
-
+
checkEquals( funx( ".GlobalEnv" ), globalenv(), msg = "Environment( character ) - 1" )
checkEquals( funx( "package:base" ), baseenv(), msg = "Environment( character ) - 2" )
checkEquals( funx( "package:Rcpp" ), as.environment("package:Rcpp") , msg = 'Environment( "package:Rcpp") ' )
-
+
checkEquals( funx(1L), globalenv(), msg = "Environment( SEXP{integer} )" )
}
@@ -411,15 +416,15 @@
funx <- .rcpp.environments$runit_env_string
checkEquals( funx( ".GlobalEnv" ), globalenv(), msg = "Environment( std::string ) - 1" )
checkEquals( funx( "package:base" ), baseenv(), msg = "Environment( std::string ) - 2" )
- checkEquals( funx( "package:Rcpp" ), as.environment("package:Rcpp") ,
+ checkEquals( funx( "package:Rcpp" ), as.environment("package:Rcpp") ,
msg = 'Environment( std::string ) - 3' )
-
+
}
test.environment.constructor.int <- function(){
funx <- .rcpp.environments$runit_env_int
for( i in 1:length(search())){
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rcpp -r 3647
More information about the Rcpp-commits
mailing list