Skip to content

Commit e44831b

Browse files
eddelbuetteleddelbuettel
committed
unit test improvements
 - Rcpp:::test() repaired / simplified by relying on existing RUnit framework rather than reinventing it; now works again for installed package - Rcpp::unitTestSetup() renamed for consistency from unit_test_setup
1 parent a944046 commit e44831b

27 files changed

+2647
-2644
lines changed

‎R/unit.tests.R

Lines changed: 25 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
# Copyright (C) 2010 - 2013 Dirk Eddelbuettel and Romain Francois
1+
# Copyright (C) 2010 - 2014 Dirk Eddelbuettel and Romain Francois
22
#
33
# This file is part of Rcpp.
44
#
@@ -15,34 +15,36 @@
1515
# You should have received a copy of the GNU General Public License
1616
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
1717

18-
run_unit_tests <- function( output = if( file.exists( "/tmp" ) ) "/tmp" else getwd(), package = "Rcpp" ){
19-
if( !file.exists( output ) ){
20-
stop( "output directory does not exist" )
21-
}
18+
test <- function(output=if(file.exists("/tmp")) "/tmp" else getwd()) {
19+
if (require(RUnit)) {
20+
testSuite <- defineTestSuite(name="Rcpp Unit Tests",
21+
dirs=system.file("unitTests", package = "Rcpp"),
22+
testFuncRegexp = "^[Tt]est.+")
2223

23-
Rscript <- file.path( R.home( component = "bin" ), "Rscript" )
24-
if( .Platform$OS.type == "windows" ){
25-
Rscript <- sprintf( "%s.exe", Rscript )
26-
}
27-
test.script <- system.file( "unitTests", "runTests.R", package = package )
28-
cmd <- sprintf( '"%s" "%s" --output=%s', Rscript, test.script, output )
29-
system( cmd )
30-
}
24+
## if someoone calls Rcpp::test(), he/she wants all tests
25+
Sys.setenv("RunAllRcppTests"="yes")
3126

32-
test <- function( output = if( file.exists( "/tmp" ) ) "/tmp" else getwd() ){
33-
message( "test is deprecated, use `run_unit_test` instead" )
34-
run_unit_tests( output, "Rcpp" )
27+
## Run tests
28+
tests <- runTestSuite(testSuite)
29+
30+
## Print results
31+
printTextProtocol(tests)
32+
33+
return(tests)
34+
}
35+
36+
stop("Running unit tests requires the 'RUnit' package.")
3537
}
3638

37-
unit_test_setup <- function(file, packages = NULL) {
38-
function(){
39-
if( !is.null(packages) ){
40-
for( p in packages ){
41-
suppressMessages( require( p, character.only = TRUE ) )
39+
unitTestSetup <- function(file, packages=NULL,
40+
pathToRcppTests=system.file("unitTests", package = "Rcpp")) {
41+
function() {
42+
if (! is.null(packages)) {
43+
for (p in packages) {
44+
suppressMessages(require(p, character.only=TRUE))
4245
}
4346
}
44-
if (!exists("pathRcppTests")) pathRcppTests <- getwd()
45-
sourceCpp(file.path(pathRcppTests, "cpp", file ))
47+
sourceCpp(file.path(pathToRcppTests, "cpp", file))
4648
}
4749
}
4850

‎inst/NEWS.Rd

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,9 @@
4444
\itemize{
4545
\item The file \code{tests/doRUnit.R} was rewritten following the
4646
pattern deployed in \cpkg{RProtoBuf} which is due to Murray Stokely
47+
\item The function \code{test()} was rewritten; it provides an
48+
easy entry point to running unit tests of the installed package
49+
}
4750
}
4851
}
4952

‎inst/unitTests/runTests.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -43,9 +43,7 @@ if (require("RUnit", quietly = TRUE)) {
4343
## --- Testing ---
4444

4545
## Define tests
46-
testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs = path
47-
# , testFileRegexp = "Vector"
48-
)
46+
testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs = path)
4947

5048
## TODO: actually prioritize which ones we want
5149
## for now, expensive tests (eg Modules, client packages) are skipped

‎inst/unitTests/runit.DataFrame.R

Lines changed: 49 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
#!/usr/bin/r -t
22
# -*- mode: R; tab-width: 4; -*-
33
#
4-
# Copyright (C) 2010 - 2013 Dirk Eddelbuettel and Romain Francois
4+
# Copyright (C) 2010 - 2014 Dirk Eddelbuettel and Romain Francois
55
#
66
# This file is part of Rcpp.
77
#
@@ -22,64 +22,64 @@
2222

2323
if (.runThisTest) {
2424

25-
.setUp <- Rcpp:::unit_test_setup( "DataFrame.cpp" )
25+
.setUp <- Rcpp:::unitTestSetup("DataFrame.cpp")
2626

27-
test.DataFrame.FromSEXP <- function() {
28-
DF <- data.frame(a=1:3, b=c("a","b","c"))
29-
checkEquals( FromSEXP(DF), DF, msg = "DataFrame pass-through")
30-
}
27+
test.DataFrame.FromSEXP <- function() {
28+
DF <- data.frame(a=1:3, b=c("a","b","c"))
29+
checkEquals( FromSEXP(DF), DF, msg = "DataFrame pass-through")
30+
}
3131

32-
test.DataFrame.index.byName <- function() {
33-
DF <- data.frame(a=1:3, b=c("a","b","c"))
34-
checkEquals( index_byName(DF, "a"), DF$a, msg = "DataFrame column by name 'a'")
35-
checkEquals( index_byName(DF, "b"), DF$b, msg = "DataFrame column by name 'b'")
36-
}
32+
test.DataFrame.index.byName <- function() {
33+
DF <- data.frame(a=1:3, b=c("a","b","c"))
34+
checkEquals( index_byName(DF, "a"), DF$a, msg = "DataFrame column by name 'a'")
35+
checkEquals( index_byName(DF, "b"), DF$b, msg = "DataFrame column by name 'b'")
36+
}
3737

38-
test.DataFrame.index.byPosition <- function() {
39-
DF <- data.frame(a=1:3, b=c("a","b","c"))
40-
checkEquals( index_byPosition(DF, 0), DF$a, msg = "DataFrame column by position 0")
41-
checkEquals( index_byPosition(DF, 1), DF$b, msg = "DataFrame column by position 1")
42-
}
38+
test.DataFrame.index.byPosition <- function() {
39+
DF <- data.frame(a=1:3, b=c("a","b","c"))
40+
checkEquals( index_byPosition(DF, 0), DF$a, msg = "DataFrame column by position 0")
41+
checkEquals( index_byPosition(DF, 1), DF$b, msg = "DataFrame column by position 1")
42+
}
4343

44-
test.DataFrame.string.element <- function() {
45-
DF <- data.frame(a=1:3, b=c("a","b","c"), stringsAsFactors=FALSE)
46-
checkEquals( string_element(DF), DF[2,"b"], msg = "DataFrame string element")
47-
}
44+
test.DataFrame.string.element <- function() {
45+
DF <- data.frame(a=1:3, b=c("a","b","c"), stringsAsFactors=FALSE)
46+
checkEquals( string_element(DF), DF[2,"b"], msg = "DataFrame string element")
47+
}
4848

49-
test.DataFrame.CreateOne <- function() {
50-
DF <- data.frame(a=1:3)
51-
checkEquals( createOne(), DF, msg = "DataFrame create1")
52-
}
49+
test.DataFrame.CreateOne <- function() {
50+
DF <- data.frame(a=1:3)
51+
checkEquals( createOne(), DF, msg = "DataFrame create1")
52+
}
5353

54-
test.DataFrame.CreateTwo <- function() {
55-
DF <- data.frame(a=1:3, b=c("a","b","c"))
56-
checkEquals( createTwo(), DF, msg = "DataFrame create2")
57-
}
54+
test.DataFrame.CreateTwo <- function() {
55+
DF <- data.frame(a=1:3, b=c("a","b","c"))
56+
checkEquals( createTwo(), DF, msg = "DataFrame create2")
57+
}
5858

59-
test.DataFrame.SlotProxy <- function(){
60-
setClass("track", representation(x="data.frame", y = "function"))
61-
df <- data.frame( x = 1:10, y = 1:10 )
62-
tr1 <- new( "track", x = df, y = rnorm )
63-
checkTrue( identical( SlotProxy(tr1, "x"), df ), msg = "DataFrame( SlotProxy )" )
64-
checkException( SlotProxy(tr1, "y"), msg = "DataFrame( SlotProxy ) -> exception" )
65-
}
59+
test.DataFrame.SlotProxy <- function(){
60+
setClass("track", representation(x="data.frame", y = "function"))
61+
df <- data.frame( x = 1:10, y = 1:10 )
62+
tr1 <- new( "track", x = df, y = rnorm )
63+
checkTrue( identical( SlotProxy(tr1, "x"), df ), msg = "DataFrame( SlotProxy )" )
64+
checkException( SlotProxy(tr1, "y"), msg = "DataFrame( SlotProxy ) -> exception" )
65+
}
6666

67-
test.DataFrame.AttributeProxy <- function(){
68-
df <- data.frame( x = 1:10, y = 1:10 )
69-
tr1 <- structure( NULL, x = df, y = rnorm )
70-
checkTrue( identical( AttributeProxy(tr1, "x"), df) , msg = "DataFrame( AttributeProxy )" )
71-
checkException( AttributeProxy(tr1, "y"), msg = "DataFrame( AttributeProxy ) -> exception" )
72-
}
67+
test.DataFrame.AttributeProxy <- function(){
68+
df <- data.frame( x = 1:10, y = 1:10 )
69+
tr1 <- structure( NULL, x = df, y = rnorm )
70+
checkTrue( identical( AttributeProxy(tr1, "x"), df) , msg = "DataFrame( AttributeProxy )" )
71+
checkException( AttributeProxy(tr1, "y"), msg = "DataFrame( AttributeProxy ) -> exception" )
72+
}
7373

74-
test.DataFrame.CreateTwo.stringsAsFactors <- function() {
75-
DF <- data.frame(a=1:3, b=c("a","b","c"), stringsAsFactors = FALSE )
76-
checkEquals( createTwoStringsAsFactors(), DF, msg = "DataFrame create2 stringsAsFactors = false")
77-
}
74+
test.DataFrame.CreateTwo.stringsAsFactors <- function() {
75+
DF <- data.frame(a=1:3, b=c("a","b","c"), stringsAsFactors = FALSE )
76+
checkEquals( createTwoStringsAsFactors(), DF, msg = "DataFrame create2 stringsAsFactors = false")
77+
}
7878

79-
test.DataFrame.nrows <- function(){
80-
df <- data.frame( x = 1:10, y = 1:10 )
81-
checkEquals( DataFrame_nrows( df ), nrow(df) )
82-
}
79+
test.DataFrame.nrows <- function(){
80+
df <- data.frame( x = 1:10, y = 1:10 )
81+
checkEquals( DataFrame_nrows( df ), nrow(df) )
82+
}
8383

8484

8585
}

0 commit comments

Comments
 (0)