swh:1:snp:cae2596088bc8b92147ee77a766423472ecb4710
Tip revision: 79984c8c127b2e67bfc975973c6572b110810663 authored by Dirk Eddelbuettel on 15 July 2017, 11:02:11 UTC
version 0.12.12
version 0.12.12
Tip revision: 79984c8
unit.tests.R
# Copyright (C) 2010 - 2016 Dirk Eddelbuettel, Romain Francois and Kevin Ushey
#
# This file is part of Rcpp.
#
# Rcpp is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# Rcpp is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
test <- function(output=if(file.exists("/tmp")) "/tmp" else getwd(),
gctorture=FALSE,
gctorture.exclude="runit.Module.client.package.R") {
if (requireNamespace("RUnit")) { # nocov start
if (gctorture) {
message("Running tests with gctorture(TRUE)")
if (length(gctorture.exclude)) {
message("The following tests will be excluded:\n",
paste(">>", gctorture.exclude, collapse="\n")
)
}
unitTestsDir <- system.file("unitTests", package="Rcpp")
files <- list.files(
unitTestsDir,
recursive=TRUE
)
files <- setdiff(files, gctorture.exclude)
dirs <- list.dirs(unitTestsDir, full.names=FALSE)
testDir <- file.path( tempdir(), "RcppTests" )
for (dir in file.path(testDir, dirs)) dir.create(dir)
copySuccess <- sapply(files, function(file) {
file.copy(
file.path(unitTestsDir, file),
file.path(testDir, file)
)
})
if (!all(copySuccess)) {
stop("Could not copy test files to temporary directory")
}
## Modify all the test files that were copied
testFiles <- list.files(testDir, pattern="^runit", full.names=TRUE)
for (file in testFiles) gctortureRUnitTest(file)
## Ensure we can read and parse each file
for (file in testFiles) {
tryCatch( parse(text=readLines(file)),
error=function(e) {
"could not parse test file"
}
)
}
} else {
testDir <- system.file("unitTests", package = "Rcpp")
}
testSuite <- RUnit::defineTestSuite(name="Rcpp Unit Tests",
dirs=testDir,
testFuncRegexp = "^[Tt]est.+")
## if someoone calls Rcpp::test(), he/she wants all tests
Sys.setenv("RunAllRcppTests"="yes")
## Run tests
tests <- RUnit::runTestSuite(testSuite)
## Print results
RUnit::printTextProtocol(tests)
return(tests)
}
stop("Running unit tests requires the 'RUnit' package.") # nocov end
}
unitTestSetup <- function(file, packages=NULL,
pathToRcppTests=system.file("unitTests", package = "Rcpp")) {
function() {
if (! is.null(packages)) {
for (p in packages) {
suppressMessages(require(p, character.only=TRUE))
}
}
sourceCpp(file.path(pathToRcppTests, "cpp", file))
}
}
gctortureRUnitTest <- function(file) {
test <- readLines(file) # nocov start
## todo: handle '{', '}' within quotes
findMatchingBrace <- function(test, start, balance=1) {
line <- test[start]
if (start > length(test)) {
stop("error")
}
if (balance > 0) {
balance <- balance +
sum(gregexpr("{", line, fixed=TRUE)[[1]] > 0) -
sum(gregexpr("}", line, fixed=TRUE)[[1]] > 0)
return( findMatchingBrace(test, start+1, balance) )
}
return(start - 1)
}
## Find the lines defining unit tests
testStarts <- grep("^[[:space:]]*[Tt]est\\.+", test)
## Get the line with the closing brace
testEnds <- sapply(testStarts, function(ind) {
findMatchingBrace(test, ind + 1)
})
stopifnot( length(testStarts) == length(testEnds) )
## Modify the function definition by wrapping it in gctorture
for (i in seq_along(testStarts)) {
start <- testStarts[i]
end <- testEnds[i]
test[start] <- paste( test[start], "gctorture(TRUE);" )
test[end] <- paste("gctorture(FALSE); }")
}
cat(test, file=file, sep="\n") # nocov end
}