RUnit/ 0000755 0001751 0000144 00000000000 15024244447 011337 5 ustar hornik users RUnit/tests/ 0000755 0001751 0000144 00000000000 13267374743 012513 5 ustar hornik users RUnit/tests/README 0000644 0001751 0000144 00000000121 13267374743 013365 0 ustar hornik users
unit tests have been moved to inst/unitTests
in the source package structure
RUnit/.Rinstignore 0000644 0001751 0000144 00000000022 14561532231 013631 0 ustar hornik users inst/doc/Makefile
RUnit/MD5 0000644 0001751 0000144 00000005413 15024244447 011652 0 ustar hornik users 393a5ca445f6965873eca0259a17f833 *COPYING
6b94a58ea79e6ef655370420f985c731 *ChangeLog
2b3eeb6404107e01f4ec6e2db33cc0a2 *DESCRIPTION
d67ace25e05eec76fdb91401cd1b461a *NAMESPACE
d5e61c4fb2e03e331699c99b589b56c3 *NEWS
fdfb94feb8fae5d9b5085d808b592de1 *R/00Init.r
e09d7eb635cd67aee843dbe167e69727 *R/checkFuncs.r
0af7c3a4b469fd74ae00feb78ebf85d5 *R/exportHTML.r
683a514df0cc07ffe238287faecd22f2 *R/html.r
7d37388f85a1c445e4c11fca01dee7da *R/htmlProtocol.r
a18fca4276409763b6d2ed72d63282e8 *R/inspector.r
dac8cdcb71213d0766b2e7421cb6d5e4 *R/junitProtocol.r
d2259ad7818d1a12586f84dc0a34b390 *R/options.r
008c7654ad519fa9de7af8e431ab9098 *R/runit.r
1946f1e7a4090ffe510d99f82c91b58b *R/testLogger.r
3ad2fcf437829b6b6bb7d198df8fadd5 *R/textProtocol.r
35fb76293a8cddc0e2d0d0b247ee9744 *README.md
2c21327ac730bb34e3ce350f2df36e5c *build/stage23.rdb
9417a2d6f70f7f7fff6d25723d515bdd *build/vignette.rds
4f62202a93b4588883bd6cf6c53adc2d *inst/doc/Makefile
4b3f61d679e4bbea1dce9fcfa690aa62 *inst/doc/RUnit.R
2352b006ecb7a74230bf757319b3d4d4 *inst/doc/RUnit.Rnw
5b0545a6f19f59953d1646734d2d61fa *inst/doc/RUnit.pdf
42b28300a717f74028c32c0a87b8adfe *inst/examples/correctTestCase.r
0d450a1fca30e1c3e193d3b2d117b423 *inst/examples/runitVirtualClassTest.r
3df11b61be3a51c4cd3f2aaa62b4c005 *inst/examples/runitc2f.r
4201d80ec130d66cbc544f78522c3608 *inst/share/R/checkCode.r
fa963471970494c4d471175456202d27 *inst/share/R/compareRUnitTestData.r
e97e7c5dda56971910efb622ab8c71b5 *inst/unitTests/Makefile
87db5d27b6c4cc1dfd0182e6d1872113 *inst/unitTests/runalltests.R
20fea06109317e04deac5f348245dfac *inst/unitTests/runitHTMLProtocol.r
8c83fe548809a81699e4c05483e8171b *inst/unitTests/runitInspect.r
3416f47fd504913d182aaba77ffdd14d *inst/unitTests/runitJUnitProtocol.r
376b320c3d1576b1dfe0d6dc6925c83c *inst/unitTests/runitPlotConnection.r
3f947455879084d9eafa9d7ea6663b73 *inst/unitTests/runitRUnit.r
713c2b0f3142caaf4a0ebfaf69b5c8c3 *inst/unitTests/runitS4.r
f58c90583929b356cc16862b3fd87ce0 *inst/unitTests/runitSetUp.r
1ab9a24c678577d379c64bc455139134 *inst/unitTests/runitTearDown.r
d2406b7de7c13f3d5b31bdd5c8fc226a *inst/unitTests/runitTestLogger.r
128d52ea94c7462f871e3242e39566f1 *inst/unitTests/runitTextProtocol.r
9aaab36a3a42fda03d01ad73df977fcc *man/RUnit-internal.Rd
31d29f6382dc390328ca14c36d5fa6e5 *man/RUnit-intro.Rd
04138fda366b5447fc26c40ac83e9d61 *man/RUnit-options.Rd
549b0f02d2ae37b3033251260640f6e7 *man/checkFuncs.Rd
c0b777e713d145c47f051a6915916e55 *man/inspect.Rd
bcc10620027dc39f2018453dcbacf935 *man/printHTML.Rd
bd9d34629232ebd1ed9f98ad7acb4080 *man/runit.Rd
a6390ca77a460a8b3791ff4c50b8f4e0 *man/testCaseSetUp.Rd
e7107c7dcae672ec729fa662a8697449 *man/textProtocol.Rd
9d79fea474c52eb8ef81bf8ee8c6835e *man/tracker.Rd
aad073d2afa8c98edc05a00dddc8dac7 *tests/README
2352b006ecb7a74230bf757319b3d4d4 *vignettes/RUnit.Rnw
RUnit/R/ 0000755 0001751 0000144 00000000000 14563457515 011551 5 ustar hornik users RUnit/R/options.r 0000644 0001751 0000144 00000002741 13267374743 013434 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
.buildRUnitOptions <- function() {
##@bdescr
## Internal function
## adds an entry to R's default global option list
## modelled after version in package Biobase (BioC)
##@edescr
##
##@ret : [list] extended options() list
##
##@codestatus : internal
RUnit <- getOption("RUnit")
if (is.null(RUnit)) {
RUnit <- list()
class(RUnit) <- "RUnitOptions"
}
if (is.null( RUnit$verbose)) {
## integer: == 0: silent, >= 1: add comments to test case log
RUnit$verbose <- 1L
}
if (is.null(RUnit$silent)) {
RUnit$silent <- FALSE
}
if (is.null(RUnit$outfile)) {
RUnit$outfile <- NULL
}
options("RUnit"=RUnit)
}
RUnit/R/testLogger.r 0000644 0001751 0000144 00000025650 14563457515 014063 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
.newTestLogger <- function(useOwnErrorHandler) {
##@bdescr
## creates a new, empty TestLogger 'object'.
## TestLogger is an object based on the 'closure trick'. It has the task
## to store, administrate and print the test protocol.
##@edescr
##@in useOwnErrorHandler : [logical]
##@ret : [list]
##
##@codestatus : internal
## private data:
## -----------------------
.testData <- list()
class(.testData) <- "RUnitTestData"
.currentTestSuiteName <- NULL
.currentSourceFileName <- NULL
## book keeping variables for individual test functions
## can be reset by function cleanup
.currentTraceBack <- NULL
.failure <- FALSE
.deactivationMsg <- NULL ## if non-NULL test function is deactivated
.checkNum <- 0
## verbosity level: 0: silent
.verbosity <- 1L
## define own error handler
## -----------------------
errorHandler <- function() {
##@bdescr
## used as default error handler during test case execution iff
## the user specified 'useOwnErrorHandler' as TRUE (default).
## called in case an error condition, typically stop() has been signalled.
## tries to create a traceback object, currently only used by addError().
##
## not provided via testLogger but used by R's error handler.
##@edescr
##
##@ret : [NULL] used for it's side effect
##
##@codestatus : internal
res <- try(dump.frames())
if (inherits(res, "try-error")) {
.currentTraceBack <<- "traceback not available (dump.frames failed)."
} else {
.currentTraceBack <<- names(last.dump)[-length(last.dump)]
}
}
if(useOwnErrorHandler) {
options(error=errorHandler)
}
## public methods:
## -----------------------
.getTestData <- function() {
##@bdescr
## return the protocol data collected during the test runs
##@edescr
return(.testData)
}
.setCurrentTestSuite <- function(testSuite) {
##@bdescr
## record the test suite that is currently executed.
##@edescr
##@in testSuite : [testSuite - list] the current testSuite
if(is.null(testSuite)) {
.currentTestSuiteName <<- NULL
} else {
if(is.element(testSuite$name, names(.testData))) {
stop(paste("Duplicate test suite:", testSuite$name))
}
.currentTestSuiteName <<- testSuite$name
.testData[[testSuite$name]] <<- list(nTestFunc = 0L,
nDeactivated = 0L,
nErr = 0,
nFail = 0,
dirs = testSuite[["dirs"]],
testFileRegexp = testSuite[["testFileRegexp"]],
testFuncRegexp = testSuite[["testFuncRegexp"]],
sourceFileResults = list())
}
}
.setCurrentSourceFile <- function(sourceFileName) {
##@bdescr
## record the source file whose test functions are currently executed
##@edescr
##@in sourceFileName : [character] name of current source file
if(is.null(sourceFileName)) {
.currentSourceFileName <<- NULL
} else {
.currentSourceFileName <<- sourceFileName
.testData[[.currentTestSuiteName]]$sourceFileResults[[sourceFileName]] <<- list()
}
}
.addSuccess <- function(testFuncName, secs) {
##@bdescr
## add a successful test function run.
##@edescr
##@in testFuncName : [character] name of test function
##@in secs : [numeric] time in seconds needed by the test function to complete
.testData[[.currentTestSuiteName]]$nTestFunc <<- 1 + .testData[[.currentTestSuiteName]]$nTestFunc
.testData[[.currentTestSuiteName]]$sourceFileResults[[.currentSourceFileName]][[testFuncName]] <<-
list(kind="success", checkNum=.checkNum, time=secs)
}
.addError <- function(testFuncName, errorMsg) {
##@bdescr
## add a test function that generated an error.
##@edescr
##@in testFuncName : [character] name of test function
##@in errorMsg : [character] the error message
.testData[[.currentTestSuiteName]]$nTestFunc <<- 1 + .testData[[.currentTestSuiteName]]$nTestFunc
.testData[[.currentTestSuiteName]]$nErr <<- 1 + .testData[[.currentTestSuiteName]]$nErr
.testData[[.currentTestSuiteName]]$sourceFileResults[[.currentSourceFileName]][[testFuncName]] <<-
list(kind="error", msg=errorMsg, checkNum=.checkNum, traceBack=.currentTraceBack)
}
.addFailure <- function(testFuncName, failureMsg) {
##@bdescr
## add a test function that generated an error.
##@edescr
##@in testFuncName : [character] name of test function
##@in failureMsg : [character] the failure message
.testData[[.currentTestSuiteName]]$nTestFunc <<- 1 + .testData[[.currentTestSuiteName]]$nTestFunc
.testData[[.currentTestSuiteName]]$nFail <<- 1 + .testData[[.currentTestSuiteName]]$nFail
.testData[[.currentTestSuiteName]]$sourceFileResults[[.currentSourceFileName]][[testFuncName]] <<-
list(kind="failure", msg=failureMsg, checkNum=.checkNum, traceBack=NULL) ## traceBack is useless in this case
}
.addDeactivated <- function(testFuncName) {
##@bdescr
## add a deactivated test function that generated an error.
##@edescr
##@in testFuncName : [character] name of test function
.testData[[.currentTestSuiteName]]$nDeactivated <<- 1 + .testData[[.currentTestSuiteName]]$nDeactivated
.testData[[.currentTestSuiteName]]$sourceFileResults[[.currentSourceFileName]][[testFuncName]] <<-
list(kind="deactivated", msg=.deactivationMsg, checkNum=.checkNum)
}
.addCheckNum <- function(testFuncName) {
##@bdescr
## add total number of checks performed
##@edescr
##@in testFuncName : [character] name of test function
.testData[[.currentTestSuiteName]]$sourceFileResults[[.currentSourceFileName]][[testFuncName]]$checkNum <<- .checkNum
}
.cleanup <- function() {
##@bdescr
## reset book keeping variables like .failure, ...
## should be called before each test function execution
##@edescr
.currentTraceBack <<- NULL
.failure <<- FALSE
.deactivationMsg <<- NULL
.checkNum <<- 0
}
.isFailure <- function() {
##@bdescr
## return current failure status
##@edescr
return(.failure)
}
.setFailure <- function() {
##@bdescr
## set failure status to TRUE
##@edescr
.failure <<- TRUE
}
.isDeactivated <- function() {
##@bdescr
## return current deactivation message
##@edescr
##@ret : [logical] TRUE if deactivation msg is not NULL
return(!is.null(.deactivationMsg))
}
.setDeactivated <- function(msg) {
##@bdescr
## set deactivation message variable, indicating a deactivated test case
##@edescr
##@in msg : [character] message string
if (length(msg) > 1) {
msg <- paste(msg, collapse=" ")
}
.deactivationMsg <<- msg
}
.incrementCheckNum <- function() {
##@bdescr
## increment internal counter of total num of test cases
##@edescr
.checkNum <<- 1 + .checkNum
}
.getCheckNum <- function() {
##@bdescr
## return counter value for total num of test cases
##@edescr
return(.checkNum)
}
.getVerbosity <- function() {
##@bdescr
## return verbosity level for output log messages
##@edescr
return(.verbosity)
}
.setVerbosity <- function(level) {
##@bdescr
## set verbosity level for output log messages
##@edescr
##@in level : [integer] 0: omit output log messages, 1 >= : write begin/end comments for each test case
if (length(level) > 1) {
level <- level[1]
}
.verbosity <<- level
}
tl <- list(getTestData = .getTestData,
setCurrentTestSuite = .setCurrentTestSuite,
setCurrentSourceFile = .setCurrentSourceFile,
addSuccess = function(testFuncName, secs) .addSuccess(testFuncName, secs),
addError = function(testFuncName, errorMsg) .addError(testFuncName, errorMsg),
addFailure = function(testFuncName, failureMsg) .addFailure(testFuncName, failureMsg),
addDeactivated = function(testFuncName) .addDeactivated(testFuncName),
addCheckNum = function(testFuncName) .addCheckNum(testFuncName),
isFailure = .isFailure,
setFailure = .setFailure,
isDeactivated = .isDeactivated,
setDeactivated = function(msg) .setDeactivated(msg),
incrementCheckNum = .incrementCheckNum,
getCheckNum = .getCheckNum,
getVerbosity = .getVerbosity,
setVerbosity = .setVerbosity,
cleanup = .cleanup)
class(tl) <- "TestLogger"
return(invisible(tl))
}
getErrors <- function(testData) {
##@bdescr
## return a brief summary of the test case execution result,
## computed from the testData listOfListsOfLists
##
##@edescr
##
##@in testData : [list] S3 RUnitTestData class object
##@ret : [list] containing no of errors, deactivated, failed, and total test functions
##
##@codestatus : testing
if(!is(testData, "RUnitTestData")) {
stop("getErrors needs an object of class 'RUnitTestData' as argument.")
}
ret <- list(nErr=0, nDeactivated=0, nFail=0, nTestFunc=0)
for(i in seq_along(testData)) {
ret$nErr <- ret$nErr + testData[[i]]$nErr
ret$nDeactivated <- ret$nDeactivated + testData[[i]]$nDeactivated
ret$nFail <- ret$nFail + testData[[i]]$nFail
ret$nTestFunc <- ret$nTestFunc + testData[[i]]$nTestFunc
}
return(ret)
}
.existsTestLogger <- function(envir=RUnitEnv) {
##@bdescr
## Internal Function
## checks if .testLogger object is available in specified environment
## and if present if this object is of class 'TestLogger'
##
##@edescr
##
##@in envir : [environment] to search within
##@ret : [logical] TRUE iff .testLogger list object is found in specified environment
##
##@codestatus : internal
exists(".testLogger", envir=envir) && inherits(get(".testLogger", envir=envir), "TestLogger")
}
RUnit/R/junitProtocol.r 0000644 0001751 0000144 00000010133 13267374743 014606 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
printJUnitProtocol <- function(testData,
fileName = "") {
##@bdescr
## Report generator
## Extracts the log information stored in the 'RUnitTestData' test run object
## and generates a JUnit-style formated XML output.
##@edescr
##
##@in testData : [RUnitTestData] S3 class object
##@in fileName : [character] string, full path + file name to be written to
##@ret : [logical] TRUE if execution completed without error
##
##@codestatus : testing
## preconditions
if (!is(testData, "RUnitTestData")) {
stop("Argument 'testData' must be of class 'RUnitTestData'.")
}
if (!is.character(fileName)) {
stop("Argument 'fileName' has to be of type character.")
}
if (length(fileName) != 1) {
stop("Argument 'fileName' must contain exactly one element.")
}
errInfo <- getErrors(testData)
# Create entry fro all test suites
xml.testsuites <- XML::newXMLNode("testsuites",
attrs = c(
errors=errInfo$nErr,
failures=errInfo$nFail,
tests=errInfo$nTestFunc)
)
for (tsName in names(testData)) {
# Create entry for test suite
xml.testsuite <- XML::newXMLNode("testsuite",
attrs = c(
errors = testData[[tsName]]$nErr,
failures = testData[[tsName]]$nFail,
name = tsName,
tests = testData[[tsName]]$nTestFunc
))
XML::addChildren(xml.testsuites, kids=c(xml.testsuite))
if (testData[[tsName]]$nErr + testData[[tsName]]$nFail >= 0) {
srcFileRes <- testData[[tsName]][["sourceFileResults"]]
for (i in seq_along(srcFileRes)) {
testFuncNames <- names(srcFileRes[[i]])
for (j in seq_along(testFuncNames)) {
funcList <- srcFileRes[[i]][[testFuncNames[j]]]
# Each tested function gets a testcase
xml.testcase <- XML::newXMLNode("testcase", attrs=c(name=testFuncNames[j], time=funcList$time[['elapsed']]))
XML::addChildren(xml.testsuite, kids=c(xml.testcase))
if (funcList$kind == "success") {
} else if (funcList$kind == "error") {
xml.error <- XML::newXMLNode("error", attrs=c(
"message"=funcList$msg,
"type"="ERROR"))
XML::addChildren(xml.testcase, kids=c(xml.error))
}
else if (funcList$kind == "failure") {
xml.error <- XML::newXMLNode("failure", attrs=c(
"message"=funcList$msg,
"type"="FAILURE"))
XML::addChildren(xml.testcase, kids=c(xml.error))
}
else if (funcList$kind == "deactivated") {
xml.skipped <- XML::newXMLNode("skipped")
XML::addChildren(xml.testcase, kids=c(xml.skipped))
}
}
}
}
}
xml <- XML::saveXML(xml.testsuites)
if(fileName=="") {
write(xml, stdout())
} else {
dir.create(dirname(fileName), showWarnings=FALSE, recursive=TRUE)
fileConn <- file(fileName)
write(xml, fileConn)
close(fileConn)
}
return(invisible(TRUE))
}
RUnit/R/html.r 0000644 0001751 0000144 00000031046 13267374743 012705 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
writeRaw <- function(htmlStr,htmlFile,append=TRUE)
{
##@bdescr
## private function
## write raw text in a html file
##@bdescr
##@in htmlStr : [character] text
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
cat(htmlStr,file=htmlFile,append=append)
invisible(TRUE)
}
writeRawCR <- function(htmlStr,htmlFile,append=TRUE)
{
##@bdescr
## private function
## write raw text in a html file with a cr at end
##@bdescr
##@in htmlStr : [character] text
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw(htmlStr,htmlFile,append)
cat("\n",file=htmlFile,append=TRUE)
invisible(TRUE)
}
writeTitle <- function(htmlStr,htmlFile,append=TRUE)
{
##@bdescr
## private function
## write title tags and title text
##@bdescr
##@in htmlStr : [character] title
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw("
",htmlFile,append)
writeRaw(htmlStr,htmlFile)
writeRaw("\n",htmlFile)
}
writeBeginHead <- function(htmlFile,append=TRUE)
{
##@bdescr
## private function
## write
##@bdescr
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw("",htmlFile,append)
}
writeEndHead <- function(htmlFile,append=TRUE)
{
##@bdescr
## private function
## write
##@bdescr
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw("\n",htmlFile,append)
}
writeBeginHtml <- function(htmlFile,append=TRUE)
{
##@bdescr
## private function
## write
##@bdescr
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw("",htmlFile,append)
}
writeEndHtml <- function(htmlFile,append=TRUE)
{
##@bdescr
## private function
## write
##@bdescr
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw("\n",htmlFile,append)
}
writeBeginBody <- function(htmlFile,append=TRUE)
{
##@bdescr
## private function
## write
##@bdescr
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw("",htmlFile,append)
}
writeEndBody <- function(htmlFile,append=TRUE)
{
##@bdescr
## private function
## write
##@bdescr
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw("\n",htmlFile,append)
}
writeBeginTag <- function(htmlTag,htmlFile,para="",append=TRUE)
{
##@bdescr
## private function
## write begin of a tag, with parameters
##@bdescr
##@in htmlTag : [character] name of the tag
##@in htmlFile : [character] name of the html file
##@in para : [character] parameters as string
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
if(all(para =="")) {
writeRaw(paste("<",htmlTag,">",sep=""),htmlFile,append)
} else {
writeRaw(paste("<",htmlTag," ",para,">",sep=""),htmlFile,append)
}
}
writeEndTag <- function(htmlTag,htmlFile,append=TRUE)
{
##@bdescr
## private function
## write end of tag
##@bdescr
##@in htmlTag : [character] name of the tag
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRaw(paste("",htmlTag,">",sep=""),htmlFile,append)
}
writeCR <- function(htmlFile,append=TRUE)
{
##@bdescr
## private function
## write CR in html file for better formatting of the html source
##@bdescr
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
cat("\n",file=htmlFile,append=append)
invisible(TRUE)
}
writeBeginTable <- function(header,htmlFile,border=1,
width="100%",append=TRUE,
columnWidth=NULL)
{
##@bdescr
## private function
## write begin of a table
##@bdescr
##@in header : [character] title for columns
##@in htmlFile : [character] name of the html file
##@in border : [integer] border of table
##@in width : [character] width of table
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
tablePara <- paste("border=\"",border,"\" width=\"",width,"\"",sep="")
writeRawCR(paste("",sep=""),htmlFile,append)
## if header is provided
if (length(header) > 0) {
writeBeginTag("tr",htmlFile)
for(i in seq_along(header)) {
para <- ""
if(!is.null(columnWidth)) {
if (length(columnWidth) == length(header)) {
para = paste("width=\"", columnWidth[i], "\"", sep="")
} else {
## recycle first
para = paste("width=\"", columnWidth[1], "\"", sep="")
}
}
writeBeginTag("th",htmlFile, para=para)
writeRaw(header[i],htmlFile)
writeEndTag("th",htmlFile)
writeCR(htmlFile)
}
writeEndTag("tr",htmlFile,append)
}
writeCR(htmlFile)
}
writeTableRow <- function(row,htmlFile,append=TRUE,bgcolor="")
{
##@bdescr
## private function
## write a table row
##@bdescr
##@in row : [character] data for table cells in row
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@in bgcolor : [character] color for table cells
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeBeginTag("tr",htmlFile)
if(length(bgcolor) == 1)
{
bgcolor <- rep(bgcolor,length(row))
}
for(i in seq_along(row))
{
if(bgcolor[i] == "")
{
writeBeginTag("td",htmlFile)
} else {
writeBeginTag("td",htmlFile,para=paste("bgcolor=\"",bgcolor[i],"\"",sep=""))
}
writeRaw(row[i],htmlFile)
writeEndTag("td",htmlFile)
writeCR(htmlFile)
}
writeEndTag("tr",htmlFile,append)
writeCR(htmlFile)
}
writeLink <- function(target,name,htmlFile,append=TRUE)
{
##@bdescr
## private function
## write a link
##@bdescr
##@in target : [character] target of the link
##@in name : [character] name of the target
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeBeginTag("a",htmlFile,paste("href=\"",target,"\"",sep=""),append=append)
writeRaw(name,htmlFile,append=TRUE)
writeEndTag("a",htmlFile,append=TRUE)
}
writeEndTable <- function(htmlFile,append=TRUE)
{
##@bdescr
## private function
## close an
#@bdescr
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeEndTag("table",htmlFile,append)
writeCR(htmlFile)
}
writeHtmlHeader <- function(header,htmlFile)
{
##@bdescr
## private function
## write a HTML file header
## - DOCTYPE
## -
## -
## -
##
## should be finished by writeHtmlEnd
##@bdescr
##@in header : [character] title of the document
##@in htmlFile : [character] name of the link
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRawCR("",htmlFile)
writeBeginHtml(htmlFile)
writeBeginHead(htmlFile)
writeTitle(header,htmlFile)
writeEndHead(htmlFile)
writeBeginBody(htmlFile)
}
writeHtmlEnd <- function(htmlFile)
{
##@bdescr
## private function
## write end of html code
##@bdescr
##@in htmlFile : [character] name of the html file
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeEndBody(htmlFile)
writeEndHtml(htmlFile)
}
writeHtmlSep <- function(htmlFile)
{
##@bdescr
## private function
## write horizontal seperator
##@bdescr
##@in htmlFile : [character] name of the html file
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeRawCR("
",htmlFile)
}
writeImage <- function(img,htmlFile,append=TRUE)
{
##@bdescr
## private function
## write image tags
##@bdescr
##@in img : [character] name of the image file
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
writeBeginTag("img",htmlFile,para=paste("src=\"",img,"\"",sep=""),append)
writeEndTag("img",htmlFile)
}
writeHtmlSection <- function(title,sec,htmlFile,append=TRUE)
{
##@bdescr
## private function
## write titles for section
##@bdescr
##@in title : [character] title of the section
##@in sec : [integer] size of title (between 1-6)
##@in htmlFile : [character] name of the html file
##@in append : [logical] append the html code
##@ret : [logical] TRUE if execution completes
##
##@codestatus : internal
secTag <- paste("h",sec,sep="")
writeBeginTag(secTag,htmlFile,append)
writeRaw(title,htmlFile,append)
writeEndTag(secTag,htmlFile,append)
writeCR(htmlFile,append)
}
writeHtmlTable <- function(dataFrame, htmlFile, border=1,
width="100%", append=TRUE)
{
##@bdescr
## private function
## write a data frame to a HTML table
##@bdescr
##
##@in dataFrame : [data frame] size of title (between 1-6)
##@in htmlFile : [character] name of the html file
##@in border : [integer] 1 (default) table borders will be shown
##@in width : [character] width of table
##@in append : [logical] if TRUE append the tabel to an existing HTML file
##@ret : [logical] TRUE if execution completed
##
##@codestatus : internal
header <- NULL
colNames <- colnames(dataFrame)
if (!is.null(colNames)) {
if (length(colNames) == dim(dataFrame)[2]) {
header <- colNames
} else {
## don't write column names
header <- NULL
}
}
rowNames <- rownames(dataFrame)
if (!is.null(rowNames)) {
header <- c("Name", header)
dataFrame <- cbind(rowNames, dataFrame)
}
writeBeginTable(header, htmlFile, border=border,
width=width, append=append,
columnWidth=NULL)
for (ti in 1:dim(dataFrame)[1]) {
writeTableRow(dataFrame[ti, ], htmlFile, append=TRUE, bgcolor="")
}
writeEndTable(htmlFile,append=TRUE)
}
RUnit/R/exportHTML.r 0000644 0001751 0000144 00000023137 14563457515 013750 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2010 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
plotConnection.trackInfo <- function(con, pngfile, ...)
{
##@bdescr
## create a plot displaying the execution flow as a graph
##@edescr
##
##@in con : [matrix] counts of execution calls for previous functions
##@in pngfile : [character] string specifying the full path & file name of the
## plot file (PNG) to be generate
##@ret : [NULL] used for its side effect
##
##@codestatus : testing
#stopifnot(require(graphics))
## experimental 2nd order connections
## color for arrows
color <- c("black","lightgreen","green","lightblue","blue","orangered","red")
## create nothing if
if(all(con==0))
{
## open png device
grDevices::png(filename=pngfile,width=1024,height=960)
graphics::plot(1:10,axes=FALSE,xlab="",ylab="",main="",type="n")
graphics::text(5,5,labels="No connection graph available")
grDevices::dev.off()
return(invisible())
}
## overall connections
allCon <- sum(con)
## connections with percent
con <- ceiling(con/sum(con)*100)
## normalize for colors
con <- (con + 14) %/% 15
## open png device
grDevices::png(filename=pngfile,width=1024,height=960)
## basic plot
plot(x=1:nrow(con), y=1:nrow(con), type="n",axes=FALSE,ylab="# line",xlab="",
ylim=c(nrow(con),1))
## draw text lines
text(x=1, y=1:nrow(con), labels=1:nrow(con))
## offset, to avoid complete overlay
offset <- rep(3,length.out=nrow(con))
## minimal x
xmin <- 2
## check all connections
for(i in 1:nrow(con))
{
for(j in 1:ncol(con))
{
## check for an existing connection
if(con[i,j] != 0)
{
colDraw <- color[con[i,j]]
from <- j
to <- i
## circular
if(from == to)
{
top <- from + 0.5
bot <- from - 0.5
middle <- (xmin+offset[from])/2
## top spline
splTop <- stats::spline(c(xmin,middle,offset[from]), c(from + 0.2,top,from))
## bottom spline
splBot <- stats::spline(c(xmin,middle,offset[from]), c(from - 0.2,bot,from))
lines(splTop$x, splTop$y, col=colDraw)
lines(splBot$x, splBot$y, col=colDraw)
l <- length(splTop$y)
## draw arrow tips
arrows(splTop$x[l-1], splTop$y[l-1], splTop$x[l], splTop$y[l],
length=0.04, col=colDraw)
offset[from] <- offset[from] + 1
} else {
## "regular" case
middle <- (i+j)/2;
splxy <- stats::spline(c(from - 0.2, middle, to + 0.2),
c(xmin - 0.2, offset[from], xmin + 0.2))
lines(splxy$y, splxy$x, col=colDraw)
if(i < j)
{
l <- length(splxy$y)
## draw an arrow tip
arrows(splxy$y[l-1], splxy$x[l-1], splxy$y[l], splxy$x[l],
length=0.06, col=colDraw)
} else {
## draw "inverse" arrow tip
arrows(splxy$y[2], splxy$x[2], splxy$y[1], splxy$x[1],
length=0.06, col=colDraw)
}
## set offset higher
offset[from] <- offset[from] + 1
}
}
}
}
legposx <- nrow(con)
leg.txt <- c("0-15%","15-30%","30-45%","45-60%","60-75%","75-90%","90-100%")
legend(x=legposx,y=1,legend=leg.txt,lty=1,xjust=1,col=color)
grDevices::dev.off()
return(invisible())
}
printHTML <- function(object, baseDir=".") UseMethod("printHTML")
printHTML.default <- function(object, baseDir=".") NextMethod("printHTML")
printHTML.trackInfo <- function(object, baseDir=".")
{
##@bdescr
## create a HTML representation of the TrackInfo object data
##@edescr
##
##@in object : [list] trackInfo object
##@in baseDir : [character] string specifying the full path to the root directory to hold the HTML pages
##
##
##@codestatus : untested
## preconditions
if (!is(object, "trackInfo")) {
stop("argument 'object' has to be a list of class 'trackInfo'.")
}
if (!is.character(baseDir)) {
stop("argument 'baseDir' has to be of type 'character'.")
}
if (length(baseDir) != 1) {
stop("argument 'baseDir' has to contain exactly one element.")
}
if (is.na(baseDir)) {
stop("argument 'baseDir' may not be missing value.")
}
path <- file.path(baseDir,"results")
if (!file.exists(path))
{
ok <- dir.create(path)
if(!ok) {
stop(paste("could not create", path) )
}
}
htmlFile <- file.path(path,"index.html")
footerString <- paste("RUnit ", packageDescription("RUnit", fields="Version"),
as.character(Sys.time()))
## create index.html
writeHtmlHeader("RUnit Code Inspection - Overview",htmlFile)
writeHtmlSection("Overview",2,htmlFile)
writeBeginTable(c("Categ.","Name","Signature"),htmlFile)
for(i in seq_along(object))
{
funcID <- strsplit(names(object)[i],"/")[[1]]
funcCat <- funcID[1]
funcName <- funcID[2]
if(length(funcID) > 2)
{
sig <- funcID[3:length(funcID)]
funcSig <- paste(funcName,"(",paste(sig,collapse=", "),")",sep="")
} else {
funcSig <- ""
}
writeBeginTag("tr",htmlFile)
writeCR(htmlFile)
## write function category
writeBeginTag("td",htmlFile)
writeRaw(funcCat,htmlFile)
writeEndTag("td",htmlFile)
writeCR(htmlFile)
## write function name
writeBeginTag("td",htmlFile)
writeLink(file.path(".", paste("result",i,".html",sep="")), funcName, htmlFile)
writeEndTag("td",htmlFile)
writeCR(htmlFile)
## write function signature
writeBeginTag("td",htmlFile)
writeRaw(funcSig,htmlFile)
writeEndTag("td",htmlFile)
writeCR(htmlFile)
writeEndTag("tr",htmlFile)
}
writeEndTable(htmlFile)
writeRaw(footerString, htmlFile)
writeHtmlEnd(htmlFile)
writeLinkRef <- function(htmlFile,leftLink,leftName,rightLink,rightName)
{
writeBeginTable(c("",""),htmlFile,border=0,width="100%")
writeBeginTag("tr",htmlFile)
writeCR(htmlFile)
writeBeginTag("td",htmlFile)
writeLink(leftLink,leftName,htmlFile)
writeEndTag("td",htmlFile)
writeCR(htmlFile)
writeBeginTag("td",htmlFile,"align=\"right\"");
writeLink(rightLink,rightName,htmlFile)
writeEndTag("td",htmlFile)
writeEndTag("tr",htmlFile)
writeCR(htmlFile)
writeEndTable(htmlFile)
}
## create result pages
for(i in seq_along(object))
{
absGraphImg <- file.path(path, paste("con",i,".png",sep=""))
absGraphFile <- file.path(path, paste("con",i,".html",sep=""))
relGraphImg <- file.path(".", paste("con",i,".png",sep=""))
relGraphFile <- file.path(".", paste("con",i,".html",sep=""))
relHTMLFile <- file.path(".", paste("result",i,".html",sep=""))
htmlFile <- file.path(path, paste("result",i,".html",sep=""))
## begin result page
writeHtmlHeader("RUnit Code Inspection - Result",htmlFile)
writeLinkRef(htmlFile,"index.html","index",relGraphFile,"graph")
writeHtmlSep(htmlFile)
writeHtmlSection("Result",2,htmlFile)
funcName <- strsplit(names(object)[i],"/")[[1]][2]
writeRaw("Function: ",htmlFile)
writeBeginTag("b",htmlFile)
writeRaw(funcName,htmlFile)
writeEndTag("b",htmlFile)
writeCR(htmlFile)
writeRaw("Runs: ",htmlFile)
writeBeginTag("b",htmlFile)
writeRaw(object[[i]]$nrRuns,htmlFile)
writeEndTag("b",htmlFile)
writeCR(htmlFile)
writeCR(htmlFile)
writeBeginTable(c("line","code","calls","time"),htmlFile)
for(j in seq_along(object[[i]]$src))
{
srcLine <- object[[i]]$src[j]
leadingSpaceNr <- attr(regexpr("^( )*",srcLine),"match.length")
if(leadingSpaceNr > 0)
{
srcLine <- gsub("^( )*","",srcLine)
srcLine <- paste(paste(rep(" ",leadingSpaceNr),collapse=""),
srcLine,collapse="",sep="")
}
if(object[[i]]$run[j] > 0)
{
bgcolor <- "#00D000"
} else {
bgcolor <- "#D00000"
}
writeTableRow(c(j,srcLine,object[[i]]$run[j],round(object[[i]]$time[j],2)),
htmlFile,bgcolor=bgcolor)
}
writeEndTable(htmlFile)
writeHtmlSep(htmlFile)
writeLinkRef(htmlFile,"index.html","index",relGraphFile,"graph")
writeHtmlSep(htmlFile)
writeRaw(footerString, htmlFile)
writeHtmlEnd(htmlFile)
## Conncetion plot
plotConnection.trackInfo(object[[i]]$graph, absGraphImg)
writeHtmlHeader("RUnit Code Inspection - Connection Graph",absGraphFile)
writeLinkRef(absGraphFile,"index.html","index",relHTMLFile,"Function")
writeHtmlSep(absGraphFile)
writeHtmlSection("Connection Graph",2,absGraphFile)
writeImage(relGraphImg,absGraphFile)
writeCR(absGraphFile)
writeHtmlSep(absGraphFile)
writeLinkRef(absGraphFile,"index.html","index",relHTMLFile,"Function")
writeRaw(footerString, absGraphFile)
writeHtmlEnd(absGraphFile)
}
return(invisible())
}
RUnit/R/inspector.r 0000644 0001751 0000144 00000035312 13267374743 013747 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
includeTracker <- function(fbody, track=track)
{
##@bdescr
## Internal function
##
##@edescr
##
##@in fbody : [character] vector of code lines of function to track
##@in track : [trackInfo] list
##@ret : [list] with elements list(modFunc=c(sig,newBody),newSource = newCode)
##
##@codestatus : internal
## get the signature
sig <- fbody[1]
## get the block structure (important for if, for, while, else with one line)
block <- sapply(fbody[-1],function(x) regexpr("[^ ]",x)[1], USE.NAMES=FALSE)
## vector of keywords
kwOpen <- c("for","while","repeat","if","else")
## keyword at begin
kwGrep <- paste("(",paste(kwOpen,sep="",collapse="|"),")",sep="")
oneLiner <- function(code)
{
##@bdescr
## utility
## search a character vector ie. the vector of lines of a function body
## for block structures e.g. for|while|repeat|if|else { } code block
##@edescr
##
##@in code : [character] vector of function body code lines
##@ret : [logical] vector of length of code, indication which are one line control blocks
##
##@codestatus : internal
return(sapply(code,
function(line)
{
opBr <- grep(paste("^[ ]*",kwGrep,".*[ ]+$",sep=""), line)
## special case if combined with assignment or math operators
opBr2 <- grep(paste("(<-|=|\\+|\\-|\\*|\\/)[ ]*if[ ]*\\(",sep=""), line)
if(length(opBr) > 0 || length(opBr2) > 0) {
return(TRUE)
}
return(FALSE)
}, USE.NAMES=FALSE))
}
## set Brackets
setBrackets <- function(potLine,block,env)
{
##@bdescr
##
##@edescr
##
##@in potLine : [logical] mask vector which line contains a one-line control construct
##@in block : [integer] vector
##@in env : [logical] mask vector: which line already contains a opening brace
##@ret : [list] with matching element vectors: openBr & clodeBr
##
##@codestatus : internal
oBr <- character(length(potLine))
clBr <- character(length(potLine))
lineIdx <- 1L
while(lineIdx < length(potLine))
{
if(potLine[lineIdx] && !(potLine[lineIdx+1])) {
oBr[lineIdx] <- "{"
if (!env[lineIdx+1]) {
clBr[lineIdx+2] <- paste(clBr[lineIdx+2],"}")
} else {
bbl <- block[lineIdx]
endBlockIdx <- min(which((bbl >= block) & (seq_along(block) > lineIdx)))
clBr[endBlockIdx] <- paste(clBr[endBlockIdx],"}")
}
} else if(potLine[lineIdx] && (potLine[lineIdx+1]) ) {
oBr[lineIdx] <- "{"
bbl <- block[lineIdx]
endBlockIdx <- min(which((bbl >= block) & (seq_along(block) > lineIdx)))
clBr[endBlockIdx] <- paste(clBr[endBlockIdx],"}")
}
lineIdx <- lineIdx + 1L
}
return(list(openBr=oBr, closeBr=clBr))
}
## check for new environments
env <- sapply(fbody[-1],
function(code)
{
envIdx <- grep("\\{$",code)
if(length(envIdx) > 0)
{
return(TRUE)
}
return(FALSE)
},USE.NAMES=FALSE)
## check the block structure
block <- sapply(fbody[-1], function(x) regexpr("[^ ]",x)[1], USE.NAMES=FALSE)
## is 4 a convention or a rule?
block <- (block %/% 4) + 1
## check for if's, while's, etc.
ol <- oneLiner(fbody[-1])
## create brackets for control structures without new environments
br <- setBrackets(ol,block,env)
## create new Code
newCode <- paste(as.vector(rbind(br$closeBr,fbody[-1],br$openBr)))
newCode <- newCode[newCode != ""]
## include the breakpoint function
bpVec <- sapply(newCode,
function(line)
{
nobp <- grep("^[ ]*(else |\\{|\\})",line)
if(length(nobp) == 0)
{
return("track$bp();")
}
return("")
},USE.NAMES=FALSE)
for(i in seq_along(bpVec)) {
bpVec[i] <- gsub("\\(\\)",paste("(",i,")",sep=""),bpVec[i])
}
## create the mainpulated body of the function
newBody <- paste(bpVec,newCode)
## return signature and body
return(list(modFunc=c(sig,newBody), newSource=newCode))
}
tracker <- function()
{
##@bdescr
## initialization of the central tracking object
## which stores all information related to inspection results and code execution structure
## defines accessor functions
## - addFunc (fId,src,callExpr): add specified function to the track list
## - getSource(nr): get the source code (character) for function nr on track list
## - init
## - bp
## - getTrackInfo
## - isValidTrackInfo
##@edescr
##
##@ret : [list] OO object with functions addFunc, getSourcee, init, bp, getTrackInfo
##
##@codestatus : testing
## object for information
trackInfo <- list()
class(trackInfo) <- "trackInfo"
## current function index
fIdx <- 0
## old time
oldTime <- NULL
## old src line
oldSrcLine <- 0
addFunc <- function(fId,src,callExpr)
{
##@bdescr
##
## accessor function
##@edescr
##
##@in fId : [character] function name
##@in src : [character] source code character vector
##@in callExpr : [character] function call
##@ret : [NULL] returns invisible, used for its side effects
##
## codestatus : internal
## preconditions
if( length(fId) != 1) {
stop("fId must be one character string: function name")
}
isThere <- which(fId == names(trackInfo))
if(length(isThere) == 1)
{
## already in tracking list
fIdx <<- isThere
}
else
{
fIdx <<- fIdx + 1
newFuncInfo <- list(src=src,
run=integer(length(src)),
time=numeric(length(src)),
graph=matrix(0,nrow=length(src),ncol=length(src)),
nrRuns=as.integer(0),
funcCall=callExpr)
## append strips class attribute
trackInfo <- append(trackInfo,list(newFuncInfo))
names(trackInfo)[fIdx] <- fId
class(trackInfo) <- "trackInfo"
## update global state
trackInfo <<- trackInfo
}
## increment run number
trackInfo[[fIdx]]$nrRuns <<- trackInfo[[fIdx]]$nrRuns + 1
## initialize local variables
oldSrcLine <<- 0
oldTime <<- NULL
return(invisible())
}
getTrackInfo <- function()
{
##@bdescr
##
## accessor function
## returns the main inspection result list with
## elements
## - src
## - run
## - time
## - graph
## - nrRuns
## - funCall
##@edescr
##
##@ret : [trackInfo] S3 class list (see description above)
##
## codestatus : internal
return(trackInfo)
}
init <- function()
{
##@bdescr
##
## initalisation function
## sets/resets variables run and fIdx
##@edescr
##
##@ret : [NULL] returns invisible, used for its side effects
##
## codestatus : internal
trackInfoInit <- list()
class(trackInfoInit) <- "trackInfo"
trackInfo <<- trackInfoInit
fIdx <<- 0L
return(invisible())
}
bp <- function(nr)
{
##@bdescr
##
## accessor function
##@edescr
##
##@in : [integer] index, function run number
##@ret : [NULL] returns invisible, used for its side effects
##
## codestatus : internal
## preconditions
if (length(nr) != 1) {
stop("argument 'nr' has to be of length 1.")
}
if (is.na(nr)) {
stop("argument 'nr' may not contain missing value (NA).")
}
trackInfo[[fIdx]]$run[nr] <<- trackInfo[[fIdx]]$run[nr] + 1
## cumulative processing time
if(!is.null(oldTime))
{
dtime <- proc.time()[1] - oldTime
trackInfo[[fIdx]]$time[nr] <<- trackInfo[[fIdx]]$time[nr] + dtime
}
oldTime <<- proc.time()[1]
## graph
if(oldSrcLine != 0)
{
trackInfo[[fIdx]]$graph[oldSrcLine,nr] <<- trackInfo[[fIdx]]$graph[oldSrcLine,nr] + 1
}
## store the old line
oldSrcLine <<- nr
return(invisible())
}
getSource <- function(nr)
{
##@bdescr
##
## accessor function
## returns the source code as character string
##@edescr
##
##@in : [integer] index, function run number
##@ret : [character] string, source code
##
##@codestatus : untested
## preconditions
if (length(nr) != 1) {
stop("argument 'nr' has to be of length 1.")
}
if (is.na(nr)) {
stop("argument 'nr' may not contain missing value (NA).")
}
return(trackInfo[[nr]]$src)
}
isValidTrackInfo <- function(trackInfo) {
##@bdescr
## test function
## returns TRUE iff trackInfo object fullfils S3 class definition constraints
## - S3 class 'trackInfo'
## - with elements
## - src [character] vector of function source code lines
## - run [integer] vector of no. of times this function was called
## - time [numeric] vector of function execution times in seconds per call
## - graph [matrix] connection matrix (# code linbes x # of execution calls)
## - nrRuns [integer]
## - funcCall [character] function call
##@edescr
##
##@in : [trackInfo] S3 class object
##@ret : [logical] TRUE, iff object fullfils class definition constraints
##
##@codestatus : untested
if (!is(trackInfo,"trackInfo")) {
return(FALSE)
}
checkElements <- function(x) {
if (!all(c("src", "run", "time", "graph", "nrRuns", "funcCall") %in% names(x))) {
return(FALSE)
}
if (length(x[["run"]]) < 1 || any(is.na(x[["run"]])) || any(x[["run"]] < 0)) {
return(FALSE)
}
if (length(x[["time"]]) < 1 || any(is.na(x[["time"]])) || any(x[["time"]] < 0)) {
return(FALSE)
}
## TODO: graph
if (length(x[["nrRuns"]]) != 1 || is.na(x[["nrRuns"]]) || x[["nrRuns"]] < 0) {
return(FALSE)
}
if (length(x[["funcCall"]]) != 1 || is.na(x[["funcCall"]])) {
return(FALSE)
}
}
ok <- sapply(trackInfo, checkElements)
if (!all(ok)) {
return(FALSE)
}
return(TRUE)
}
return(list(addFunc=addFunc,
getSource=getSource,
init=init,
bp=bp,
getTrackInfo=getTrackInfo,
isValid=isValidTrackInfo))
}
inspect <- function(expr, track=track)
{
##@bdescr
## inspector function
## an attempt is made to parse the expression or function
## insert track info statements to be used for subsequent
## code execution structure displays
##
## can handle functions aswell as generics
##@edescr
##
##@in expr : [call]
##@in track : [list] tracker object
##@ret : [expression|ANY] either the unevaluated expression of the function or the result of the function call
##
##@codestatus : testing
## get the call and its parameters
fCall <- as.character(substitute(expr))
## get the original call
callExpr <- deparse(substitute(expr))
## get the name of the function
fname <- fCall[1]
## check for generic function
if(isGeneric(fname))
{
## get type of arguments
selType <- sapply(fCall[-1],
function(x)
{
if(exists(x, envir=sys.parent(sys.parent())))
{
varSig <- is(get(x,envir=sys.parent(sys.parent())))[1]
}
else
{
varSig <- is(eval(parse(text=x)))[1]
}
return(varSig)
},USE.NAMES=FALSE)
## we have to check for missing arguments
formalArg <- names(formals(getGeneric(fCall[1])))
## number of missing arguments
nrMissing <- length(formalArg) - length(selType)
if(nrMissing > 0)
{
## check for ...
ellipseIdx <- which(formalArg == "...")
if(length(ellipseIdx) != 0)
{
selType <- c(selType,rep("missing",nrMissing -1 ))
} else {
selType <- c(selType,rep("missing",nrMissing))
}
}
## select function
selFunc <- selectMethod(fname, selType)
## deparse the function
fbody <- deparse(selFunc@.Data, width.cutoff=500)
## create an identifier for the generic function
fNameId <- paste("S4",fname,paste(selFunc@defined@.Data, collapse="/"), sep="/")
} else {
## deparse the function
fbody <- try(deparse(get(fname), width.cutoff=500), silent=TRUE)
if (inherits(fbody, "try-error")) {
## in case the function is defined
## in the test case file
fbody <- try(deparse(get(fname, envir=sys.parent()), width.cutoff=500))
if (inherits(fbody, "try-error")) {
stop("function not found.")
}
}
## create an identifier for the generic function
fNameId <- paste("R/",fname,sep="")
}
## generate the new body of the function
newFunc <- includeTracker(fbody, track=track)
track$addFunc(fNameId, newFunc$newSource, callExpr)
## build the test function
eval(parse(text=c("testFunc <- ",newFunc$modFunc)),envir=sys.frame())
## create function call
newFunCall <- paste("testFunc(",paste(fCall[-1], collapse=","), ")",sep="")
parsedFunc <- try(parse(text=newFunCall))
## check for an error
if(!inherits(parsedFunc,"try-error"))
{
## call the new function
res <- eval(parsedFunc, envir=parent.frame())
} else {
## no parsing possible
## simple call without tracking
res <- expr
}
## do here some error checking
return(res)
}
RUnit/R/htmlProtocol.r 0000644 0001751 0000144 00000041413 13267374743 014426 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
printHTMLProtocol <- function(testData,
fileName = "",
separateFailureList = TRUE,
traceBackCutOff=9,
testFileToLinkMap=function(x) x) {
##@bdescr
## Report generator
## Extracts the log information stored in the 'RUnitTestData' test run object
## and generates a well formated HTML output.
##@edescr
##
##@in testData : [RUnitTestData] S3 class object
##@in fileName : [character]
##@in separateFailureList : [logical] if TRUE (default) add a list of all failures
##@in traceBackCutOff : [integer] number of steps back in the trace back stack to be displayed
##@in testFileToLinkMap : [function] a function transforming the full name of the test file to a link location
##@ret : [logical] TRUE if execution completed w/o error
##
##@codestatus : testing
## --------------------------------
## CHECK OF INPUT DATA
## --------------------------------
if (!is(testData, "RUnitTestData"))
{
stop("Argument 'testData' must be of class 'RUnitTestData'.")
}
if (!is.character(fileName))
{
stop("Argument 'fileName' has to be of type character.")
}
if (length(fileName) != 1)
{
stop("Argument 'fileName' must contain exactly one element.")
}
if (!is.logical(separateFailureList))
{
stop("Argument 'separateFailureList' has to be of type logical.")
}
if (length(separateFailureList) != 1)
{
stop("Argument 'separateFailureList' must contain exactly one element.")
}
if (!is.numeric(traceBackCutOff))
{
stop("Argument 'traceBackCutOff' has to be of type logical.")
}
if (length(traceBackCutOff) != 1)
{
stop("Argument 'traceBackCutOff' must contain exactly one element.")
}
if (traceBackCutOff < 0 || traceBackCutOff > 100)
{
stop("Argument 'traceBackCutOff' out of valid range [0, 100].")
}
## --------------------------------
## HELPER FUNCTIONS
## --------------------------------
## get singular or plural right
sop <- function(number, word, plext="s") {
ifelse(number == 1, paste(number, word),
paste(number, paste(word, plext, sep="")))
}
pr <- function(...) {
writeRaw(paste(...), htmlFile=fileName)
writeRaw("
", htmlFile=fileName)
}
writeP <- function(string, para="") {
writeBeginTag("p", para=para, htmlFile=fileName)
writeRaw(string, htmlFile=fileName)
writeEndTag("p", htmlFile=fileName)
writeCR(htmlFile=fileName)
}
writeLi <- function(..., para="") {
writeBeginTag("li", para=para, htmlFile=fileName)
writeRaw(paste(...), htmlFile=fileName)
writeEndTag("li", htmlFile=fileName)
}
createTestFuncRef <- function(testSuite, srcFileName, testFuncName,
asAnchor=FALSE) {
tmp <- paste(testSuite, srcFileName, testFuncName, sep="_")
if(asAnchor) {
return(paste("#", gsub("/", "_", tmp), sep=""))
} else {
return(gsub("/", "_", tmp))
}
}
printTraceBack <- function(traceBack) {
if(length(traceBack) > 0) {
writeRaw("Call Stack:
", htmlFile=fileName)
if(traceBackCutOff > length(testFuncInfo$traceBack)) {
writeRaw("(traceBackCutOff argument larger than length of trace back: full trace back printed)
", htmlFile=fileName)
writeBeginTag("ol", htmlFile=fileName)
for(i in seq_along(traceBack)) {
writeBeginTag("li", htmlFile=fileName)
writeRaw(traceBack[i], htmlFile=fileName)
writeEndTag("li", htmlFile=fileName)
}
} else {
writeBeginTag("ol", htmlFile=fileName)
for(i in traceBackCutOff:length(traceBack)) {
writeBeginTag("li", htmlFile=fileName)
writeRaw(traceBack[i], htmlFile=fileName)
writeEndTag("li", htmlFile=fileName)
}
}
writeEndTag("ol", htmlFile=fileName)
}
}
errorStyle <- "color:red"
deactivatedStyle <- "color:black"
## --------------------------------------------
## PART 1: TITLE AND BASIC ERROR INFORMATION
## --------------------------------------------
## title
title <- paste("RUNIT TEST PROTOCOL", date(), sep="--")
writeHtmlHeader(title, htmlFile=fileName)
writeHtmlSection(title, 1, htmlFile=fileName)
if(length(testData) == 0) {
writeP(" no test cases :-(")
return(invisible(TRUE))
}
## basic Info
errInfo <- getErrors(testData)
writeP(paste("Number of test functions:", errInfo$nTestFunc))
if(errInfo$nDeactivated > 0) {
writeP(paste("Number of deactivated test functions:", errInfo$nDeactivated),
para=ifelse(errInfo$nDeactivated == 0, "", paste("style", deactivatedStyle, sep="=")))
}
writeP(paste("Number of errors:", errInfo$nErr),
para=ifelse(errInfo$nErr == 0, "", paste("style", errorStyle, sep="=")))
writeP(paste("Number of failures:", errInfo$nFail),
para=ifelse(errInfo$nFail == 0, "", paste("style", errorStyle, sep="=")))
writeHtmlSep(htmlFile=fileName)
## --------------------------------
## PART 2: TABLE OF TEST SUITES
## --------------------------------
## summary of test suites
writeHtmlSection(sop(length(testData), "Test suite"), 3, htmlFile=fileName)
## table of test suites
if(errInfo$nDeactivated > 0) {
writeBeginTable(c("Name", "Test functions", "Deactivated", "Errors", "Failures"),
width="80%",
htmlFile=fileName,
columnWidth=c("20%", "20%", "20%", "20%", "20%"))
for(tsName in names(testData)) {
rowString <- c(paste("", tsName, "", sep=""),
testData[[tsName]]$nTestFunc,
testData[[tsName]]$nDeactivated,
testData[[tsName]]$nErr,
testData[[tsName]]$nFail)
rowCols <- c("", "",
ifelse(testData[[tsName]]$nDeactivated==0, "", "yellow"),
ifelse(testData[[tsName]]$nErr==0, "", "red"),
ifelse(testData[[tsName]]$nFail==0, "", "red"))
writeTableRow(row=rowString, bgcolor=rowCols, htmlFile=fileName)
}
writeEndTable(htmlFile=fileName)
}
else { ## skip 'deactivated' column if no function has been deactivated
writeBeginTable(c("Name", "Test functions", "Errors", "Failures"),
width="60%",
htmlFile=fileName,
columnWidth=c("30%", "30%", "20%", "20%"))
for(tsName in names(testData)) {
rowString <- c(paste("", tsName, "", sep=""),
testData[[tsName]]$nTestFunc,
testData[[tsName]]$nErr,
testData[[tsName]]$nFail)
rowCols <- c("", "",
ifelse(testData[[tsName]]$nErr==0, "", "red"),
ifelse(testData[[tsName]]$nFail==0, "", "red"))
writeTableRow(row=rowString, bgcolor=rowCols, htmlFile=fileName)
}
writeEndTable(htmlFile=fileName)
}
writeHtmlSep(htmlFile=fileName)
## ------------------------------------------------
## PART 3: ERROR, FAILURE AND DEACTIVATED TABLES
## -------------------------------------------------
## error table
if(separateFailureList && (errInfo$nErr > 0)) {
writeHtmlSection("Errors", 3, htmlFile=fileName)
writeBeginTable(c("Test suite : test function", "message"),
htmlFile=fileName,
columnWidth=c("30%", "70%"))
for(tsName in names(testData)) {
if(testData[[tsName]]$nErr > 0) {
srcFileRes <- testData[[tsName]]$sourceFileResults
srcFileNames <- names(srcFileRes)
for(i in seq_along(srcFileRes)) {
testFuncNames <- names(srcFileRes[[i]])
for(j in seq_along(testFuncNames)) {
funcList <- srcFileRes[[i]][[testFuncNames[j]]]
if(funcList$kind == "error") {
lnk <- paste("",
paste(tsName, testFuncNames[j], sep=" : "),
"", sep="")
writeTableRow(row=c(lnk, funcList$msg),
htmlFile=fileName)
}
}
}
}
}
writeEndTable(htmlFile=fileName)
writeHtmlSep(htmlFile=fileName)
}
## failure table
if(separateFailureList && (errInfo$nFail > 0)) {
writeHtmlSection("Failures", 3, htmlFile=fileName)
writeBeginTable(c("Test suite : test function", "message"),
htmlFile=fileName,
columnWidth=c("30%", "70%"))
for(tsName in names(testData)) {
if(testData[[tsName]]$nFail > 0) {
srcFileRes <- testData[[tsName]]$sourceFileResults
srcFileNames <- names(srcFileRes)
for(i in seq_along(srcFileRes)) {
testFuncNames <- names(srcFileRes[[i]])
for(j in seq_along(testFuncNames)) {
funcList <- srcFileRes[[i]][[testFuncNames[j]]]
if(funcList$kind == "failure") {
lnk <- paste("",
paste(tsName, testFuncNames[j], sep=" : "),
"", sep="")
writeTableRow(row=c(lnk, funcList$msg),
htmlFile=fileName)
}
}
}
}
}
writeEndTable(htmlFile=fileName)
writeHtmlSep(htmlFile=fileName)
}
## deactivated table
if(separateFailureList && (errInfo$nDeactivated > 0)) {
writeHtmlSection("Deactivated", 3, htmlFile=fileName)
writeBeginTable(c("Test suite : test function", "message"),
htmlFile=fileName,
columnWidth=c("30%", "70%"))
for(tsName in names(testData)) {
if(testData[[tsName]]$nDeactivated > 0) {
srcFileRes <- testData[[tsName]]$sourceFileResults
srcFileNames <- names(srcFileRes)
for(i in seq_along(srcFileNames)) {
testFuncNames <- names(srcFileRes[[i]])
for(j in seq_along(testFuncNames)) {
funcList <- srcFileRes[[i]][[testFuncNames[j]]]
if(funcList$kind == "deactivated") {
lnk <- paste("",
paste(tsName, testFuncNames[j], sep=" : "),
"", sep="")
writeTableRow(row=c(lnk, funcList$msg),
htmlFile=fileName)
}
}
}
}
}
writeEndTable(htmlFile=fileName)
writeHtmlSep(htmlFile=fileName)
}
## --------------------------------
## PART 4: DETAILS
## --------------------------------
writeHtmlSection("Details", 3, htmlFile=fileName)
## loop over all test suites
for(tsName in names(testData)) {
tsList <- testData[[tsName]]
writeBeginTag("p", htmlFile=fileName)
writeBeginTag("a", para=paste("name=\"", tsName, "\"", sep=""),
htmlFile=fileName)
writeHtmlSection(paste("Test Suite:", tsName), 5, htmlFile=fileName)
writeEndTag("a", htmlFile=fileName)
pr("Test function regexp:", tsList$testFuncRegexp)
pr("Test file regexp:", tsList$testFileRegexp)
if(length(tsList$dirs) == 0) {
pr("No directories !")
}
else {
if(length(tsList$dirs) == 1) {
pr("Involved directory:")
}
else {
pr("Involved directories:")
}
for(dir in tsList$dirs) {
pr(dir)
}
res <- tsList$sourceFileResults
testFileNames <- names(res)
if(length(res) == 0) {
pr(" no test files")
}
else {
## loop over all source files
writeBeginTag("ul", htmlFile=fileName)
for(testFileName in testFileNames) {
testFuncNames <- names(res[[testFileName]])
if(length(testFuncNames) > 0) {
writeBeginTag("li", htmlFile=fileName)
writeLink(target=testFileToLinkMap(testFileName),
name=paste("Test file:", basename(testFileName)),
htmlFile=fileName)
## loop over all test functions in the test file
writeBeginTag("ul", htmlFile=fileName)
for(testFuncName in testFuncNames) {
writeBeginTag("li", htmlFile=fileName)
testFuncInfo <- res[[testFileName]][[testFuncName]]
anchorName <- createTestFuncRef(tsName, testFileName, testFuncName)
writeBeginTag("a", para=paste("name=\"", anchorName, "\"", sep=""),
htmlFile=fileName)
if(testFuncInfo$kind == "success") {
pr(paste(testFuncName, ": (",testFuncInfo$checkNum, " checks) ... OK (", testFuncInfo$time,
" seconds)", sep=""))
writeEndTag("a", htmlFile=fileName)
}
else {
if(testFuncInfo$kind == "error") {
writeBeginTag("u", para=paste("style", errorStyle, sep="="),
htmlFile=fileName)
writeRaw(paste(testFuncName, ": ERROR !! ", sep=""),
htmlFile=fileName)
writeEndTag("u", htmlFile=fileName)
writeEndTag("a", htmlFile=fileName)
}
else if (testFuncInfo$kind == "failure") {
writeBeginTag("u", para=paste("style", errorStyle, sep="="),
htmlFile=fileName)
writeRaw(paste(testFuncName, ": FAILURE !! (check number ",
testFuncInfo$checkNum, ") ", sep=""),
htmlFile=fileName)
writeEndTag("u", htmlFile=fileName)
writeEndTag("a", htmlFile=fileName)
}
else if (testFuncInfo$kind == "deactivated") {
writeBeginTag("u", para=paste("style", deactivatedStyle, sep="="),
htmlFile=fileName)
writeRaw(paste(testFuncName, ": DEACTIVATED, ", sep=""),
htmlFile=fileName)
writeEndTag("a", htmlFile=fileName)
}
else {
writeLi(paste(testFuncName, ": unknown error kind", sep=""))
writeEndTag("a", htmlFile=fileName)
}
pr(testFuncInfo$msg)
printTraceBack(testFuncInfo$traceBack)
}
writeEndTag("li", htmlFile=fileName)
}
writeEndTag("ul", htmlFile=fileName)
}
writeEndTag("li", htmlFile=fileName)
}
writeEndTag("ul", htmlFile=fileName)
}
}
writeHtmlSep(htmlFile=fileName)
}
ver <- cbind(unlist(version))
## add host name
ver <- rbind(ver, Sys.info()["nodename"])
rownames(ver)[dim(ver)[1]] <- "host"
colnames(ver) <- "Value"
## compiler used (under *nix)
rhome <- Sys.getenv("R_HOME")
## on Windows Makeconf does not exist
## other than that we have no indication which compiler
## would be used for R CMD INSTALL so we report NA
gccVersion <- as.character(NA)
makeconfFile <- file.path(rhome, "etc", "Makeconf")
if (file.exists(makeconfFile) && identical(.Platform$OS.type, "unix")) {
gccVersion <- system(paste("cat ", makeconfFile," | grep \"^CXX =\" "),
intern=TRUE)
gccVersion <- sub("^CXX[ ]* =[ ]*", "", gccVersion)
}
ver <- rbind(ver, gccVersion)
rownames(ver)[dim(ver)[1]] <- "compiler"
writeHtmlTable(ver,
htmlFile=fileName,
border=0,
width="80%",
append=TRUE)
## finish html document
writeHtmlEnd(htmlFile=fileName)
return(invisible(TRUE))
}
RUnit/R/00Init.r 0000644 0001751 0000144 00000002524 13267374743 013003 0 ustar hornik users ######################################################################
## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
RUnitEnv <- new.env()
.onLoad <- function(libname, pkgname)
{
##@bdescr
## Internal Function.
## Not to be called by users.
##@edescr
## runitVersion <- packageDescription("RUnit", lib.loc=libname, fields="Version")
assign(".testLogger", NULL, envir=RUnitEnv)
## add options to R's global options list
.buildRUnitOptions()
}
.onUnload <- function(libpath) {
## drop RUnit specific options from global options list
options("RUnit"=NULL)
}
RUnit/R/runit.r 0000644 0001751 0000144 00000036427 14561532231 013074 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
defineTestSuite <- function(name, dirs,
testFileRegexp="^runit.+\\.[rR]$",
testFuncRegexp="^test.+",
rngKind="Marsaglia-Multicarry",
rngNormalKind="Kinderman-Ramage")
{
##@bdescr
## Convenience functions to handle test suites
##@edescr
##
##@in name : [character] test suite title used in protocol
##@in dirs : [character] vector of paths to search for test case files
##@in testFileRegexp : [character] regular expression string to match file names
##@in testFuncRegexp : [character] (vector) regular expression string(s) to match test case functions within all test case files
##@in rngKind : [character] name of the RNG version, see RNGversion()
##@in rngNormalKind : [character] name of the RNG version for the rnorm, see RNGversion()
##@ret : [RUnitTestSuite] S3 class (list) object, ready for test runner
##
##@codestatus : testing
if (missing(dirs)) {
stop("argument 'dirs' is missing without a default.")
}
if (missing(name)) {
warning("argument 'name' is missing. using basename(dirs)[1] instead.")
name <- basename(dirs)[1]
}
ret <- list(name=name,
dirs=dirs,
testFileRegexp=testFileRegexp,
testFuncRegexp=testFuncRegexp,
rngKind=rngKind,
rngNormalKind=rngNormalKind)
class(ret) <- "RUnitTestSuite"
return(invisible(ret))
}
isValidTestSuite <- function(testSuite)
{
##@bdescr
## Helper function
## checks 'RUnitTestSuite' class object features
##@edescr
##
##@in testSuite : [RUnitTestSuite] S3 class (list) object, input object for test runner
##@ret : [logical] TRUE if testSuite is valid
##
##@codestatus : testing
if(!is(testSuite, "RUnitTestSuite"))
{
warning(paste("'testSuite' object is not of class 'RUnitTestSuite'."))
return(FALSE)
}
## check required elements, irrespective of order, allow for additional elements
requiredNames <- c("name", "dirs", "testFileRegexp", "testFuncRegexp",
"rngKind", "rngNormalKind")
if(!all(requiredNames %in% names(testSuite)))
{
warning("'testSuite' object does not conform to S3 class definition. Not all list elements present.")
return(FALSE)
}
for(i in seq_along(testSuite))
{
if(!is.character(testSuite[[i]])) {
warning(paste("'testSuite' object does not conform to S3 class definition.\n",
"'", names(testSuite)[i],"' element has to be of type 'character'.", sep=""))
return(FALSE)
}
if(any(testSuite[[i]] == "")) {
warning(paste("'testSuite' object does not conform to S3 class definition.\n",
"'",names(testSuite)[i],"' element may not contain empty string.", sep=""))
return(FALSE)
}
}
notFound <- !file.exists(testSuite[["dirs"]])
if (any(notFound)) {
warning(paste("specified directory",
paste(testSuite[["dirs"]][notFound], collapse=", "), "not found."))
return(FALSE)
}
if (length(testSuite[["name"]]) != 1) {
warning(paste("'name' element may only contain exactly one name."))
return(FALSE)
}
if (length(testSuite[["testFileRegexp"]]) != 1) {
warning(paste("'testFileRegexp' element may only contain exactly one string."))
return(FALSE)
}
if (length(testSuite[["testFuncRegexp"]]) != 1) {
warning(paste("'testFuncRegexp' element may only contain exactly one string."))
return(FALSE)
}
## RNGkind has an internal list of valid names which cannot be accessed
## programmatically. Furthermore, users can define their own RNG and select that one
## so we have to leave it to RNGkind() to check if the arguments are valid.
if (length(testSuite[["rngKind"]]) != 1) {
warning(paste("'rngKind' element may only contain exactly one name."))
return(FALSE)
}
if (length(testSuite[["rngNormalKind"]]) != 1) {
warning(paste("'rngNormalKind' element may only contain exactly one name."))
return(FALSE)
}
return(TRUE)
}
.setUp <- function() {
##@bdescr
## Internal Function.
## Default function to be executed once for each test case before the test case gets executed.
## This function can be adopted to specific package requirements for a given project.
## Need to replace this default with a new function definition.
## Function cannot take arguments and does not have a return value.
##@edescr
##
##@codestatus : internal
return(invisible())
}
.tearDown <- function() {
##@bdescr
## Internal Function.
## Default function to be executed once for each test case after the test case got executed.
## This function can be adopted to specific package requirements for a given project.
## Need to replace this default with a new function definition.
## Function cannot take arguments and does not have a return value.
##@edescr
##
##@codestatus : internal
return(invisible())
}
.executeTestCase <- function(funcName, envir, setUpFunc, tearDownFunc)
{
##@bdescr
## Internal Function.
## Execute individual test case, record logs and change state of global TestLogger object.
##@edescr
##
##@in funcName : [character] name of test case function
##@in envir : [environment]
##@in setUpFunc : [function]
##@in tearDownFunc : [function]
##@ret : [NULL]
##
##@codestatus : internal
## write to stdout for logging
func <- get(funcName, envir=envir)
## anything else than a function is ignored.
if(mode(func) != "function") {
return(invisible())
}
if (RUnitEnv$.testLogger$getVerbosity() > 0) {
cat("\n\nExecuting test function", funcName, " ... ")
}
## safe execution of setup function
res <- try(setUpFunc())
if (inherits(res, "try-error")) {
message <- paste("Error executing .setUp before",funcName, ":", geterrmessage())
RUnitEnv$.testLogger$addError(testFuncName=paste(".setUp (before ", funcName, ")", sep=""),
errorMsg=message)
return(invisible())
}
## reset book keeping variables in RUnitEnv$.testLogger
RUnitEnv$.testLogger$cleanup()
## ordinary test function execution:
timing <- try(system.time(func(), gcFirst=RUnitEnv$.gcBeforeTest))
if (inherits(timing, "try-error")) {
if(RUnitEnv$.testLogger$isFailure()) {
RUnitEnv$.testLogger$addFailure(testFuncName=funcName,
failureMsg=geterrmessage())
}
else if(RUnitEnv$.testLogger$isDeactivated()) {
RUnitEnv$.testLogger$addDeactivated(testFuncName=funcName)
}
else {
RUnitEnv$.testLogger$addError(testFuncName=funcName,
errorMsg=geterrmessage())
}
}
else {
RUnitEnv$.testLogger$addSuccess(testFuncName=funcName, secs=round(timing[3], 2))
}
## add number of check function calls within test case
RUnitEnv$.testLogger$addCheckNum(testFuncName=funcName)
## safe execution of tearDown function
res <- try(tearDownFunc())
if (inherits(res, "try-error")) {
message <- paste("Error executing .tearDown after",funcName, ":", geterrmessage())
RUnitEnv$.testLogger$addError(testFuncName=paste(".tearDown (after ", funcName, ")", sep=""),
errorMsg=message)
return(invisible())
}
if (RUnitEnv$.testLogger$getVerbosity() > 0) {
cat(" done successfully.\n\n")
}
return(invisible())
}
.sourceTestFile <- function(absTestFileName, testFuncRegexp)
{
##@bdescr
## This function sources a file, finds all the test functions in it, executes them
## and reports the results to the TestLogger.
## No return value, called for its side effects on TestLogger object
##@edescr
##
##@in absTestFileName : [character] absolute path name of the file to test
##@in testFuncRegexp : [character] a regular expression identifying the names of test functions
##@ret : [NULL]
##
##@codestatus : internal
RUnitEnv$.testLogger$setCurrentSourceFile(absTestFileName)
if (!file.exists(absTestFileName)) {
msgText <- paste("Test case file ", absTestFileName," not found.")
RUnitEnv$.testLogger$addError(testFuncName=absTestFileName, errorMsg=msgText)
return(invisible())
}
sandbox <- new.env(parent=.GlobalEnv)
## will be destroyed after function closure is left
## catch syntax errors in test case file
res <- try(sys.source(absTestFileName, envir=sandbox))
if (inherits(res, "try-error")) {
message <- paste("Error while sourcing ",absTestFileName,":",geterrmessage())
RUnitEnv$.testLogger$addError(testFuncName=absTestFileName, errorMsg=message)
return(invisible())
}
## test file provides definition of .setUp/.tearDown
if (exists(".setUp", envir=sandbox, inherits=FALSE)) {
.setUp <- get(".setUp", envir=sandbox)
}
if (exists(".tearDown", envir=sandbox, inherits=FALSE)) {
.tearDown <- get(".tearDown", envir=sandbox)
}
testFunctions <- ls(pattern=testFuncRegexp, envir=sandbox)
for (funcName in testFunctions) {
.executeTestCase(funcName, envir=sandbox, setUpFunc=.setUp, tearDownFunc=.tearDown)
}
}
runTestSuite <- function(testSuites, useOwnErrorHandler=TRUE, verbose=getOption("RUnit")$verbose,
gcBeforeTest=FALSE) {
##@bdescr
## This is the main function of the RUnit framework. It identifies all specified
## test files and triggers all required actions. At the end it creates a test
## protocol data object.
## IMPORTANT to note, the random number generator is (re-)set to the default
## methods specified in defineTestSuite() before each new test case *file* is sourced.
## This guarantees that each new test case set defined together in on file can rely
## on the default, even if the random number generator version is being reconfigured in some
## previous test case file(s).
##@edescr
##
##@in testSuites : [list] list of test suite lists
##@in useOwnErrorHandler : [logical] TRUE (default) : use the RUnit error handler
##@in verbose : [integer] >= 1: (default) write begin/end comments for each test case, 0: omit begin/end comment
##@in gcBeforeTest : [logical] FALSE (default) : garbage collect before timing each test
##@ret : [list] 'RUnitTestData' S3 class object
##
##@codestatus : testing
## preconditions
if (!is.logical(useOwnErrorHandler)) {
stop("argument 'useOwnErrorHandler' has to be of type logical.")
}
if (length(useOwnErrorHandler) != 1) {
stop("argument 'useOwnErrorHandler' has to be of length 1.")
}
if (is.na(useOwnErrorHandler)) {
stop("argument 'useOwnErrorHandler' may not contain NA.")
}
if (!is.logical(gcBeforeTest)) {
stop("argument 'gcBeforeTest' has to be of type logical.")
}
if (length(gcBeforeTest) != 1) {
stop("argument 'gcBeforeTest' has to be of length 1.")
}
if (is.na(gcBeforeTest)) {
stop("argument 'gcBeforeTest' may not contain NA.")
}
oFile <- getOption("RUnit")$outfile
if (!is.null(oFile)) {
if(is.character(oFile)) {
## connection has to be open when handed on to sink
oFile <- file(oFile, "w")
} else if(!inherits(oFile, "connection")) {
stop("'outfile' must be a connection or a character string.")
}
sink(file=oFile)
sink(file=oFile, type="message")
resetStream <- function() {
sink(type="message")
sink()
flush(oFile)
close(oFile)
##close(oFile)
}
on.exit(resetStream())
}
## record RNGkind and reinstantiate on exit
rngDefault <- RNGkind()
on.exit(RNGkind(kind=rngDefault[1], normal.kind=rngDefault[2]), add=TRUE)
oldErrorHandler <- getOption("error")
## reinstall error handler
on.exit(options(error=oldErrorHandler), add=TRUE)
## initialize TestLogger
assign(".testLogger", .newTestLogger(useOwnErrorHandler), envir=RUnitEnv)
RUnitEnv$.testLogger$setVerbosity(verbose)
## store the information about GC before test
assign(".gcBeforeTest", gcBeforeTest, envir=RUnitEnv)
## main loop
if (isValidTestSuite(testSuites)) {
testSuites <- list(testSuites)
} else if (isValidTestSuite(testSuites[[1]])) {
## do nothing
} else {
stop("invalid test suite supplied.")
}
for (i in seq_along(testSuites)) {
testSuite <- testSuites[[i]]
if(!isValidTestSuite(testSuite)) {
errMsg <- paste("Invalid test suite",testSuite$name,". Test run aborted.")
stop(errMsg)
}
RUnitEnv$.testLogger$setCurrentTestSuite(testSuite)
testFiles <- list.files(testSuite$dirs,
pattern = testSuite$testFileRegexp,
full.names=TRUE)
for(testFile in testFiles) {
## set a standard random number generator.
RNGkind(kind=testSuite$rngKind, normal.kind=testSuite$rngNormalKind)
.sourceTestFile(testFile, testSuite$testFuncRegexp)
}
}
ret <- RUnitEnv$.testLogger$getTestData()
return(ret)
}
runTestFile <- function(absFileName, useOwnErrorHandler=TRUE,
testFuncRegexp="^test.+",
rngKind="Marsaglia-Multicarry",
rngNormalKind="Kinderman-Ramage",
verbose=getOption("RUnit")$verbose,
gcBeforeTest=FALSE) {
##@bdescr
## Convenience function.
##@edescr
##
##@in absFileName : [character] complete file name of test cases code file
##@in useOwnErrorHandler : [logical] if TRUE RUnits error handler will be used
##@in testFuncRegexp : [character]
##@in rngKind : [character] name of the RNG, see RNGkind for avialbale options
##@in rngNormalKind : [character] name of the RNG for rnorm, see RNGkind for avialbale options
##@in verbose : [integer] >= 1: (default) write begin/end comments for each test case, 0: ommit begin/end comment (passed on to function runTestSuite)
##@in gcBeforeTest : [logical] FALSE (default) : garbage collect before timing each test
##@ret : [list] 'RUnitTestData' S3 class object
##
##@codestatus : testing
## preconditions
## all error checking and handling is delegated to function runTestSuite
fn <- basename(absFileName)
nn <- strsplit(fn, "\\.")[[1]][1]
dn <- dirname(absFileName)
ts <- defineTestSuite(name=nn, dirs=dn,
testFileRegexp=paste("^", fn, "$", sep=""),
testFuncRegexp=testFuncRegexp,
rngKind=rngKind,
rngNormalKind=rngNormalKind)
return(runTestSuite(ts, useOwnErrorHandler=useOwnErrorHandler,
verbose=verbose, gcBeforeTest=gcBeforeTest))
}
RUnit/R/checkFuncs.r 0000644 0001751 0000144 00000017550 14561530024 014001 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
checkEquals <- function(target, current, msg="",
tolerance = .Machine$double.eps^0.5, checkNames=TRUE, ...)
{
##@bdescr
## checks if two objects are equal, thin wrapper around 'all.equal'
## with tolerance one can adjust to and allow for numerical imprecision
##@edescr
##@in target : [ANY] one thing to be compared
##@in current : [ANY] second object to be compared
##@in msg : [character] an optional message to further identify and document the call
##@in tolerance : [numeric] directly passed to 'all.equal', see there for further documentation
##@in checkNames: [logical] iff TRUE do not strip names attributes from current and target prior to the comparison
##@ret : [logical] TRUE iff check was correct
##
##@codestatus : testing
if (missing(current)) {
stop("argument 'current' is missing")
}
if(!is.numeric(tolerance)) {
stop("'tolerance' has to be a numeric value")
}
if (length(tolerance) != 1) {
stop("'tolerance' has to be a scalar")
}
if(!is.logical(checkNames)) {
stop("'checkNames' has to be a logical value")
}
if (length(checkNames) != 1) {
stop("'checkNames' has to be a scalar")
}
if(.existsTestLogger()) {
RUnitEnv$.testLogger$incrementCheckNum()
}
if (!identical(TRUE, checkNames)) {
names(target) <- NULL
names(current) <- NULL
}
result <- all.equal(target, current, tolerance=tolerance, ...)
if (!identical(result, TRUE)) {
if(.existsTestLogger()) {
RUnitEnv$.testLogger$setFailure()
}
stop(paste(result, collapse="\n"), "\n", msg)
} else {
return(TRUE)
}
}
checkEqualsNumeric <- function(target, current, msg="", tolerance = .Machine$double.eps^0.5, ...)
{
##@bdescr
## checks if two objects are equal, thin wrapper around 'all.equal.numeric'
## with tolerance one can adjust to and allow for numerical imprecision.
## current and target are converted via as.vector() thereby stripping all attributes.
##@edescr
##@in target : [ANY] one thing to be compared
##@in current : [ANY] second object to be compared
##@in tolerance : [numeric] directly passed to 'all.equal.numeric', see there for further documentation
##@in msg : [character] an optional message to further identify and document the call
##
##@ret : [logical] TRUE, if objects 'target' and 'current' are equal w.r.t. specified numerical tolerance, else a stop signal is issued
##
##@codestatus : testing
if (missing(current)) {
stop("argument 'current' is missing")
}
if(!is.numeric(tolerance)) {
stop("'tolerance' has to be a numeric value")
}
if (length(tolerance) != 1) {
stop("'tolerance' has to be a scalar")
}
if(.existsTestLogger()) {
RUnitEnv$.testLogger$incrementCheckNum()
}
## Fix for R>4.1.2 where as.vector.data.frame returns a list instead of vector
if(is.data.frame(target)) {
target <- unlist(as.list(target), use.names=FALSE)
}
if(is.data.frame(current)) {
current <- unlist(as.list(current), use.names=FALSE)
}
## R 2.3.0: changed behaviour of all.equal
## strip attributes before comparing current and target
result <- all.equal.numeric(as.vector(target), as.vector(current), tolerance=tolerance, ...)
if (!identical(result, TRUE)) {
if(.existsTestLogger()) {
RUnitEnv$.testLogger$setFailure()
}
stop(paste(result, collapse="\n"), "\n", msg)
} else {
return(TRUE)
}
}
checkIdentical <- function(target, current, msg="")
{
##@bdescr
## checks if two objects are exactly identical, thin convenience wrapper around 'identical'
##
##@edescr
##@in target : [ANY] one object to be compared
##@in current : [ANY] second object to be compared
##@in msg : [character] an optional message to further identify and document the call
##
##@ret : [logical] TRUE, if objects 'target' and 'current' are identical
##
##@codestatus : testing
if (missing(current)) {
stop("argument 'current' is missing")
}
if(.existsTestLogger()) {
RUnitEnv$.testLogger$incrementCheckNum()
}
result <- identical(target, current)
if (!identical(TRUE, result)) {
if(.existsTestLogger()) {
RUnitEnv$.testLogger$setFailure()
}
stop(paste(paste(result, collapse="\n"), "\n", msg))
} else {
return(TRUE)
}
}
checkTrue <- function(expr, msg="")
{
##@bdescr
## checks whether or not something is true
##@edescr
##@in expr : [expression] the logical expression to be checked to be TRUE
##@in msg : [character] optional message to further identify and document the call
##
##@ret : [logical] TRUE, if the expression in a evaluates to TRUE, else a stop signal is issued
##
##@codestatus : testing
if (missing(expr)) {
stop("'expr' is missing")
}
if(.existsTestLogger()) {
RUnitEnv$.testLogger$incrementCheckNum()
}
## allow named logical argument 'expr'
result <- eval(expr)
names(result) <- NULL
if (!identical(result, TRUE)) {
if(.existsTestLogger()) {
RUnitEnv$.testLogger$setFailure()
}
stop("Test not TRUE\n", msg)
} else {
return(TRUE)
}
}
checkException <- function(expr, msg="", silent=getOption("RUnit")$silent)
{
##@bdescr
## checks if a function call creates an error. The passed function must be parameterless.
## If you want to check a function with arguments, call it like this:
## 'checkException(function() func(args...))'
##
## adding argument silent was suggested by Seth Falcon
## who provided a patch.
##@edescr
##@in expr : [parameterless function] the function to be checked
##@in msg : [character] an optional message to further identify and document the call
##@in silent : [logical] passed on to try, iff TRUE error messages will be suppressed
##
##@ret : [logical] TRUE, if evaluation of the expression results in a 'try-error', else a stop signal is issued
##
##@codestatus : testing
if (missing(expr)) {
stop("'expr' is missing")
}
if(is.null(silent)) {
silent <- FALSE
warning("'silent' has to be of type 'logical'. Was NULL. Set to FALSE.")
}
if(.existsTestLogger()) {
RUnitEnv$.testLogger$incrementCheckNum()
}
if (!inherits(try(eval(expr, envir=parent.frame()), silent=silent), "try-error")) {
if(.existsTestLogger()) {
RUnitEnv$.testLogger$setFailure()
}
stop("Error not generated as expected\n", msg)
} else {
return(TRUE)
}
}
DEACTIVATED <- function(msg="")
{
##@bdescr
## Convenience function, for maintaining test suites.
## If placed in an existing test case call
## the test will be executed normally until occurrence of the call
## after which execution will leave the test case (so all code will
## be checked and errors or failures reported as usual).
## An entry for a separate table in the log will be added
## for this test case.
##
##@edescr
##@in msg : [character] optional message to further identify and document the call
##
##@codestatus : testing
if(.existsTestLogger()) {
RUnitEnv$.testLogger$setDeactivated(paste(msg, "\n", sep=""))
}
stop(msg)
}
RUnit/R/textProtocol.r 0000644 0001751 0000144 00000021101 13267374743 014436 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
printTextProtocol <- function(testData,
fileName = "",
separateFailureList = TRUE,
showDetails = TRUE,
traceBackCutOff=9) {
##@bdescr
## Report generator
## Extracts the log information stored in the 'RUnitTestData' test run object
## and generates a well formated protocol output.
##@edescr
##
##@in testData : [RUnitTestData] S3 class object
##@in fileName : [character] string, full path + file name to be written to
##@in separateFailureList : [logical] if TRUE (default) add a failure list
##@in showDetails : [logical] if TRUE (default) add detailed traceback for each error incurred
##@in traceBackCutOff : [integer] number of steps back in the trace back stack to display
##@ret : [logical] TRUE if execution completed without error
##
##@codestatus : testing
## preconditions
if (!is(testData, "RUnitTestData")) {
stop("Argument 'testData' must be of class 'RUnitTestData'.")
}
if (!is.character(fileName)) {
stop("Argument 'fileName' has to be of type character.")
}
if (length(fileName) != 1) {
stop("Argument 'fileName' must contain exactly one element.")
}
if (!is.logical(separateFailureList)) {
stop("Argument 'separateFailureList' has to be of type logical.")
}
if (length(separateFailureList) != 1) {
stop("Argument 'separateFailureList' must contain exactly one element.")
}
if (!is.logical(showDetails)) {
stop("Argument 'showDetails' has to be of type logical.")
}
if (length(showDetails) != 1) {
stop("Argument 'showDetails' must contain exactly one element.")
}
if (!is.numeric(traceBackCutOff)) {
stop("Argument 'traceBackCutOff' has to be of type logical.")
}
if (length(traceBackCutOff) != 1) {
stop("Argument 'traceBackCutOff' must contain exactly one element.")
}
if (traceBackCutOff < 0 || traceBackCutOff > 100) {
stop("Argument 'traceBackCutOff' out of valid range [0, 100].")
}
## just a convenience function
pr <- function(..., sep=" ", nl=TRUE) {
if(nl) {
cat(... , "\n", file = fileName, append=TRUE, sep=sep)
} else {
cat(... , file = fileName, append=TRUE, sep=sep)
}
}
## get singular or plural right
sop <- function(number, word, plext="s") {
ifelse(number == 1, paste(number, word),
paste(number, paste(word, plext, sep="")))
}
## header part
cat("RUNIT TEST PROTOCOL --", date(), "\n", file = fileName)
pr("***********************************************")
if(length(testData) == 0) {
pr("no test cases :-(")
return(invisible(TRUE))
}
errInfo <- getErrors(testData)
pr("Number of test functions:", errInfo$nTestFunc)
if(errInfo$nDeactivated > 0) {
pr("Number of deactivated test functions:", errInfo$nDeactivated)
}
pr("Number of errors:", errInfo$nErr)
pr("Number of failures:", errInfo$nFail, "\n\n")
## summary of test suites
pr(sop(length(testData), "Test Suite"), ":")
for(tsName in names(testData)) {
pr(tsName, " - ", sop(testData[[tsName]]$nTestFunc, "test function"), ", ",
sop(testData[[tsName]]$nErr, "error"), ", ",
sop(testData[[tsName]]$nFail, "failure"), sep="")
if(separateFailureList && (testData[[tsName]]$nErr + testData[[tsName]]$nFail > 0)) {
srcFileRes <- testData[[tsName]][["sourceFileResults"]]
for(i in seq_along(srcFileRes)) {
testFuncNames <- names(srcFileRes[[i]])
for(j in seq_along(testFuncNames)) {
funcList <- srcFileRes[[i]][[testFuncNames[j]]]
if(funcList$kind == "error") {
pr("ERROR in ", testFuncNames[j], ": ", funcList$msg, nl=FALSE, sep="")
} else if(funcList$kind == "failure") {
pr("FAILURE in ", testFuncNames[j], ": ", funcList$msg,
sep="", nl=FALSE)
} else if(funcList$kind == "deactivated") {
pr("DEACTIVATED ", testFuncNames[j], ": ", funcList$msg,
sep="", nl=FALSE)
}
}
}
}
}
## if no details are required, we are done.
if(!showDetails) {
return(invisible(TRUE))
}
pr("\n\n\nDetails")
## loop over all test suites
for(tsName in names(testData)) {
tsList <- testData[[tsName]]
pr("***************************")
pr("Test Suite:", tsName)
pr("Test function regexp:", tsList$testFuncRegexp)
pr("Test file regexp:", tsList$testFileRegexp)
if(length(tsList$dirs) == 0) {
pr("No directories !")
} else {
if(length(tsList$dirs) == 1) {
pr("Involved directory:")
} else {
pr("Involved directories:")
}
for(dir in tsList$dirs) {
pr(dir)
}
res <- tsList$sourceFileResults
testFileNames <- names(res)
if(length(res) == 0) {
pr("no test files")
} else {
## loop over all source files
for(testFileName in testFileNames) {
testFuncNames <- names(res[[testFileName]])
if(length(testFuncNames) > 0) {
pr("---------------------------")
pr("Test file:", testFileName)
## loop over all test functions in the test file
for(testFuncName in testFuncNames) {
testFuncInfo <- res[[testFileName]][[testFuncName]]
if(testFuncInfo$kind == "success") {
pr(testFuncName, ": (",testFuncInfo$checkNum, " checks) ... OK (",
testFuncInfo$time, " seconds)", sep="")
} else {
if(testFuncInfo$kind == "error") {
pr(testFuncName, ": ERROR !! ", sep="")
} else if (testFuncInfo$kind == "failure") {
pr(testFuncName, ": FAILURE !! (check number ",
testFuncInfo$checkNum, ")", sep="")
} else if (testFuncInfo$kind == "deactivated") {
pr(testFuncName, ": DEACTIVATED, ", nl=FALSE)
} else {
pr(testFuncName, ": unknown error kind", sep="")
}
pr(testFuncInfo$msg, nl=FALSE)
if(length(testFuncInfo$traceBack) > 0) {
pr(" Call Stack:")
if(traceBackCutOff > length(testFuncInfo$traceBack)) {
pr(" (traceBackCutOff argument larger than length of ",
"trace back: full trace back printed)")
for(i in 1:length(testFuncInfo$traceBack)) {
pr(" ", i, ": ", testFuncInfo$traceBack[i], sep="")
}
} else {
for(i in traceBackCutOff:length(testFuncInfo$traceBack)) {
pr(" ", 1+i-traceBackCutOff, ": ",
testFuncInfo$traceBack[i], sep="")
}
}
}
}
}
}
}
}
}
}
## return type
return(invisible(TRUE))
}
print.RUnitTestData <- function(x, ...)
{
##@bdescr
## Generic print method
##@edescr
##
##@in x : [RUnitTestData] S3 class object
##@in ... : [ANY] currently ignored
##@ret : [NULL]
##
##@codestatus : untested
errInfo <- getErrors(x)
cat("Number of test functions:", errInfo$nTestFunc, "\n")
if(errInfo$nDeactivated > 0) {
cat("Number of deactivated test functions:", errInfo$nDeactivated, "\n")
}
cat("Number of errors:", errInfo$nErr, "\n")
cat("Number of failures:", errInfo$nFail, "\n")
}
summary.RUnitTestData <- function(object, ...)
{
##@bdescr
## Generic summary method
##@edescr
##
##@in object : [RUnitTestData] S3 class object
##@in ... : [ANY]
##@ret : [logical] return valof from printTextProtocol
##
##@codestatus : untested
printTextProtocol(object, ...)
}
RUnit/NEWS 0000644 0001751 0000144 00000015547 14561532231 012046 0 ustar hornik users Dear Emacs, please make this -*-Text-*- mode!
**************************************************
*
*
* RUnit
*
*
*
**************************************************
Changes in RUnit 0.4.33
o checkEqualsNumeric functions when given two one-column data.frames
Changes in RUnit 0.4.32
o runTestSuite and runTestFile takes additional gcBeforeTest parameter
(default FALSE). This disables running garbage collector before timing
the test.
This setting speeds up the test suite
at the cost of making individual test timing less reliable.
When trying to optimize tests for speed, set gcBeforeTest to TRUE for
more reliable timing information.
o added .Rinstignore to cut down on warnings when building the package
o removed Biobase specific tests, replaced with direct S4 class creation
o fixed CRAN URLs in README.md
Changes in RUnit 0.4.31
o checkEquals and others output optional message on separate line
Changes in RUnit 0.4.30
o printJUnitProtocol added for JUnit-style output
Changes in RUnit 0.4.29
o changed maintainer to Roman Zenka
o .testLogger global variable now stored in package environment RUnitEnv
o added imports of graphics package to NAMESPACE
Changes in RUnit 0.4.26
o isValidTestSuite: fixed insufficient if expression handling, reported by Rich Calaway;
extended validity checks
Changes in RUnit 0.4.25
o enable redirection of error and log messages to file, controlled via new
global option 'outfile', (following a suggestion by Seth Falcon)
Changes in RUnit 0.4.24
o added RUnit specific options 'verbose' and 'silent' to global options list
to allow control of test log output
o moved unit tests from tests/ to inst/unitTests
o added Makefile for executing unit tests (using R wiki example)
Changes in RUnit 0.4.23
o vignette: fixed function name in example code, reported by Blair Christian
o init .testLogger to avoid R CMD check NOTE messages
o allow verbosity of console output log to be controlled: added 'verbose' argument
to runTestFile and runTestSuite (following a suggestion by Seth Falcon)
o test logger object declared as S3 class 'TestLogger'
Changes in RUnit 0.4.22
o clarified applicable license: GPL 2
o defineTestSuite: gained some argument checks
o isValidTestSuite: check for empty name
o includeTracker: fix `<- if` handling
Changes in RUnit 0.4.21
o documentation issues corrected, identified by new R 2.9.0 devel Rd parser
Changes in RUnit 0.4.20
o test protocol generation on Mac OS X failed due to incorrect code to identify
'gcc' version
o Rd documentation updated
Changes in RUnit 0.4.19
o test protocol now states check number per test case
o changed check for object class to is() to allow derived class objects to pass
(suggested by Philippe Grosjean)
o removed start up message
Changes in RUnit 0.4.18
o seq_along introduced instead of seq( ) for efficiency and R version dependency set to
2.4.0 when seq_along was introduced
o some small changes to avoid warnings with options(warnPartialMatchArgs=TRUE)
Changes in RUnit 0.4.17
o corrected documentation example code
Changes in RUnit 0.4.16
o changed the environment test code files are evaluated, now
a new environment outside the RUnit namespace is utilized,
allowing e.g. setClass calls without specifying where=.GlobalEnv
o updated documentation to use encoding latin1
o use LazyLoad: yes instead of SaveImage:yes (to be deprecated for R 2.6.0)
o internal error handler rewritten to be more failure robust
o added new test cases for .setUp and .tearDown, extended tests
to cover S4 class and method behaviour in check* functions
o example on S4 virtual class testing added
o utility function to compare to RUnitTestResult objects added:
concept idea for comparing and optimizing test suite
performance (share/R/checkCode.r)
Changes in RUnit 0.4.15
o compatibility to R 1.9.0 as declared in DESCRIPTION: removed calls to isTRUE
as this was introduced only in R 2.1.0, replaced where needed by identical(TRUE, x)
o fixed printHTMLProtocol: on Windows Makeconf does not exist so
CC compiler used by R cannot be queried this way (reported by
Tobias Verbeke)
Changes in RUnit 0.4.14
o stated all package dependencies in DESCRIPTION, required for R
2.4.0 compatibility
Changes in RUnit 0.4.13
o allow the RNG to be set by the user via new arguments 'rngKind' and
'rngNormalKind' to functions defineTestSuite and runTestFile (patch by Seth Falcon)
o fixed exit status: RNG kind was left changed after runTestSuite execution in
user workspace
o email contact address modified
Changes in RUnit 0.4.12
o allow *.R test case file extension (suggested by Gregor Gorjanc)
o fixed code typo in example vignette (spotted by Gregor Gorjanc)
Changes in RUnit 0.4.11
o checkException: argument silent added to allow to suppress
error messages emitted by the failing function
o inspect: added argument track, which _has_ to be provided
at each invocation to avoid recursive default argument
reference call errors (experimental: subject to change if this
leads to new incompatibilities)
Changes in RUnit 0.4.9
o checkEquals has new compatibility argument checkNames
Changes in RUnit 0.4.8
o checkIdentical added, to allow to check for exact identity
Changes in RUnit 0.4.7
o update for checkEqualsNumeric to be compatible with R 2.3.0
Changes in RUnit 0.4.5
o improvements to error detection in runTestSuite
Changes in RUnit 0.4.4
o changed maintainer
Changes in RUnit 0.4.2
o checkTrue: corrected handling of named logical arguments
Changes in RUnit 0.4.1
o printHTMLProtocol has new parameter 'testFileToLinkMap'
to allow to provide a function to add dynamically generated
URLs for each test case file, e.g. for use with CVSweb
Changes in RUnit 0.4.0
o New 'error' category DEACTIVATED introduced: If the function
DEACTIVATED is inserted into a test function the function
stops at that point and is reported as deactivated in the test
protocol.
o New function 'getErrors' which takes a list of type
'RUnitTestData' and returns some very basic error information
of a test run.
o The name of the currently executed test function is written to
standard out.
o 'printHTMLProtocol' fixed such that it does not produce a
warning anymore.
o Dependency on package 'splines' removed.
o Various small fixes of the documentation.
RUnit/COPYING 0000644 0001751 0000144 00000043131 13267374743 012406 0 ustar hornik users GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program 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.
This program 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 this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) year name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.
RUnit/vignettes/ 0000755 0001751 0000144 00000000000 15024242132 013334 5 ustar hornik users RUnit/vignettes/RUnit.Rnw 0000644 0001751 0000144 00000050422 14563457515 015114 0 ustar hornik users % -*- mode: noweb; noweb-default-code-mode: R-mode; -*-
%
% $Id: RUnit.Rnw,v 1.22 2009/11/25 15:12:11 burgerm Exp $
%
%
%\VignetteIndexEntry{RUnit primer}
%\VignetteKeywords{Unit Testing, Code Inspection, Programming}
%\VignetteDepends{methods, splines}
%\VignettePackage{RUnit}
\documentclass[12pt, a4paper]{article}
%\usepackage{amsmath,pstricks}
\usepackage{hyperref}
%\usepackage[authoryear,round]{natbib}
%\parskip=.3cm
\oddsidemargin=.1in
\evensidemargin=.1in
\headheight=-.3in
\newcommand{\scscst}{\scriptscriptstyle}
\newcommand{\scst}{\scriptstyle}
\newcommand{\Rfunction}[1]{{\texttt{#1}}}
\newcommand{\Robject}[1]{{\texttt{#1}}}
\newcommand{\Rpackage}[1]{{\textit{#1}}}
%\makeindex
%
\begin{document}
\title{RUnit - A Unit Test Framework for R}
\author{Thomas K\"onig, Klaus J\"unemann, and Matthias Burger\\Epigenomics AG}
\maketitle
\tableofcontents
\section*{Abstract}
\label{section:abstract}
Software development for production systems presents a challenge to the development team as the quality of the coded package(s) has to be constantly monitored and verified. We present a generic approach to software testing for the R language modelled after successful examples such as JUnit, CppUnit, and PerlUnit. The aim of our approach is to facilitate development of reliable software packages and provide a set of tools to analyse and report the software quality status. The presented framework is completely implemented within R and does not rely on external tools or other language systems. The basic principle is that every function or method is accompanied with a test case that queries many calling situations including incorrect invocations. A test case can be executed instantly without reinstalling the whole package - a feature that is necessary for parallel development of functionality and test cases. On a second level one or more packages can be tested in a single test run, the result of which is reported in an well structured test protocol.
To verify the coverage of the test framework a code inspector is provided that monitors the code coverage of executed test cases. The result of individual test invocations as well as package wide evaluations can be compiled into a summary report exported to HTML. This report details the executed tests, their failure or success, as well as the code coverage. Taking it one step further and combining the build system with a development and release procedure with defined code status description this approach opens the way for a principled software quality monitoring and risk assessment of the developed application.
For our code development we have utilised the described system with great benefit w.r.t.\ code reliability and maintenance efforts in a medium sized development team.
\section{Introduction}
The importance of software testing can hardly be overrated. This
is all the more true for interpreted languages where not even a compiler
checks the basic consistency of a program. Nonetheless, testing is
often perceived more as a burden than a help by the
programmer. Therefore it is necessary to provide tools that make the
task of testing as simple and systematic as possible. The key goal of
such a testing framework should be to promote the creation and
execution of test cases to become an integral part of the software
development process. Experience shows that such a permanently repeated
code - test - simplify cycle leads to faster and more successful
software development than the usually futile attempt to add test cases
once the software is largely finished. This line of thought has been
pushed furthest by the Extreme Programming
\cite{xp} and Test-First paradigms
where test cases are viewed as the essential guidelines for the
development process. These considerations lead to various requirements
that a useful testing framework should satisfy:
\begin {itemize}
\item {Tests should be easy to execute.}
\item {The results should be accessible through a well structured test
protocol.}
\item{It should be possible to execute only small portions of the test
cases during the development process.}
\item{It should be possible to estimate the amount of code that is
covered by some test case.}
\end {itemize}
%\paragraph{Background}
%\label{paragraph:Background}
Testing frameworks that address these aspects have been written in a
variety of languages such as Smalltalk, Java, C++ and Python. In
particular, the approach described in \cite{beck} has turned out to be
very successful, leading -- among others -- to the popular JUnit
library for Java \cite{junit}, which has
been ported to many other languages (see \cite{xp} for an extensive list of testing
frameworks for all kinds of languages). Accordingly, the RUnit package (available at sourceforge \cite{runit-sf}) is our
version of porting JUnit to R, supplemented by additional
functionality to inspect the test coverage of some function under question.
%\paragraph{Motivation}
%\label{paragraph:Motivation}
One may wonder why R would need yet another testing framework
even though the standard method, namely executing {\it R CMD check} on ones complete package at the shell prompt, is widely accepted and applied.
We think, however, that the RUnit approach is more in line with the above listed
requirements and can be seen as a complement to the existing process in that:
\begin{itemize}
\item{test cases are called and executed from the R prompt}
\item{the programmer decides which result or functionality to put under testing, e.g.\
formating issues of textual output do not need to matter}
\item{test and reference data files need not be maintained separately but are combined into one file}
\item{test cases need not be limited to testing/using functionality from one package checked at a time}
\end{itemize}
Moreover, testing frameworks based on JUnit ports seem
to have become a quasi standard in many programming languages. Therefore,
programmers new to R but familiar with other languages might
appreciate a familiar testing environment. And finally, offering more
than one alternative in the important field of code testing is certainly not a bad idea and could turn out useful.
Before explaining the components of the RUnit package in detail,
we would like to list some of the lessons learned in the attempt of
writing useful test suites for our software (a more complete collection
of tips relating to a Test-First development approach can be found in \cite{tfg}):
\begin{itemize}
\item {Develop test cases parallel to implementing your
functionality. Keep testing all the time (code - test - simplify
cycle). Do not wait until the software is complete and attempt to
add test cases at the very end. This typically leads to poor quality
and incomplete test cases.}
\item{Distinguish between unit and integration tests: Unit tests
should be as small as possible and check one unit of functionality
that cannot be further decomposed. Integration tests, on the other
hand, run through a whole analysis workflow and check the
interplay of various software components.}
\item{Good test coverage enables refactoring, by which a
reorganisation of the implementation is meant. Without regular testing the
attitude {\it `I better do not touch this code anymore`} once some piece
of software appears to be working is frequently
encountered. It is very pleasing and time-saving just to run a
test suite after some improvement or simplification of the
implementation to see that all test cases are still passing
(or possibly reveal some newly introduced bug). This
refactoring ability is a key benefit of unit testing leading
not only to better software quality but also to better design.}
\item{Do not test internal functions but just the public interface of
a library. Since R does not provide very much language support for this
distinction, the first step here is to clarify which
functions are meant to be called by a user of a package and which are
not (namespaces in R provide a useful directive for making this distinction, if
the export list is selected carefully and maintained).
If internal functions are directly tested, the ability of
refactoring gets lost because this typically involves
reorganisation of the internal part of a library.}
\item {Once a bug has been found, add a corresponding test case.}
\item{We greatly benefitted from an automated test system: A
shell script, running nightly, checks out and installs all relevant packages.
After that all test suites are run and the resulting test protocol is stored
in a central location. This provides an excellent overview over the current
status of the system and the collection of nightly test protocols documents
the development progress.}
\end{itemize}
\section{The RUnit package}
\label{section:RUnitPackage}
This section contains a detailed explanation of the RUnit package and
examples how to use it. As has already been mentioned the package
contains two independent components: a framework for test case
execution and a tool that allows to inspect the flow of execution
inside a function in order to analyse which portions of code are
covered by some test case.
Both components are now discussed in turn.
\subsection{Test case execution}
\label{subsection:Testcaseexecution}
The basic idea of this component is to execute a set of test functions
defined through naming conventions, store whether or not the test
succeeded in a central logger object and finally write a test protocol
that allows to precisely identify the problems.
{\bf Note, that RUnit - by default - sets the version for normal, and all other RNGs to 'Kinderman-Ramage', and 'Marsaglia-Multicarry', respectively. If you like to change these defaults please see {\tt ?defineTestSuite} for argument 'rngNormalKind' and 'rngKind'.}
As an example consider a function that converts centigrade to
Fahrenheit:
\begin{Sinput}
c2f <- function(c) return(9/5 * c + 32)
\end{Sinput}
A corresponding test function could look like this:
\begin{Sinput}
test.c2f <- function() {
checkEquals(c2f(0), 32)
checkEquals(c2f(10), 50)
checkException(c2f("xx"))
}
\end{Sinput}
The default naming convention for test functions in the RUnit package is {\tt test...} as is standard in JUnit. To perform the actual checks that the function to be tested works correctly a set of functions called {\tt check ...} is provided. The purpose of these {\tt check} functions is two-fold: they make sure that a possible failure is reported to the central test logger so that it will appear properly in the final test protocol and they are supposed to make explicit the actual checks in a test case as opposed to other code used to set up the test scenario. Note that {\tt checkException} fails if the passed expression does not generate an error. This kind of test is useful to make sure that a function correctly recognises error situations instead of silently creating inappropriate results. These check functions are direct equivalents to the various {\tt assert} functions of the JUnit framework. More information can be found in the online help.
Before running the test function it is necessary to create a test suite which is a collection of test functions and files relating to one topic. One could, for instance, create one test suite for one R package. A test suite is just a list containing a name, an array of absolute directories containing the locations of the test files, a regular expression identifying the test files and a regular expression identifying the test functions. In our example assume that the test function is located in a file {\tt runitc2f.r} located in a directory {\tt /foo/bar/}. To create the corresponding test suite we can use a helper function:
\begin{Sinput}
testsuite.c2f <- defineTestSuite("c2f",
dirs = file.path(.path.package(package="RUnit"),
"examples"),
testFileRegexp = "^runit.+\\.r",
testFuncRegexp = "^test.+",
rngKind = "Marsaglia-Multicarry",
rngNormalKind = "Kinderman-Ramage")
\end{Sinput}
All that remains is to run the test suite and print the test protocol:
\begin{Sinput}
testResult <- runTestSuite(testsuite.c2f)
printTextProtocol(testResult)
\end{Sinput}
The resulting test protocol should be self explanatory and can also be printed as HTML version. See the online help for further information.
Note that for executing just one test file there is also a shortcut in order to make test case execution as easy as possible:
\begin{Sinput}
runTestFile(file.path(.path.package(package="RUnit"),
"examples/runitc2f.r"))
\end{Sinput}
The creation and execution of test suites can be summarised by the following recipe:
\begin{enumerate}
\item{create as many test functions in as many test files as necessary }
\item{create one or more test suites using the helper function {\tt defineTestSuite}}
\item{run the test suites with {\tt runTestSuite}}
\item{print the test protocol either with {\tt printTextProtocol} or with {\tt printHTMLProtocol} (or with a generic method like {\tt print} or {\tt summary})}
\end{enumerate}
We conclude this section with some further comments on various aspects of the test execution framework:
\begin{itemize}
\item{A test file can contain an arbitrary number of test functions. A test directory can contain an arbitrary number of test files, a test suite can contain an arbitrary number of test directories and the test runner can run an arbitrary number of test suites -- all resulting in one test protocol. The test function and file names of a test suite must, however, obey a naming convention expressible through regular expressions.
As default test functions start with {\tt test} and files with {\tt runit}.}
\item{RUnit makes a distinction between failure and error. A failure occurs if one of the check functions fail (e.g.~{\tt checkTrue(FALSE)} creates a failure). An error is reported if an ordinary R error (usually created by {\tt stop}) occurs.}
\item{Since version 0.4.0 there is a function {\tt DEACTIVATED} which
can be used to deactivate test cases temporarily. This might be useful
in the case of a major refactoring. In particular, the deactivated
test cases are reported in the test protocol so that they cannot fall
into oblivion.}
\item{The test runner tries hard to leave a clean R session behind. Therefore all objects created during test case execution will be deleted after a test file has been processed.}
\item{In order to prevent mysterious errors the random number generator is reset to a standard setting before sourcing a test file. If a particular setting is needed to generate reproducible results it is fine to configure the random number generator at the beginning of a test file. This setting applies during the execution of all test functions of that test file but is reset before the next test file is sourced.}
\item{In each source file one can define the parameterless functions {\tt .setUp()} and {\tt .tearDown()}.
which are then executed directly before and after each test function. This can, for instance, be used to control global settings or create addition log information.}
\end{itemize}
\subsection{R Code Inspection}
\label{subsection:RCodeInspection}
The Code Inspector is an additional tool for checking detailed test case coverage and getting profiling information.
It records how often a code line will be executed. We utilise this information for improving our test cases, because we can identify code lines not executed by the current test case code.
The Code Inspector is able to handle S4 methods.
During the development of the Code Inspector, we noticed, that the syntax of R is very flexible.
Because our coding philosophy has an emphasis of maintenance and a clear style, we developed style guides for our R coding.
Therefore, one goal for the Code Inspector was to handle our coding styles in a correct manner.
This leads to the consequence that not all R expression can be handled correctly.
In our implementation the Code Inspector has two main functional parts.
The first part is responsible for parsing and modifying the code of the test function.
The second part, called the Tracker, holds the result of the code tracking.
The result of the tracking process allows further analysis of the executed code.
\subsubsection{Usage}
The usage of the Code Inspector and the Tracker object is very simple. The following code snippet is an example:
<>=
library(RUnit)
## define sample functions to be tested
foo <- function(x) {
x <- x*x
x <- 2*x
return(x)
}
test.foo <- function() {
checkTrue(is.numeric(foo(1:10)))
checkEquals(length(foo(1:10)), 10)
checkEqualsNumeric(foo(1), 2)
}
bar <- function(x, y=NULL) {
if (is.null(y)) {
y <- x
}
if (all(y > 100)) {
## subtract 100
y <- y - 100
}
res <- x^y
return(res)
}
track <- tracker(); ## initialize a tracking "object"
track$init(); ## initialize the tracker
a <- 1:10
d <- seq(0,1,0.1)
resFoo <- inspect(foo(a), track=track); ## execute the test function and track
resBar <- inspect(bar(d), track=track); ## execute the test function and track
resTrack <- track$getTrackInfo(); ## get the result of Code Inspector (a list)
printHTML(resTrack, baseDir=tempdir()) ; ## create HTML sites
@
Note, that the tracking object is an global object and must have the name {\tt track}.
The {\tt inspect} function awaits a function call as argument and executes and tracks the function.
The results will be stored in the tracking object.
The result of the function (not of the Tracker) will be returned as usual.
The tracking results will received by tr\$getResult().
With {\tt printHTML} the result of the tracking process will be presented as HTML pages.
\subsubsection{Technical Details}
The general idea for the code tracking is to modify the source code of the function.
Therefore, we use the {\tt parse} and {\tt deparse} functions and the capability of R to generate functions on runtime.
To track the function we try to include a hook in every code line.
That hook calls a function of the tracked object.
The information of the tracking will be stored in the closure of the tracking object (actually a function).
Because the R parser allows very nested expressions, we didn't try to modify every R expression.
This is a task for the future.
A simple example for the modifying process is as follow:\\
original:
<>=
foo <- function(x)
{
y <- 0
for(i in 1:x)
{
y <- y + x
}
return(y)
}
@
modified:
<>=
foo.mod <- function(x)
{
track$bp(1) ;
y <- 0
track$bp(2);
for(i in 1:x)
{
track$bp(4) ;
y <- y +x
}
track$bp(6);
return(y)
}
@
Problematic code lines are:
<>=
if(any(a==1)) {
print("do TRUE")
} else print ("do FALSE");
@
This must be modified to
<>=
if(any(a==1)) {
track$bp(2);
print("do TRUE")
}else{
track$bp(3);
print("do FALSE");
}
@
The problem is the \textit{else} branch, that cannot be modified in the current version.
\section{Future Development Ideas}
Here we briefly list -- in an unordered manner -- some of the avenues for future development we or someone interested in this package could take:
\begin{itemize}
\item{extend the {\tt checkEquals} function to handle complex S4 class objects correctly in comparisons. To this end R core has modified check.equal to handle S4 objects.}
\item{reimplement the internal structures storing the test suite as well as the test result data as S4 classes.}
\item{record all warnings generated during the execution of a test function.}
\item{add tools to create test cases automatically. This is a research project but -- given the importance of testing -- worth the effort. See \cite{junit} for various approaches in other languages.}
\item{improve the export of test suite execution data e.g.~by adding XML data export support.}
\item{add some evaluation methods to the code inspector e.g.~use software metrics to estimate standard measures of code quality, complexity, and performance.}
\item{overcome the problem of nested calls to registered functions for code inspection.}
\item{allow automatic registration of functions \& methods.}
\end{itemize}
\begin{thebibliography}{99}
% \bibliographystyle{plainnat}
\bibitem{xp} http://www.xprogramming.com
\bibitem{beck} http://www.xprogramming.com/testfram.htm
\bibitem{junit} http://www.junit.org/
\bibitem{tfg} http://www.xprogramming.com/xpmag/testFirstGuidelines.htm
\bibitem{runit-sf} https://sourceforge.net/projects/runit/
\end{thebibliography}
\end{document}
RUnit/ChangeLog 0000644 0001751 0000144 00000121005 14563457515 013121 0 ustar hornik users 2024-02-15 12:15 zenkar
* cleaned up minor CRAN check notes
2009-04-22 15:52 burgerm
* tests/runitInspect.r: added test cases for more complex functions
to track
2009-04-22 15:50 burgerm
* R/inspector.r: includeTracker: fix `<- if` call handling which
caused the inspect mechanism to fail
2009-04-22 15:48 burgerm
* R/runit.r: isValidTestSuite: check for empty name string as this
will cause subsequent failure which is harder to understand
2009-04-22 15:46 burgerm
* NAMESPACE: declare S3 print and summary methods for RUnitTestData
2009-04-22 11:37 burgerm
* inst/doc/RUnit.pdf: removed: use R CMD build to generate, no need
to store in repository
2009-04-16 11:54 burgerm
* DESCRIPTION: patch level 0.4.22: clarified GPL version
2009-04-16 11:49 burgerm
* R/textProtocol.r: specified license to be version 2 of the GPL
2009-04-16 11:48 burgerm
* R/testLogger.r: specified license to be version 2 of the GPL;
extended function descriptions
2009-04-16 11:44 burgerm
* R/: checkFuncs.r, exportHTML.r, html.r, htmlProtocol.r,
inspector.r, runit.r: specified license to be version 2 of the
GPL
2009-04-16 11:39 burgerm
* R/00Init.r: specified license to be version 2 of the GPL
2009-04-16 11:23 burgerm
* inst/: examples/correctTestCase.r,
examples/runitVirtualClassTest.r, share/R/checkCode.r,
share/R/compareRUnitTestData.r: specified license to be version 2
of the GPL
2009-04-16 11:18 burgerm
* tests/: runitHTMLProtocol.r, runitInspect.r,
runitPlotConnection.r, runitRUnit.r, runitS4.r, runitSetUp.r,
runitTearDown.r, runitTextProtocol.r: specified license to be
version 2 of the GPL
2009-04-16 11:13 burgerm
* man/: RUnit-internal.Rd, RUnit-intro.Rd, checkFuncs.Rd,
inspect.Rd, printHTML.trackinfo.Rd, runit.Rd, textProtocol.Rd,
tracker.Rd: specified license to be version 2 of the GPL
2009-03-16 17:38 burgerm
* R/inspector.r: always coninue if-else on the same line removed
semicolon at line ends
2009-03-16 17:36 burgerm
* R/runit.r: defineTestSuite: gained some argument checks
isValidTestSuite: warning messages modified to handle multiple
names some typos in inline documentation fixed
2009-03-16 17:29 burgerm
* R/checkFuncs.r: always coninue if else on the same line
checkIdentical: added precondition check
2009-03-16 17:26 burgerm
* R/exportHTML.r: always coninue if-else on the same line removed
semicolon at line ends
2009-03-16 17:24 burgerm
* R/html.r: always coninue if else on the same line html.r removed
semicolon at line ends
2009-03-16 17:21 burgerm
* inst/doc/RUnit.Rnw: minute corrections
2009-03-05 16:58 burgerm
* DESCRIPTION: License field updated according to R-ext for R 2.8.1
2009-01-23 19:13 burgerm
* man/: checkFuncs.Rd, inspect.Rd, printHTML.trackinfo.Rd,
runit.Rd, textProtocol.Rd, tracker.Rd: corrected typos, changed
formating of code chunks to allow for proper display in pdf
reference manual (suggested by Terry Therneau)
2009-01-23 17:23 burgerm
* NEWS: typos corrected
2009-01-15 14:47 burgerm
* DESCRIPTION: patch level 0.4.21
2009-01-15 14:46 burgerm
* ChangeLog: update for 0.4.21 submission
2009-01-15 14:46 burgerm
* NEWS: updated for 0.4.21 submission
2009-01-15 14:26 burgerm
* man/tracker.Rd: enclosed \item statements within \describe
environment: identified by new R 2.9.0 Rd parser
2009-01-15 14:23 burgerm
* man/runit.Rd: defineTestSuite default argument value: use \
escape to display \\ in resulting help page after parsing
2008-11-07 14:49 burgerm
* R/htmlProtocol.r: compiler detection failed on MacOS, fixed,
thanks to report by Steffen Neumann
2008-11-07 12:20 burgerm
* R/inspector.r: use seq_along
2008-11-07 12:19 burgerm
* R/checkFuncs.r: check for missing arguments
2008-11-07 12:15 burgerm
* DESCRIPTION: patch level 0.4.20
2008-06-20 17:51 burgerm
* R/textProtocol.r: printTextProtocol rewritten by Klaus using
toText; getErrors moved here, TODO replace with S4 method
2008-06-20 17:49 burgerm
* NAMESPACE: adopt S4 classes and methods; removed some outdated
functions
2008-06-20 17:36 burgerm
* R/runit.r: rewritten by Klaus, using S4 design and condition
mechanism
2008-06-20 17:29 burgerm
* R/00Init.r: added generics definition used for S4 methods
2008-06-20 17:27 burgerm
* R/testLogger.r: removed; will eventually be replaced
2008-06-20 17:26 burgerm
* R/: TestFileResult.r, TestFunctionResult.r, TestResult.r,
TestSuite.r, TestSuiteResult.r: S4 class based design of RUnit
2008-06-20 17:26 burgerm
* R/checkFuncs.r: rewritten by Klaus using conditions
2008-06-20 17:24 burgerm
* R/utility.r: utility functions not attributed to one class;
miscellaneous
2008-06-19 15:57 burgerm
* ChangeLog: updated
2008-06-19 13:49 burgerm
* tests/runitInspect.r: added 2nd example function
2008-06-19 13:46 burgerm
* man/textProtocol.Rd: details section updated; example on RUnit
test suite execution added in a dontrun clause: works only on
source package as tests/ folder is not copied to installed
package
2008-06-19 13:42 burgerm
* man/runit.Rd: runTestFile example call added
2008-06-19 10:07 burgerm
* DESCRIPTION: patch version 0.4.19
2008-06-18 19:18 burgerm
* R/textProtocol.r: details section: output check number per test
case
2008-06-18 19:17 burgerm
* R/htmlProtocol.r: details section: output check number per test
case; improved compiler detection
2008-06-18 19:16 burgerm
* R/runit.r: isValidTestSuite: changed check for object class to
is() to allow derived class objects to pass (suggested by
Philippe Grosjean); use addCheckNum to set number of checks
performed within test function
2008-06-18 19:13 burgerm
* R/testLogger.r: added addCheckNum, getCheckNum functions to allow
check number output in summary
2008-06-18 19:12 burgerm
* R/checkFuncs.r: checkEquals: argument checkNames checked for
correct type; not required paste calls around error message
removed (suggested by Philippe Grosjean)
2008-06-18 19:09 burgerm
* R/00Init.r: removed start up message
2008-04-29 10:06 burgerm
* inst/share/R/compareRUnitTestData.r: check for empty test case
results and exclude them from comparison; replaced seq with
seq_along
2007-11-30 15:13 burgerm
* tests/runitRUnit.r: error introduced in last commit corrected;
some more check conditions added
2007-11-30 14:57 burgerm
* R/htmlProtocol.r: fixed errors introduced in last commit:
replaced seq_len with seq_along
2007-11-27 20:07 burgerm
* ChangeLog: updated
2007-11-27 20:05 burgerm
* DESCRIPTION: patch level 0.4.18; R dependency set to 2.4.0 were
seq_along was introduced
2007-11-27 19:56 burgerm
* tests/runitRUnit.r: seq_along introduced; partial argument names
expanded
2007-11-27 19:55 burgerm
* R/runit.r: seq_along introduced
2007-11-27 19:53 burgerm
* R/exportHTML.r: seq_along introduced; partial argument names
expanded
2007-11-27 19:52 burgerm
* R/: html.r, htmlProtocol.r, testLogger.r, textProtocol.r:
seq_along introduced
2007-05-21 13:42 burgerm
* NEWS: updated for 0.4.17 CRAN submission
2007-05-21 13:37 burgerm
* DESCRIPTION: patch level 0.4.17
2007-05-21 13:33 burgerm
* man/: textProtocol.Rd, runit.Rd: changed example code to work
with installed package test case example path
2007-05-18 14:58 burgerm
* R/runit.r: try harder to ensure previous error handler is
reinstantiated after test runner execution
2007-05-18 14:56 burgerm
* DESCRIPTION: patch level 0.4.16
2007-05-18 14:55 burgerm
* NEWS: updated for 0.4.16
2007-05-16 15:17 burgerm
* DESCRIPTION: SaveImage replaced by LazyLoad
2007-05-16 14:27 burgerm
* inst/share/R/compareRUnitTestData.r: initial prototype: comare
two RUnitTestData objects: intended for test run time performance
evaluation
2007-05-16 14:24 burgerm
* R/runit.r: .sourceTestFile: updated to observe - after sandbox
introduction - test case file defined .setUp and .tearDown
functions
2007-05-16 14:21 burgerm
* tests/runitS4.r: check S4 setClass + removeClass chain with new
sandbox implementation
2007-05-16 14:19 burgerm
* tests/: runitSetUp.r, runitTearDown.r: added for focused check of
.setUp and .tearDown functioning
2007-05-16 14:16 burgerm
* tests/runitRUnit.r: class names changed; clean up operation
revised: try harder to reset to previous global state
2007-05-16 14:15 burgerm
* tests/runitInspect.r: .tearDown added: cleanup
2007-05-16 10:49 burgerm
* DESCRIPTION: dev patch level 0.4.15-2
2007-05-16 00:46 burgerm
* man/runit.Rd: added encoding latin1 to display umlaut correctly
if available; make use of describe command to format details
section
2007-05-16 00:42 burgerm
* man/checkFuncs.Rd: added encoding latin1 to display umlaut
correctly if available; added paragraph on S4 classes and methods
to details section
2007-05-15 23:46 burgerm
* man/inspect.Rd: added encoding latin1 to display umlaut correctly
if available
2007-05-15 23:45 burgerm
* man/textProtocol.Rd: added encoding latin1 to display umlaut
correctly if available; added header; added \pkg command around
RUnit phrase
2007-05-15 23:43 burgerm
* man/: RUnit-intro.Rd, tracker.Rd, printHTML.trackinfo.Rd: added
encoding latin1 to display umlaut correctly if available
2007-05-15 17:33 burgerm
* R/runit.r: make use of a new environment defined as child of
.GlobalEnv to allow setClass calls wo where argument
2007-04-25 08:46 burgerm
* R/TestCaseMethods.r: construct method added; verify method checks
partially switched off
2007-04-25 08:39 burgerm
* R/TestCaseTestResultData.r: slots checkNum, traceBack and
warnMessageStack added
2007-04-23 00:14 burgerm
* R/testLogger.r: replaced by condition signals
2007-04-23 00:10 burgerm
* R/TestCaseTestResultDataMethods.r: .printTextProtocol added: used
in recursive call chain
2007-04-23 00:08 burgerm
* R/: SourceFileTestResultDataMethods.r,
TestSuiteTestResultDataMethods.r: .printTextProtocol, getError
and getTestCaseNum added: used in recursive call chain
2007-04-23 00:05 burgerm
* R/runit.r: removed .testLogger; added warning handler; switched
to condition signals; use testCaseCheckCount for check call
counting
2007-04-23 00:03 burgerm
* R/checkFuncs.r: removed .testLogger
2007-04-23 00:00 burgerm
* DESCRIPTION: removed .testLogger; added experimental condition
signaling
2007-04-15 12:50 burgerm
* DESCRIPTION: patch level 0.6.0-2 exploration stage; NOT FIT FOR
PUBLIC USE
2007-04-15 12:48 burgerm
* NAMESPACE: new S4 classes and methods added
2007-04-15 12:47 burgerm
* R/runit.r: experimental: enabled new S4 class based result
collection IN PARALLEL to exiting logger mechanism for
exploration; NOT FIT FOR PUBLIC USE
2007-04-15 12:45 burgerm
* R/Logger.r: getSealed added to exported accessors
2007-04-15 12:40 burgerm
* R/checkFuncs.r: RUnit specific signals/conditions implemented and
enabled in check* functions
2007-04-15 12:38 burgerm
* R/zzz.r: log statement added; TestResultData method def enabled
2007-04-15 12:37 burgerm
* R/TestSuiteTestResultDataMethods.r: method implementation added,
accessor methods added
2007-04-15 12:36 burgerm
* R/TestSuiteTestResultData.r: slots error & errorMsg added to
cover suite level errors
2007-04-15 12:35 burgerm
* R/TestResultData.r: slot name changed
2007-04-15 12:34 burgerm
* R/TestCaseTestResultDataMethods.r: method implementation added,
accessor methods added
2007-04-15 12:33 burgerm
* R/TestCaseTestResultData.r: class definition reworked, slots
renamed and added: NOT FINAL DESIGN
2007-04-15 12:31 burgerm
* R/SourceFileTestResultDataMethods.r: method implementation added,
getTestResultData added
2007-04-15 12:29 burgerm
* R/SourceFileTestResultData.r: slot name renamed to
sourceFileName, slots error & errorMsg added to cover source file
level errors
2007-04-15 12:28 burgerm
* R/htmlProtocol.r: regexpr fixed for R 2.5.0
2007-04-12 10:29 burgerm
* R/inspector.r: unused variables removed
2007-04-09 19:42 burgerm
* tests/runitRUnit.r: all check* test cases reviewed and extended
to cover more failure conditions; checkEquals extended to be
checked for all basic R types and S4 objects
2007-04-09 19:38 burgerm
* R/testLogger.r: errorHandler: rewritten to be more failure
robust; docu added
2007-04-09 19:25 burgerm
* R/checkFuncs.r: checkEqualsNumeric: one more argument check added
(now identical to checkEquals; docu description made more clear
2007-04-08 14:14 burgerm
* R/runit.r: runTestSuite docu make more clear
2007-04-08 14:11 burgerm
* R/00Init.r: pass lib argument on to packageDescription to load
correct DESCRITPION file
2007-04-05 16:28 burgerm
* R/htmlProtocol.r: included deactivatedStyle tag to HTML output:
non-visible change
2007-04-02 00:08 burgerm
* R/zzz.r: class and method init calls added/updated
2007-04-02 00:04 burgerm
* R/00Init.r: packageDescription now observes the library path for
the currently loaded package version
2007-04-02 00:02 burgerm
* R/TestCaseTestResultData.r: sealed argument controlled by .GLOBAL
state; slot failed renamed to failure
2007-04-01 23:59 burgerm
* R/: TestResultData.r, SourceFileTestResultData.r,
TestSuiteTestResultData.r: sealed argument controlled by .GLOBAL
state
2007-04-01 23:53 burgerm
* R/: TestCase.r, TestCaseMethods.r, TestLogger.r,
TestLoggerMethods.r: playground extended
2007-04-01 23:51 burgerm
* R/ArrayMethods.r: - code formating changes ArrayMethods.r
- setNames: unnecessary precondition check removed
- concat: precondition check added
method definition also added to Array base class
- printObject rewritten to use show
- show method added
- array class constructor: sealed argument controlled by .GLOBAL
state
- applyFun method definition added to array class generator
2007-04-01 23:43 burgerm
* R/Array.r: allow sealed argument to be controlled by .GLOBAL
state
2007-04-01 23:42 burgerm
* R/classUtilities.r: in setGeneric avoid assigning to temp
variable value as no postprocessing is intended here and this
assignment has a small memory penalty as shown by memprof
2007-04-01 23:38 burgerm
* DESCRIPTION: patch level 0.6.0-1: more exploratory code chunks
added
2007-03-31 23:15 burgerm
* inst/examples/runitVirtualClassTest.r: S4 class example
2007-03-29 09:26 burgerm
* inst/share/R/checkCode.r: utility wrappers around checkUsage
(package codetools) to check no default location code files;
experimental
2007-03-23 15:18 burgerm
* tests/runitPlotConnection.r: deactivate test case if R is run in
non-interactive mode i.e. most likely no X server is present but
require by the png device
2007-03-19 21:08 burgerm
* tests/runitPlotConnection.r: simple run test
2007-03-19 01:54 burgerm
* R/htmlProtocol.r: fixed gcc query under Windows: report NA
2007-03-19 01:52 burgerm
* NEWS: printHTMLProtocol fixed (Windows)
2007-03-19 00:55 burgerm
* man/runit.Rd: added header
2007-03-19 00:54 burgerm
* tests/runitRUnit.r: added exception check for call object: R
2.5.0 devel issue with new try implementation
2007-03-19 00:51 burgerm
* tests/: runitTextProtocol.r, runitHTMLProtocol.r: added check for
successful execution, taking care of nested test suite calls
2007-03-19 00:49 burgerm
* inst/examples/correctTestCase.r: R 1.9.0 compatibility: replace
isTRUE by identical
2007-03-19 00:45 burgerm
* R/inspector.r: docu updated/extended; tracker closure functions
revised: internal object now is always of S3 class trackInfo,
renamed to trackInfo for clarity, addFunc simplified, reinit of
oldTime was not written to closure variable; several
precondition checks added
2007-03-19 00:40 burgerm
* R/exportHTML.r: functions now return invisible; HTML head info
updated; result page file names changed; HTML footer added
2007-03-19 00:36 burgerm
* man/printHTML.trackinfo.Rd: header added; details text
description corrected
2007-03-19 00:34 burgerm
* man/tracker.Rd: header added; moved closure functions to new
section to avoid R CMD check warning; added isValid
2007-03-16 12:25 burgerm
* NEWS: updated for 0.4.15
2007-03-16 12:22 burgerm
* DESCRIPTION: patch level 0.4.15
2007-03-16 12:08 burgerm
* R/checkFuncs.r: compatibility to R 1.9.0 as declared in
DESCRIPTION: removed calls to isTRUE as this was introduced only
in R 2.1.0, replaced where needed by identical(TRUE, x)
2007-03-16 12:07 burgerm
* R/htmlProtocol.r: createTestFuncRef: removed unnecessary escape
characters in gsub call
2007-03-16 12:05 burgerm
* tests/runitRUnit.r: compatibility to R 1.9.0 as declared in
DESCRIPTION: removed calls to isTRUE as this was introduced only
in R 2.1.0, replaced where needed by identical(TRUE, x)
2006-08-30 01:13 burgerm
* DESCRIPTION: patch level 0.6.0-0: start new minor level 0.6.0.x
for development, first public release will be 0.6.0; 0.5.x is
reserved for potential S3 implementation updates; class layout as
described in dia
2006-08-30 01:11 burgerm
* NAMESPACE: initial commit: class layout as described in dia
2006-08-30 00:58 burgerm
* R/TestSuiteTestResultDataMethods.r: initial commit: class layout
as described in dia
2006-08-30 00:54 burgerm
* R/: ArrayMethods.r, Logger.r, SignalHandler.r,
SourceFileTestResultDataMethods.r,
TestCaseTestResultDataMethods.r, TestSuiteMethods.r,
classUtilities.r, zzz.r: initial commit: class layout as
described in dia
2006-08-30 00:51 burgerm
* R/: Array.r, SourceFileTestResultData.r,
TestCaseTestResultData.r, TestResultData.r, TestSuite.r,
TestSuiteTestResultData.r: initial commit: class layout as
described in dia
2006-08-22 11:21 burgerm
* NEWS: 0.4.14 update log added
2006-08-17 09:12 burgerm
* DESCRIPTION: patch level 0.4.14: package utils dependency made
explicit in DESCRIPTION and NAMESPACE
2006-08-17 01:14 burgerm
* NAMESPACE: import of package utils added (required for R 2.4.0)
2006-08-16 17:39 burgerm
* inst/doc/RUnit.Rnw: added a note on the new arguments rngKind,
and rngNormalKind; replaced path construction via paste by the
more protable file.path (Gregor Gorjanc)
2006-08-16 17:36 burgerm
* inst/doc/RUnit.pdf: updated
2006-08-15 18:52 burgerm
* ChangeLog: updated
2006-08-15 18:51 burgerm
* R/textProtocol.r: return type enforced (a bit more) to be logical
2006-08-15 18:50 burgerm
* R/runit.r: defineTestSuite, runTestFile: added arguments rngKind,
rngNormalKind to allow configuartion of default RNG
configuration, docu tag updated
2006-08-15 18:48 burgerm
* R/testLogger.r: documentaion tags added
2006-08-15 18:47 burgerm
* R/htmlProtocol.r: return type enforced (a bit more) to be
logical, documentation updated
2006-08-15 18:41 burgerm
* R/textProtocol.r: documentation updated; printTextProtocol return
type changed to logical
2006-08-15 18:34 burgerm
* R/html.r: documentation tags updated
2006-08-15 18:33 burgerm
* R/exportHTML.r: file I/O: replaced paste call by more protable
file.path
2006-08-15 18:31 burgerm
* tests/runitRUnit.r: defineTestSuite test case added
2006-08-15 18:29 burgerm
* man/runit.Rd: runTestFile, defineTestSuite: documented new
arguments rngKind, rngNormalKind
2006-08-15 18:27 burgerm
* NEWS: updated: added recent releases
2006-08-15 18:26 burgerm
* DESCRIPTION: patch level: 0.4.12
2006-08-08 00:58 burger
* R/runit.r: defineTestSuite - allow file extension .R
2006-08-08 00:57 burger
* DESCRIPTION: patch level 0.4.12 - allow file extension .R
(runit.r)
2006-07-17 19:27 burger
* R/00Init.r: package version added to startup message
2006-05-22 10:33 burger
* R/checkFuncs.r: DEACTIVATED - fixed typo in var name
2006-04-05 13:47 burger
* R/checkFuncs.r: checkException: added comment on contributing
author
2006-04-04 19:25 burger
* R/TestResultClass.r: License header text added
2006-04-04 19:25 burger
* R/TestLogger.r: initial commit
2006-04-04 19:24 burger
* R/: TestResultMethods.r, TestSuiteResult.r,
TestSuiteResultMethods.r: Lincence header text added
2006-04-04 17:38 burger
* NEWS, inst/doc/RUnit.pdf: updated
2006-04-04 17:08 burger
* man/inspect.Rd: updated inspect call and argument documentation
2006-04-04 17:08 burger
* man/printHTML.trackinfo.Rd: updated inspect call
2006-04-04 17:07 burger
* man/tracker.Rd: updated inspect calls
2006-04-04 17:07 burger
* inst/doc/RUnit.Rnw: updated inspect calls, added some line to
recomendations
2006-04-03 18:35 burger
* tests/runitRUnit.r: checkException: silent added to checks
2006-04-03 18:34 burger
* R/checkFuncs.r: checkException: argument silent added
2006-04-03 18:32 burger
* man/checkFuncs.Rd: checkException, checkEquals documentation
updated
2006-04-03 18:31 burger
* DESCRIPTION: patch level 0.4.11: checkException arg added
2006-04-03 14:40 burger
* inst/examples/runitfoo.r: example function
2006-03-21 15:47 burger
* tests/runitRUnit.r: unsuccessful attempt to extend runTestSuite
test case
2006-03-21 15:37 burger
* R/runit.r: isValidTestSuite: error message texts added
2006-03-21 15:34 burger
* R/inspector.r: inspect, and includeTracker have new argument
track, which defaults to track for consitency; API docu enhanced
and extended
2006-03-21 15:32 burger
* tests/runitInspect.r: reactivated both test cases after changes
to inspect, and includeTracker
2006-03-21 15:31 burger
* DESCRIPTION: patch level 0.4.10
2006-03-07 20:41 burger
* R/checkFuncs.r: checkEquals: new compatibility argument to allow
to workaround stricter all.equal checks; tolerance precondtion
added
2006-03-07 20:39 burger
* DESCRIPTION: patch level 0.4.9: checkEquals has new compatibility
argument
2006-01-20 18:25 burger
* tests/runitRUnit.r: checkIdentical added; checkEquals test case
extended
2006-01-20 18:24 burger
* man/checkFuncs.Rd: checkIdentical added; arguments a,b, renamed
consitent with all.equal
2006-01-20 18:23 burger
* R/checkFuncs.r: checkIdentical added; msg argument default added;
msg added to stop calls; arguments a,b, renamed consitent with
all.equal
2006-01-20 18:21 burger
* NAMESPACE: checkIdentical added
2006-01-20 18:18 burger
* DESCRIPTION: patch version 0.4.8: checkIdentical added
2006-01-05 15:09 burger
* R/checkFuncs.r: checkEqualsNumeric: update to be compatible with
R 2.3.0
2006-01-05 15:08 burger
* DESCRIPTION: patch level 0.4.7: update for checkEqualsNumeric to
be compattible with R 2.3.0
2005-12-12 10:35 burger
* DESCRIPTION: patch level 0.4.6
2005-12-12 10:32 burger
* R/htmlProtocol.r: replaced HOST query by supposedly platform
independent Sys.info variant
2005-12-05 14:44 burger
* R/htmlProtocol.r: system info table format changed
2005-12-05 14:44 burger
* R/html.r: writeHtmlTable added; API tags updated
2005-11-21 15:29 burger
* DESCRIPTION: patch level 0.5.0 added - temporary - dependency on
EpiR.base (arrayTemplate class)
2005-11-21 15:28 burger
* R/zzz.r: class & method init currently required arrayTemplate and
thus relies on EpiR.base FIXME: remove dependency on EpiR.base
once design has matured
2005-11-21 15:28 burgerm
* R/zzz.r: file zzz.r was added on branch S4-devel-branch-2006-08
on 2006-08-29 22:54:46 +0000
2005-11-21 15:26 burger
* R/Logger.r: first exploration
2005-11-21 15:26 burgerm
* R/Logger.r: file Logger.r was added on branch
S4-devel-branch-2006-08 on 2006-08-29 22:54:46 +0000
2005-11-21 15:15 burger
* R/textProtocol.r: added execTime S3 method
2005-11-21 15:15 burger
* R/: TestFileResult.r, TestFunctionResult.r, TestResultMethods.r,
TestSuiteResult.r, TestFileResultMethods.r,
TestSuiteResultMethods.r: first prototype
2005-11-21 15:13 burger
* R/TestResultClass.r: first prototype: virtual base class: the
mother of all test results
2005-11-14 13:40 burger
* DESCRIPTION: patch level 0.4.5 improvements to error detection in
runTestSuite & new test cases
2005-11-14 13:39 burger
* tests/runitRUnit.r: added isValidTestSuite, runTestFile, and
runTestSuite test cases added test case description
2005-11-14 13:37 burger
* R/runit.r: runTestSuite: added preconditions runTestFile: pass on
error handler flag
2005-11-14 13:36 burger
* inst/examples/correctTestCase.r: used for unit test cases
2005-11-14 11:37 burger
* R/runit.r: added codestatus API tag runTestSuite: modified error
msg
2005-11-14 11:36 burger
* R/checkFuncs.r: added codestatus API tag, set to testing
2005-10-27 10:44 burger
* .cvsignore: initial commit ignaore eclipse project file
2005-09-29 14:19 burger
* DESCRIPTION: changed Klaus email address
2005-09-29 14:16 burger
* inst/doc/Makefile: initial commit: utility
2005-08-30 16:28 burger
* DESCRIPTION: patch level 0.4.4: changed maintainer
2005-04-07 16:17 burger
* tests/runitInspect.r: added & deactivated 2 test cases:
environment issues to be addressed by Thomas
2005-04-07 16:04 burger
* tests/runitRUnit.r: DEACTIVATED test added
2005-04-07 16:03 burger
* R/inspector.r: includeTracker: modifed regexp in grep to comply
to R 2.1.0; removed semi-colons; added docu tags
2005-04-07 16:02 burger
* R/checkFuncs.r: checkTrue: argument renmaed to match docu: R
2.1.0 CMD check issue
2005-04-07 16:00 burger
* R/runit.r: isValidTestSuite: added check on folder existance;
docu tags added
2005-04-07 15:59 burger
* R/testLogger.r: setDeactivated: added handling of msg with string
length > 1; docu extended
2005-04-07 15:41 burger
* DESCRIPTION: patch level 0.4.2: fixed R 2.1.0 inspect regexp
problem
2005-02-02 13:38 kjuen
* R/: htmlProtocol.r, textProtocol.r: the protocol now doesn't
mention test files that do not contain any test functions
2005-01-17 19:03 kjuen
* R/htmlProtocol.r: minor formatting modifications
2004-12-13 15:34 burger
* R/checkFuncs.r: checkTrue: had to add explicit eval to ensure the
argument gets evaluated before attempting to set the names
attribute to NULL
2004-12-13 14:58 burger
* man/checkFuncs.Rd: updated help text for checkTrue
2004-12-13 14:49 burger
* R/checkFuncs.r, tests/runitRUnit.r: checkTrue: extended: correct
handling of named logical arguments
2004-12-13 14:48 burger
* DESCRIPTION: patch level 0.4.2: corrected deficient checkTrue
2004-11-29 19:53 burger
* DESCRIPTION: patch level: 0.4.1: http URL mapped
2004-11-29 18:12 kjuen
* R/htmlProtocol.r, man/textProtocol.Rd: 'testFileToLinkMap'
parameter added to the printHTMLProtocol function added
2004-09-30 15:19 kjuen
* inst/doc/: RUnit.Rnw, RUnit.pdf: typos fixed
2004-09-29 18:53 burger
* DESCRIPTION: added methods dependency, again
2004-09-29 14:18 kjuen
* DESCRIPTION: changes for new release
2004-09-29 14:17 kjuen
* inst/doc/RUnit.pdf: hopefully readable for everybody
2004-09-28 11:11 kjuen
* R/htmlProtocol.r: deactivated table cells are now printed yellow
2004-09-22 15:27 burger
* DESCRIPTION: patch level 0.3.8: RC 0.4.0; removed package splines
dependency; added SaveImage directive
2004-09-22 15:24 burger
* NAMESPACE: removed splines import
2004-09-22 15:23 burger
* R/00Init.r: added .onLoad hook for loading methods prior to RUnit
attachment: recommended for R 2.0.0
2004-09-22 15:23 burger
* R/inspector.r: removed library calls for methods & splines; added
00Init.r file for this
2004-09-22 15:22 burger
* NEWS: replaced tabs; corrected typo, added splines dependency
removal
2004-09-22 14:40 kjuen
* NEWS: news for release 0.4.0
2004-09-15 15:07 kjuen
* NAMESPACE: DEACTIVATED added
2004-09-15 15:07 kjuen
* man/: RUnit-internal.Rd, RUnit-intro.Rd, checkFuncs.Rd,
inspect.Rd, printHTML.trackinfo.Rd, runit.Rd, textProtocol.Rd,
tracker.Rd: some very small cleanups to avoid warnings with R-2
2004-09-09 12:21 kjuen
* R/: htmlProtocol.r, testLogger.r, textProtocol.r: .getErrors
completely removed
2004-09-08 18:05 burger
* DESCRIPTION: updated patch level to 0.3.7
2004-09-08 18:03 burger
* NAMESPACE: added getErrors to namespace exports
2004-09-08 18:02 burger
* R/testLogger.r: copied .getErrors to getErrors, added to
namespace exports, .getErrors set deprecated
2004-09-08 14:20 kjuen
* R/htmlProtocol.r: deactivated column in testsuite table is
included only when there are any deactivated test functions
2004-09-07 17:28 kjuen
* R/: checkFuncs.r, htmlProtocol.r, runit.r, testLogger.r,
textProtocol.r: several small cleanups, DEACTIVATED function
added
2004-09-06 15:32 burger
* inst/NAMESPACE: removed, moved to from inst/ folder
2004-09-06 15:32 burger
* NAMESPACE: moved here from inst/ folder as promoted by R 2.0.0
docu
2004-09-06 15:21 burger
* R/runit.r: .executeTestCase: added log output: test function call
2004-09-06 15:13 burger
* R/textProtocol.r: added braces
2004-08-05 13:34 burger
* R/htmlProtocol.r: added braces; added col.names=FALSE to
write.table for printing out R version info
2004-07-13 18:16 burger
* inst/doc/RUnit.pdf: created via R 1.9.1 buildVignettes("RUnit",
"~/src/R/Runit", quiet=FALSE) call, package tools
2004-07-13 16:07 burger
* inst/doc/: RUnit.Rnw, RUnit.pdf: set VignetteDepends; commented
out LaTeX dependencies; added bibliography with URL for SF RUnit
site
2004-07-13 16:04 burger
* DESCRIPTION: added SF URL; fixed vignette PDF problem; updated
patch level to 0.3.6
2004-06-29 17:17 burger
* R/htmlProtocol.r: added colnames(ver) <- "" to avoid warning in R
>= 1.9.0
2004-06-10 11:01 burger
* R/htmlProtocol.r: added writeCR to writeP function: creates
better structured HTML code, relevant also for the internal built
script
2004-06-09 20:40 burger
* R/html.r: corrected writeEndHead & writeEndHtml: both wrote start
instead of end tags
2004-06-08 11:01 burger
* DESCRIPTION: updated patch level to 0.3.4, corrected R CMD check
warning on man page files
2004-06-08 09:27 burger
* man/: RUnit-intro.Rd, RUnit.Rd: renamed RUnit.Rd to
RUnit-intro.Rd
2004-06-08 09:24 burger
* man/: RUnit.Rd, checkFuncs.Rd, inspect.Rd,
printHTML.trackinfo.Rd, runit.Rd, textProtocol.Rd, tracker.Rd:
replaced keyword{RUnit} by concept{RUnit}, suggested by Kurt
Hornik
2004-06-07 11:41 koenig
* inst/doc/RUnit.Rnw: some formatting changes and better
descriptions
2004-06-04 22:44 burger
* man/checkFuncs.Rd: renamed f to fun
2004-06-04 22:44 burger
* DESCRIPTION: updated patch level to 0.3.3, fixed last failing R
CMD check tests: ready for CRAN submission
2004-06-04 22:33 burger
* man/tracker.Rd: only example text format changed
2004-06-04 22:32 burger
* man/printHTML.trackinfo.Rd: updated to new argument name
2004-06-04 22:31 burger
* R/exportHTML.r: fixed error introduced with the check on the
successful directory creation: renamed res input argument to
trackInfo
2004-06-04 20:16 burger
* R/htmlProtocol.r: added R version output at end of HTML page
2004-06-03 17:41 burger
* R/exportHTML.r: added preconditions and handling of the case the
directory results exists already
2004-06-03 17:40 burger
* man/tracker.Rd: modified useage to be consistent with required
default name for tracker object
2004-06-03 17:32 burger
* man/inspect.Rd: added seealso section
2004-06-03 17:32 burger
* man/tracker.Rd: added sealso section, clarified comments, added
one sentence to description
2004-06-03 16:54 burger
* R/inspector.r: added methods dependency
2004-06-03 16:50 burger
* man/RUnit-internal.Rd: added writeBeginHtml & writeEndHtml
2004-06-03 16:37 burger
* INDEX: initial commit
2004-06-03 16:35 burger
* inst/doc/00Index.dcf: updated
2004-06-03 16:05 kjuen
* inst/examples/runitc2f.r: example extended
2004-06-03 16:05 kjuen
* man/runit.Rd: small improvements
2004-06-03 15:30 kjuen
* man/runit.Rd: random number generator behaviour documented
2004-06-03 15:15 kjuen
* inst/doc/RUnit.Rnw: junk character that made texi2dvi fail
removed
2004-06-03 15:13 kjuen
* man/: runit.Rd, textProtocol.Rd: print and summary documentation
improved
2004-06-03 13:59 burger
* tests/runitRUnit.r: added test cases
2004-06-03 13:47 burger
* tests/: runitHTMLProtocol.r, runitTextProtocol.r: initial commit,
simple test cases, currently only checked if all input arguments
are checked correctly
2004-06-02 18:53 burger
* R/: htmlProtocol.r, textProtocol.r: added precondition checks
2004-06-02 18:51 burger
* DESCRIPTION: updated patch level to 0.3.2: updated Seawve file,
added preconditon checks
2004-06-02 18:40 burger
* inst/doc/RUnit.Rnw: corrected errors in R code which incurred R
CMD check error
2004-06-01 18:11 burger
* inst/examples/runitc2f.r: initial commit, simple example test
case, required for correct automatic Sweave translation
2004-05-27 11:37 koenig
* R/runit.r: random generator set to kind=Marsaglia-Multicarry,
normal.kind=Kinderman-Ramage (default before R-1.8.1
2004-05-25 11:07 kjuen
* inst/NAMESPACE: exports of generic print and summary functions
corrected
2004-05-25 11:07 kjuen
* R/textProtocol.r: type fixed in summary function
2004-05-25 11:06 kjuen
* R/runit.r: code that attempts to clean up the global environment
after the test runs removed, because it did not work with R-1.9
(because of some namespace stuff that I do not understand)
2004-05-25 11:04 kjuen
* R/htmlProtocol.r: junk code removed
2004-05-19 21:08 burger
* DESCRIPTION: updated patch level to 0.3.1, version presented at
useR
2004-05-19 14:42 koenig
* inst/doc/RUnit.Rnw: E-Mail adresses changed
2004-05-19 14:39 koenig
* inst/doc/RUnit.Rnw: company name and E-Mail added
2004-05-19 14:12 kjuen
* inst/doc/RUnit.Rnw: some details improved and section that
explains test case execution added
2004-05-19 12:48 kjuen
* R/testLogger.r: debug print statement removed
2004-05-19 11:26 burger
* inst/doc/RUnit.Rnw: added library(RUnit) before example code
2004-05-19 11:24 burger
* man/RUnit-internal.Rd: added newline
2004-05-19 11:24 burger
* R/exportHTML.r: added API doc tags, code polish for better
readability
2004-05-19 11:12 burger
* man/RUnit.Rd: updated, added links, removed unused tags
2004-05-19 11:09 burger
* man/: tracker.Rd, printHTML.trackinfo.Rd: added CVS header
2004-05-19 11:08 burger
* man/: tracker.Rd, inspect.Rd: minor text changes
2004-05-19 11:07 burger
* man/printHTML.trackinfo.Rd: fixed spelling of function name
2004-05-19 11:04 burger
* man/RUnit-internal.Rd: initial commit, list all private functions
not covered in the docs
2004-05-19 09:46 koenig
* man/: inspect.Rd, printHTML.trackinfo.Rd, tracker.Rd: initial
release for the documentation of the inspector
2004-05-18 23:17 burger
* inst/doc/RUnit.pdf: updated
2004-05-18 23:17 burger
* inst/doc/RUnit.Rnw: corrected missing end closure
2004-05-18 21:46 burger
* man/: runit.Rd, textProtocol.Rd: typo corrections
2004-05-18 21:45 burger
* inst/doc/RUnit.Rnw: removed duplicate abstract, typo corrections
2004-05-18 19:58 burger
* inst/NAMESPACE: removed Copyright notice, removed class &method
export directive
2004-05-18 19:49 burger
* man/: RUnit.Rd, checkFuncs.Rd, runit.Rd: added newline in lats
line: suggested by R CMD check
2004-05-18 19:47 burger
* DESCRIPTION: removed 2nd maintainer entry: not allowed by R CMD
check
2004-05-18 19:02 burger
* DESCRIPTION: added splines dependency, added poster, added more
Rd files
2004-05-18 16:58 burger
* inst/doc/RUnit.Rnw: added some lines to Motivation, added Future
Ideas
2004-05-18 16:34 koenig
* inst/doc/RUnit.Rnw: enhanced for the code inspector
2004-05-18 13:24 kjuen
* R/runit.r: sanity check of looking for a 'runit' call in a test
function removed because it is not necessary anymore
2004-05-18 13:22 kjuen
* R/testLogger.r: a dot prepended to getError and newTestLogger to
mark them as internal functions
2004-05-18 13:21 kjuen
* R/runit.r: bugfix in .executeTestCase: setUp and tearDown are now
checked for errors. typo fixed in the code that copes with errors
occuring while sourcing a test file
2004-05-18 13:18 kjuen
* R/: htmlProtocol.r, textProtocol.r: trace back writing improved
2004-05-18 13:16 kjuen
* man/textProtocol.Rd: documentation of printHTMLProtocol added
2004-05-18 13:15 kjuen
* inst/doc/RUnit.Rnw: my version of the introduction added
2004-05-17 19:54 burger
* inst/doc/RUnit.Rnw: added abstract
2004-05-17 19:53 burger
* inst/doc/RUnit.pdf: initial commit
2004-05-17 15:40 kjuen
* R/htmlProtocol.r: some minor modifications
2004-05-17 15:40 kjuen
* R/runit.r: default test file regexp in defineTestSuite improved
2004-05-17 15:16 burger
* R/: exportHTML.r, html.r, inspector.r: added GPL preamble
2004-05-14 18:38 kjuen
* R/textProtocol.r: useless code deleted
2004-05-14 18:38 kjuen
* R/runit.r: small bugfix in isValidTestSuite
2004-05-14 18:37 kjuen
* R/htmlProtocol.r: first usable version
2004-05-14 18:29 kjuen
* R/html.r: small improvement of writeBeginTable
2004-05-11 15:34 koenig
* R/exportHTML.r: moved html helper function to html.r
2004-05-11 15:33 koenig
* R/html.r: initial release. helper function for generating html
pages
2004-05-10 23:09 burger
* R/: checkFuncs.r, runit.r, testLogger.r, textProtocol.r: added
CVS tag
2004-05-10 22:58 burger
* R/runit.r: renamed argument to isValid to testSuite; ts is a time
series object
2004-05-10 22:57 burger
* R/textProtocol.r: added API documentation tags; renamed arguments
to required defaults for print & summary methods
2004-05-10 22:56 burger
* man/runit.Rd: added authors and keyword paragraphs; changed ts to
testSuite argument name and documented it
2004-05-10 22:54 burger
* man/textProtocol.Rd: added authors and keyword paragraphs; added
... argument description
2004-05-10 22:52 burger
* man/checkFuncs.Rd: added authors and keyword paragraphs
2004-05-10 22:22 burger
* inst/doc/RUnit.Rnw: fixed broken LaTeX code: missing begin
environment
2004-05-10 22:21 burger
* inst/doc/00Index.dcf: initial commit, required by R CMD check;
needs to be updated with this directories contents
2004-05-10 22:07 burger
* DESCRIPTION: updated to minor level 0.2.0: CodeInspector code
added, documentation pages added; package passes R CMD check
2004-05-10 22:05 burger
* man/: checkFuncs.Rd, runit.Rd, textProtocol.Rd: changed examples
such that no Errors are thrown, and packages passes R CMD check
2004-05-10 18:51 kjuen
* R/: 00Init.r, initGeneratedRUnit.r, utilities.r: removed
2004-05-10 18:49 koenig
* R/inspector.r: initial release for tracking tool
2004-05-10 18:48 koenig
* R/exportHTML.r: initial release for exporting results to HTML
pages
2004-05-10 16:52 kjuen
* man/: checkFuncs.Rd, runit.Rd, textProtocol.Rd: first attempt to
cope with Rs documentation tool
2004-05-10 16:51 kjuen
* R/runit.r: test suite objects now have a class attribute
2004-05-10 16:50 kjuen
* R/testProtocol.r: renamed to textProtocol
2004-05-10 16:50 kjuen
* R/textProtocol.r: renamed from testProtocol
2004-05-07 17:51 kjuen
* R/checkFuncs.r: ... added to checkEquals so that further args can
be passed to all.equal
2004-05-07 15:45 kjuen
* R/testProtocol.r: S3 generic methods 'print' and 'summary' added
2004-05-07 15:44 kjuen
* R/testLogger.r: getErrors improved
2004-05-06 20:46 burger
* DESCRIPTION: added GPL 2 licence text, some code improvements
2004-05-06 20:43 burger
* COPYING: GPL 2, downloaded from
http://www.gnu.org/copyleft/gpl.html
2004-05-06 19:39 kjuen
* R/testProtocol.r: license header added, optional args added to
configure printTextProtocol
2004-05-06 19:38 kjuen
* R/testLogger.r: license header added, traceback removed for
Failures
2004-05-06 19:37 kjuen
* R/runit.r: license header added, file regexp in runTestFile
improved
2004-05-06 19:37 kjuen
* R/checkFuncs.r: license header added
2004-05-05 21:35 burger
* R/runit.r: changed to default set in R >= 1.8.0
2004-05-05 20:08 burger
* DESCRIPTION: updated version to 0.1.0, runit test framework from
EpiR.tools revised and commited here
2004-05-05 19:30 kjuen
* R/: checkFuncs.r, runit.r, testLogger.r, testProtocol.r: initial
check in of rewritten version
2004-04-06 11:27 burger
* DESCRIPTION, R/00Init.r, R/initGeneratedRUnit.r, R/utilities.r,
inst/NAMESPACE, inst/doc/RUnit.Rnw, man/RUnit.Rd,
tests/runitRUnit.r: Initial revision
2004-04-06 11:27 burger
* DESCRIPTION, R/00Init.r, R/initGeneratedRUnit.r, R/utilities.r,
inst/NAMESPACE, inst/doc/RUnit.Rnw, man/RUnit.Rd,
tests/runitRUnit.r: initial import: preparation for public CRAN
package, will take on most of EpiR.tools functionality
RUnit/NAMESPACE 0000644 0001751 0000144 00000002026 14565677274 012577 0 ustar hornik users ######################################################################
##
## RUnit
## =====================================
##
## inst/NAMESPACE
## =====================================
## initialization of classes, namespace, ...
##
##
##
##
## Version
## =====================================
## $Id$
##
##
######################################################################
import(utils)
import(methods)
importFrom("graphics", "arrows", "legend", "lines", "plot", "text")
export(".setUp",
".tearDown",
"checkTrue",
"checkEquals",
"checkEqualsNumeric",
"checkException",
"checkIdentical",
"DEACTIVATED",
"defineTestSuite",
"getErrors",
"inspect",
"isValidTestSuite",
"printTextProtocol",
"printHTMLProtocol",
"printJUnitProtocol",
"printHTML",
"runTestSuite",
"runTestFile",
"tracker")
S3method(print, RUnitTestData)
S3method(summary, RUnitTestData)
S3method(printHTML, trackInfo)
S3method(printHTML, default)
RUnit/inst/ 0000755 0001751 0000144 00000000000 13267374743 012326 5 ustar hornik users RUnit/inst/examples/ 0000755 0001751 0000144 00000000000 13267374743 014144 5 ustar hornik users RUnit/inst/examples/runitVirtualClassTest.r 0000644 0001751 0000144 00000010013 13267374743 020660 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
## example code for test cases for S4 virtual class methods
## the following class definition code would be part of a package or script
##
## execute these test cases via e.g.
## testSuite <- defineTestSuite("VirtualClassTest",
## file.path(yourSrcPath, "RUnit/inst/examples"),
## "runitVirtual")
## testData <- runTestSuite(testSuite)
## printTextProtocol(testData)
## package 'methods' is usually loaded, but make sure it is
checkTrue(require(methods))
## define class
className <- "MyVirtualBaseClass"
setClass(className,
representation("VIRTUAL",
x = "numeric",
y = "numeric",
description = "character"),
validity = NULL,
sealed = FALSE,
where = .GlobalEnv)
if (!isGeneric("getX")) {
setGeneric("getX", function(object, ...) standardGeneric("getX"),
useAsDefault=TRUE, where=.GlobalEnv, valueClass="numeric")
}
setMethod("getX", signature=className, function(object) return(object@x),
where=.GlobalEnv)
if (!isGeneric("setX<-")) {
setGeneric("setX<-", function(object, value) standardGeneric("setX<-"),
useAsDefault=TRUE, where=.GlobalEnv)
}
setMethod("setX<-", signature=signature(object=className, value="numeric"),
function(object, value) {
if (length(value) < 1) {
stop("value has to contain at least one element.")
}
if (any(is.na(value))) {
stop("value may not contain NA(s).")
}
object@x <- value
return(object)
}, where=.GlobalEnv)
testMyVirtualBaseClass.getX <- function() {
##@bdescr
## create a derived class with no own method definitions
## which inherits parent class methods that can then be checked
##
## getter test case
##@edescr
testClassName <- "MyDerivedTestClass"
setClass(testClassName,
representation("MyVirtualBaseClass"),
validity = NULL,
sealed = FALSE,
where = .GlobalEnv)
on.exit(removeClass(testClassName, where=.GlobalEnv))
## system constructor
this <- new(testClassName)
## constructor call succeeded?
checkTrue( is(this, testClassName))
ret <- getX(this)
checkTrue( is(ret, "numeric"))
## class default
checkEquals( ret, numeric(0))
}
testMyVirtualBaseClass.setX <- function() {
##@bdescr
## setter test case
## also check correct handling of invalid arguments
##@edescr
testClassName <- "MyDerivedTestClass"
setClass(testClassName,
representation("MyVirtualBaseClass"),
validity = NULL,
sealed = FALSE,
where = .GlobalEnv)
on.exit(removeClass(testClassName, where=.GlobalEnv))
## system constructor
this <- new(testClassName)
## constructor call succeeded?
checkTrue( is(this, testClassName))
testSeq <- 1:23
setX(this) <- testSeq
ret <- getX(this)
checkTrue( is(ret, "numeric"))
checkEquals( ret, testSeq)
## error handling
checkException( setX(this) <- numeric(0))
checkException( setX(this) <- as.numeric(NA))
checkException( setX(this) <- c(1:4, NA))
}
RUnit/inst/examples/runitc2f.r 0000644 0001751 0000144 00000003135 13267374743 016065 0 ustar hornik users ## This is a very trivial demo of
## the RUnit test case execution system:
## ---------------------------------
## functions to be tested (usually defined in a different
## file from where the test cases are located):
## centigrade to Fahrenheit
c2f <- function(c) return(9/5 * c + 32)
## Fahrenheit to centigrade
f2c <- function(f) return(5/9 * f - 32) ## ups, a bug (brackets missing)
## test functions:
## ---------------------
.setUp <- function() { ## called before each test case, see also .tearDown()
print(".setUp")
}
test.c2f <- function() {
checkEquals(c2f(0), 32)
checkEquals(c2f(10), 50)
## check that an error is created for a bogus argument
checkException(c2f("xx"))
}
test.f2c <- function() {
checkEquals(f2c(32), 0)
checkEquals(f2c(50), 10)
## check that an error is created for a bogus argument
checkException(f2c("xx"))
}
test.errordemo <- function() {
stop("this is just to show what an error looks like as opposed to a failure")
}
## How to run the tests (do not uncomment in this file,
## but execute the commands at the R prompt):
## All you have to do is to adapt the directory locations.
## ------------------------------------------------
## define the test suite:
#testsuite.cf <- defineTestSuite("cfConversion", dirs="directoryOfThisFile")
## run test suite:
#testResult <- runTestSuite(testsuite.cf)
## print text protocol to console:
#printTextProtocol(testResult)
## print HTML version to a file:
#printHTMLProtocol(testResult, fileName="someFileName.html")
## In this case we also have a shortcut
#runTestFile("directoryOfThisFile/runitcfConversion.r")
RUnit/inst/examples/correctTestCase.r 0000644 0001751 0000144 00000001637 13267374743 017433 0 ustar hornik users ## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
test.correctTestCase <- function() {
checkTrue( TRUE)
checkTrue( !identical(TRUE, FALSE))
}
RUnit/inst/share/ 0000755 0001751 0000144 00000000000 13267374743 013430 5 ustar hornik users RUnit/inst/share/R/ 0000755 0001751 0000144 00000000000 13267374743 013631 5 ustar hornik users RUnit/inst/share/R/compareRUnitTestData.r 0000644 0001751 0000144 00000010671 13267374743 020063 0 ustar hornik users ######################################################################
## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
compare <- function(td1, td2, tolerance=100) {
##@bdescr
## compare two test suite result data objects obtained
## on the same test suite
## identify timing differences exceeding 'tolerance' [seconds]
##@edescr
##
##
##@in td1 : [list] of S3 class 'RUnitTestData'
##@in td2 : [list] of S3 class 'RUnitTestData'
##@in tolerance : [numeric] positive scalar
##@ret : [data.frame]
##
##@codestatus : untested
## preconditions
if (!is(td1, "RUnitTestData")) {
stop("argument 'td1' has to be of class 'RUnitTestData'.")
}
if (!is(td2, "RUnitTestData")) {
stop("argument 'td2' has to be of class 'RUnitTestData'.")
}
if (length(tolerance) != 1 || is.na(tolerance) || tolerance < 0) {
stop("argument 'tolerance' has to be positive scalar.")
}
## helper functions
commonNames <- function(x1, x2) {
return(intersect(names(x1), names(x2)))
}
compareTiming <- function(x1, x2, tol=0) {
d <- x1 - x2
if (abs(d) > tol) {
return(d)
} else {
return(as.numeric(0))
}
}
comparePerSourceFile <- function(sf1,sf2, tol=0) {
## FIXME
## check if test case file was considered in this suite
## i.e. test case file name can be in list albeit it
## was not executed in the scenario
## thus list is empty
if (length(sf1) == 0 | length(sf2) == 0) {
cat("\n skipped empty result set:", sf1)
return(NULL)
}
commonTests <- commonNames(sf1, sf2)
t(sapply(commonTests, function(x, obj1, obj2) {
##cat("\n test:", x, "\n")
if(obj1[[x]][["kind"]] == obj2[[x]][["kind"]]) {
if (obj1[[x]][["kind"]] == "success") {
return(c(x, obj1[[x]][["kind"]], obj1[[x]][["time"]],
obj2[[x]][["kind"]], obj2[[x]][["time"]],
compareTiming(obj1[[x]][["time"]],
obj2[[x]][["time"]],
tol=tol)))
} else {
return(c(x, obj1[[x]][["kind"]], as.numeric(NA),
obj2[[x]][["kind"]], as.numeric(NA), as.numeric(NA)))
}
} else {
## no timing delta
## should check for timing in second case
## obj2[[x]][["time"]])
return(c(x, obj1[[x]][["kind"]], as.numeric(NA),
obj2[[x]][["kind"]], as.numeric(NA), as.numeric(NA)))
}
}, obj1=sf1, obj2=sf2))
}
comparePerSuite <- function(s1,s2, tol=0) {
## absolute file names recorded, strip path
commonFiles <- intersect(basename(names(s1[["sourceFileResults"]])),
basename(names(s2[["sourceFileResults"]])))
do.call("rbind", sapply(commonFiles, function(x, obj1, obj2) {
## match exact file name in abs. name
idx1 <- match(x, basename(names(obj1)))
idx2 <- match(x, basename(names(obj2)))
if (length(idx1) != 1 || is.na(idx1) || length(idx2) != 1 || is.na(idx2)) {
stop("ambiguous file name.")
next;
}
comparePerSourceFile(obj1[[idx1]], obj2[[idx2]], tol=tol)
}, obj1=s1[["sourceFileResults"]], obj2=s2[["sourceFileResults"]]) )
}
## main
## test suites to compare
commonTestSuites <- commonNames(td1, td2)
res <- matrix(ncol=6, nrow=0)
colnames(res) <- c("TestCase", "Suite1 State", "Suite1 Timing", "Suite2 State", "Suite2 Timing", "Delta")
for (ti in seq_along(commonTestSuites)) {
res <- rbind(res, comparePerSuite(td1[[commonTestSuites[ti]]], td2[[commonTestSuites[ti]]],
tol=tolerance))
}
## postcondition
return(res)
}
RUnit/inst/share/R/checkCode.r 0000644 0001751 0000144 00000011656 13267374743 015675 0 ustar hornik users ######################################################################
## RUnit : A unit test framework for the R programming language
## Copyright (C) 2003-2009 Thomas Koenig, Matthias Burger, Klaus Juenemann
##
## This program 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; version 2 of the License.
##
## This program 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 this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
## $Id$
checkCodeFiles <- function(fileName) {
##@bdescr
## utility function for code checks of files outside usual R/ folder structure
## requires package codetools
##@edescr
##
##@in fileName : [character] vector of file names (including path, relative to pwd or absolute)
##@ret : [list] with elements per function, that incurred any warning
##
##@depends : codetools
##
##@codestatus : untested
## return list
retList <- list()
## initialized before ls() call to avoid listing
ok <- x <- c()
tmpRetEnv <- new.env()
tmpRet <- NULL
## generate listing of existing objects before first source'ing
lsTmp <- lsInit <- ls()
sapply(fileName, function(x) {
cat("\n file ",x)
ok <- try(utils::capture.output(source(x, local=TRUE, echo=FALSE)))
if (inherits(ok, "try-error")) {
cat("\n file",x,"could not be sourced:", geterrmessage(), "\n")
return()
}
newElements <- setdiff(ls(), lsTmp)
cat("\n functions",paste(newElements, collapse=", "))
lsTmp <- ls()
sapply(newElements, function(x) {
ok <- try(get(x))
if (!inherits(ok, "try-error") && identical(mode(ok), "function")) {
cat("\n ",x," (",is(ok)[1],"): ",sep="")
## this function will be used in signalUsageIssue w$warn
reportFunc <- function(x) {
cat(x)
assign("tmpRet", c(tmpRet, x), pos=parent.env(tmpRetEnv))
}
codetools::checkUsage(ok, report=reportFunc, all=TRUE)
if (!is.null(tmpRet)) {
retList[[length(retList) + 1]] <<- tmpRet
names(retList)[length(retList)] <<- x
}
tmpRet <<- NULL
}
})
})
return(invisible(retList))
}
checkCodeFolders <- function(path=".") {
##@bdescr
## utility function
## code checks of all .[RrSs] files found in one or more folders
## requires package codetools
##@edescr
##
##@in path : [character]
##@ret : [list]
##
##@depends : codetools
##
##@codestatus : untested
stopifnot(require(codetools))
if (!is(path, "character")) {
stop("argument 'path' has to be of type 'character'.")
}
if (!all(file.exists(path))) {
stop("argument 'path' has to contain existing folder(s).")
}
fNames <- list.files(path=path, pattern="\\.[rRsS]$", full.names=TRUE)
checkCodeFiles(fNames)
}
checkCodeSweave <- function(path=".") {
##@bdescr
## utility function
## code checks of all .[RS]nw files found in one or more folders
## experimental: does not convert extracted code chunks to closures
## thus only functions defined inside a chunk but nut all of the chunk code is checked
##
## requires package codetools
##@edescr
##
##@in path : [character]
##@ret : [list]
##@depends : codetools
##
##@codestatus : untested
## Issue:
## local path e.g. 'RUnit/inst/doc'
## is no expanded to full path
## which I would wnat to use as absolute path
## in the Stangle call
stopifnot(require(utils))
stopifnot(require(codetools))
if (!is(path, "character")) {
stop("argument 'path' has to be of type 'character'.")
}
if (!all(file.exists(path))) {
stop("argument 'path' has to contain existing folder(s).")
}
browser()
path <- path.expand(path)
pwd <- getwd()
if (length(path)) {
if (path == ".") {
path <- pwd
}
## do we have a local path rather then an absolute
## how to infer correct absolute path?
}
fName <- list.files(path=path, pattern="\\.[RS]nw$", full.names=TRUE)
timeStamp <- format(Sys.time(), "%y%m%d-%H%M")
tmpDir <- file.path(tempdir(), timeStamp)
print(tmpDir)
if(!file.exists(tmpDir)) {
stopifnot(dir.create(tmpDir, recursive=TRUE))
}
#on.exit(unlink(tmpDir, recursive=TRUE))
## change to temp folder to dump Stangle output therein
setwd(tmpDir)
on.exit(setwd(pwd), add=TRUE)
codeFiles <- unlist(sapply(fName, function(x) {
Stangle(x)
x <- basename(x)
gsub("[RS]nw$", "R", x)
}))
##
codeFiles <- file.path(tmpDir, codeFiles)
checkCodeFiles(codeFiles)
}
RUnit/inst/doc/ 0000755 0001751 0000144 00000000000 14565700136 013062 5 ustar hornik users RUnit/inst/doc/Makefile 0000644 0001751 0000144 00000000626 15024242133 014513 0 ustar hornik users ##
## RUnit
##
## utility
## create PDF document from dvi (usefull if R CMD INSTALL fails to build the pdf)
## $Id$
##
all: RUnit.pdf clean
RUnit.pdf: RUnit.ps
ps2pdf -dEncodeColorImages=false -dColorImageFilter=/FlateEncode -dAutoRotatePages=/None RUnit.ps
RUnit.ps: RUnit.dvi
dvips RUnit
RUnit.dvi: RUnit.tex
latex RUnit
latex RUnit
clean:
rm -f RUnit.aux RUnit.log RUnit.toc
RUnit/inst/doc/RUnit.Rnw 0000644 0001751 0000144 00000050422 14563457515 014626 0 ustar hornik users % -*- mode: noweb; noweb-default-code-mode: R-mode; -*-
%
% $Id: RUnit.Rnw,v 1.22 2009/11/25 15:12:11 burgerm Exp $
%
%
%\VignetteIndexEntry{RUnit primer}
%\VignetteKeywords{Unit Testing, Code Inspection, Programming}
%\VignetteDepends{methods, splines}
%\VignettePackage{RUnit}
\documentclass[12pt, a4paper]{article}
%\usepackage{amsmath,pstricks}
\usepackage{hyperref}
%\usepackage[authoryear,round]{natbib}
%\parskip=.3cm
\oddsidemargin=.1in
\evensidemargin=.1in
\headheight=-.3in
\newcommand{\scscst}{\scriptscriptstyle}
\newcommand{\scst}{\scriptstyle}
\newcommand{\Rfunction}[1]{{\texttt{#1}}}
\newcommand{\Robject}[1]{{\texttt{#1}}}
\newcommand{\Rpackage}[1]{{\textit{#1}}}
%\makeindex
%
\begin{document}
\title{RUnit - A Unit Test Framework for R}
\author{Thomas K\"onig, Klaus J\"unemann, and Matthias Burger\\Epigenomics AG}
\maketitle
\tableofcontents
\section*{Abstract}
\label{section:abstract}
Software development for production systems presents a challenge to the development team as the quality of the coded package(s) has to be constantly monitored and verified. We present a generic approach to software testing for the R language modelled after successful examples such as JUnit, CppUnit, and PerlUnit. The aim of our approach is to facilitate development of reliable software packages and provide a set of tools to analyse and report the software quality status. The presented framework is completely implemented within R and does not rely on external tools or other language systems. The basic principle is that every function or method is accompanied with a test case that queries many calling situations including incorrect invocations. A test case can be executed instantly without reinstalling the whole package - a feature that is necessary for parallel development of functionality and test cases. On a second level one or more packages can be tested in a single test run, the result of which is reported in an well structured test protocol.
To verify the coverage of the test framework a code inspector is provided that monitors the code coverage of executed test cases. The result of individual test invocations as well as package wide evaluations can be compiled into a summary report exported to HTML. This report details the executed tests, their failure or success, as well as the code coverage. Taking it one step further and combining the build system with a development and release procedure with defined code status description this approach opens the way for a principled software quality monitoring and risk assessment of the developed application.
For our code development we have utilised the described system with great benefit w.r.t.\ code reliability and maintenance efforts in a medium sized development team.
\section{Introduction}
The importance of software testing can hardly be overrated. This
is all the more true for interpreted languages where not even a compiler
checks the basic consistency of a program. Nonetheless, testing is
often perceived more as a burden than a help by the
programmer. Therefore it is necessary to provide tools that make the
task of testing as simple and systematic as possible. The key goal of
such a testing framework should be to promote the creation and
execution of test cases to become an integral part of the software
development process. Experience shows that such a permanently repeated
code - test - simplify cycle leads to faster and more successful
software development than the usually futile attempt to add test cases
once the software is largely finished. This line of thought has been
pushed furthest by the Extreme Programming
\cite{xp} and Test-First paradigms
where test cases are viewed as the essential guidelines for the
development process. These considerations lead to various requirements
that a useful testing framework should satisfy:
\begin {itemize}
\item {Tests should be easy to execute.}
\item {The results should be accessible through a well structured test
protocol.}
\item{It should be possible to execute only small portions of the test
cases during the development process.}
\item{It should be possible to estimate the amount of code that is
covered by some test case.}
\end {itemize}
%\paragraph{Background}
%\label{paragraph:Background}
Testing frameworks that address these aspects have been written in a
variety of languages such as Smalltalk, Java, C++ and Python. In
particular, the approach described in \cite{beck} has turned out to be
very successful, leading -- among others -- to the popular JUnit
library for Java \cite{junit}, which has
been ported to many other languages (see \cite{xp} for an extensive list of testing
frameworks for all kinds of languages). Accordingly, the RUnit package (available at sourceforge \cite{runit-sf}) is our
version of porting JUnit to R, supplemented by additional
functionality to inspect the test coverage of some function under question.
%\paragraph{Motivation}
%\label{paragraph:Motivation}
One may wonder why R would need yet another testing framework
even though the standard method, namely executing {\it R CMD check} on ones complete package at the shell prompt, is widely accepted and applied.
We think, however, that the RUnit approach is more in line with the above listed
requirements and can be seen as a complement to the existing process in that:
\begin{itemize}
\item{test cases are called and executed from the R prompt}
\item{the programmer decides which result or functionality to put under testing, e.g.\
formating issues of textual output do not need to matter}
\item{test and reference data files need not be maintained separately but are combined into one file}
\item{test cases need not be limited to testing/using functionality from one package checked at a time}
\end{itemize}
Moreover, testing frameworks based on JUnit ports seem
to have become a quasi standard in many programming languages. Therefore,
programmers new to R but familiar with other languages might
appreciate a familiar testing environment. And finally, offering more
than one alternative in the important field of code testing is certainly not a bad idea and could turn out useful.
Before explaining the components of the RUnit package in detail,
we would like to list some of the lessons learned in the attempt of
writing useful test suites for our software (a more complete collection
of tips relating to a Test-First development approach can be found in \cite{tfg}):
\begin{itemize}
\item {Develop test cases parallel to implementing your
functionality. Keep testing all the time (code - test - simplify
cycle). Do not wait until the software is complete and attempt to
add test cases at the very end. This typically leads to poor quality
and incomplete test cases.}
\item{Distinguish between unit and integration tests: Unit tests
should be as small as possible and check one unit of functionality
that cannot be further decomposed. Integration tests, on the other
hand, run through a whole analysis workflow and check the
interplay of various software components.}
\item{Good test coverage enables refactoring, by which a
reorganisation of the implementation is meant. Without regular testing the
attitude {\it `I better do not touch this code anymore`} once some piece
of software appears to be working is frequently
encountered. It is very pleasing and time-saving just to run a
test suite after some improvement or simplification of the
implementation to see that all test cases are still passing
(or possibly reveal some newly introduced bug). This
refactoring ability is a key benefit of unit testing leading
not only to better software quality but also to better design.}
\item{Do not test internal functions but just the public interface of
a library. Since R does not provide very much language support for this
distinction, the first step here is to clarify which
functions are meant to be called by a user of a package and which are
not (namespaces in R provide a useful directive for making this distinction, if
the export list is selected carefully and maintained).
If internal functions are directly tested, the ability of
refactoring gets lost because this typically involves
reorganisation of the internal part of a library.}
\item {Once a bug has been found, add a corresponding test case.}
\item{We greatly benefitted from an automated test system: A
shell script, running nightly, checks out and installs all relevant packages.
After that all test suites are run and the resulting test protocol is stored
in a central location. This provides an excellent overview over the current
status of the system and the collection of nightly test protocols documents
the development progress.}
\end{itemize}
\section{The RUnit package}
\label{section:RUnitPackage}
This section contains a detailed explanation of the RUnit package and
examples how to use it. As has already been mentioned the package
contains two independent components: a framework for test case
execution and a tool that allows to inspect the flow of execution
inside a function in order to analyse which portions of code are
covered by some test case.
Both components are now discussed in turn.
\subsection{Test case execution}
\label{subsection:Testcaseexecution}
The basic idea of this component is to execute a set of test functions
defined through naming conventions, store whether or not the test
succeeded in a central logger object and finally write a test protocol
that allows to precisely identify the problems.
{\bf Note, that RUnit - by default - sets the version for normal, and all other RNGs to 'Kinderman-Ramage', and 'Marsaglia-Multicarry', respectively. If you like to change these defaults please see {\tt ?defineTestSuite} for argument 'rngNormalKind' and 'rngKind'.}
As an example consider a function that converts centigrade to
Fahrenheit:
\begin{Sinput}
c2f <- function(c) return(9/5 * c + 32)
\end{Sinput}
A corresponding test function could look like this:
\begin{Sinput}
test.c2f <- function() {
checkEquals(c2f(0), 32)
checkEquals(c2f(10), 50)
checkException(c2f("xx"))
}
\end{Sinput}
The default naming convention for test functions in the RUnit package is {\tt test...} as is standard in JUnit. To perform the actual checks that the function to be tested works correctly a set of functions called {\tt check ...} is provided. The purpose of these {\tt check} functions is two-fold: they make sure that a possible failure is reported to the central test logger so that it will appear properly in the final test protocol and they are supposed to make explicit the actual checks in a test case as opposed to other code used to set up the test scenario. Note that {\tt checkException} fails if the passed expression does not generate an error. This kind of test is useful to make sure that a function correctly recognises error situations instead of silently creating inappropriate results. These check functions are direct equivalents to the various {\tt assert} functions of the JUnit framework. More information can be found in the online help.
Before running the test function it is necessary to create a test suite which is a collection of test functions and files relating to one topic. One could, for instance, create one test suite for one R package. A test suite is just a list containing a name, an array of absolute directories containing the locations of the test files, a regular expression identifying the test files and a regular expression identifying the test functions. In our example assume that the test function is located in a file {\tt runitc2f.r} located in a directory {\tt /foo/bar/}. To create the corresponding test suite we can use a helper function:
\begin{Sinput}
testsuite.c2f <- defineTestSuite("c2f",
dirs = file.path(.path.package(package="RUnit"),
"examples"),
testFileRegexp = "^runit.+\\.r",
testFuncRegexp = "^test.+",
rngKind = "Marsaglia-Multicarry",
rngNormalKind = "Kinderman-Ramage")
\end{Sinput}
All that remains is to run the test suite and print the test protocol:
\begin{Sinput}
testResult <- runTestSuite(testsuite.c2f)
printTextProtocol(testResult)
\end{Sinput}
The resulting test protocol should be self explanatory and can also be printed as HTML version. See the online help for further information.
Note that for executing just one test file there is also a shortcut in order to make test case execution as easy as possible:
\begin{Sinput}
runTestFile(file.path(.path.package(package="RUnit"),
"examples/runitc2f.r"))
\end{Sinput}
The creation and execution of test suites can be summarised by the following recipe:
\begin{enumerate}
\item{create as many test functions in as many test files as necessary }
\item{create one or more test suites using the helper function {\tt defineTestSuite}}
\item{run the test suites with {\tt runTestSuite}}
\item{print the test protocol either with {\tt printTextProtocol} or with {\tt printHTMLProtocol} (or with a generic method like {\tt print} or {\tt summary})}
\end{enumerate}
We conclude this section with some further comments on various aspects of the test execution framework:
\begin{itemize}
\item{A test file can contain an arbitrary number of test functions. A test directory can contain an arbitrary number of test files, a test suite can contain an arbitrary number of test directories and the test runner can run an arbitrary number of test suites -- all resulting in one test protocol. The test function and file names of a test suite must, however, obey a naming convention expressible through regular expressions.
As default test functions start with {\tt test} and files with {\tt runit}.}
\item{RUnit makes a distinction between failure and error. A failure occurs if one of the check functions fail (e.g.~{\tt checkTrue(FALSE)} creates a failure). An error is reported if an ordinary R error (usually created by {\tt stop}) occurs.}
\item{Since version 0.4.0 there is a function {\tt DEACTIVATED} which
can be used to deactivate test cases temporarily. This might be useful
in the case of a major refactoring. In particular, the deactivated
test cases are reported in the test protocol so that they cannot fall
into oblivion.}
\item{The test runner tries hard to leave a clean R session behind. Therefore all objects created during test case execution will be deleted after a test file has been processed.}
\item{In order to prevent mysterious errors the random number generator is reset to a standard setting before sourcing a test file. If a particular setting is needed to generate reproducible results it is fine to configure the random number generator at the beginning of a test file. This setting applies during the execution of all test functions of that test file but is reset before the next test file is sourced.}
\item{In each source file one can define the parameterless functions {\tt .setUp()} and {\tt .tearDown()}.
which are then executed directly before and after each test function. This can, for instance, be used to control global settings or create addition log information.}
\end{itemize}
\subsection{R Code Inspection}
\label{subsection:RCodeInspection}
The Code Inspector is an additional tool for checking detailed test case coverage and getting profiling information.
It records how often a code line will be executed. We utilise this information for improving our test cases, because we can identify code lines not executed by the current test case code.
The Code Inspector is able to handle S4 methods.
During the development of the Code Inspector, we noticed, that the syntax of R is very flexible.
Because our coding philosophy has an emphasis of maintenance and a clear style, we developed style guides for our R coding.
Therefore, one goal for the Code Inspector was to handle our coding styles in a correct manner.
This leads to the consequence that not all R expression can be handled correctly.
In our implementation the Code Inspector has two main functional parts.
The first part is responsible for parsing and modifying the code of the test function.
The second part, called the Tracker, holds the result of the code tracking.
The result of the tracking process allows further analysis of the executed code.
\subsubsection{Usage}
The usage of the Code Inspector and the Tracker object is very simple. The following code snippet is an example:
<>=
library(RUnit)
## define sample functions to be tested
foo <- function(x) {
x <- x*x
x <- 2*x
return(x)
}
test.foo <- function() {
checkTrue(is.numeric(foo(1:10)))
checkEquals(length(foo(1:10)), 10)
checkEqualsNumeric(foo(1), 2)
}
bar <- function(x, y=NULL) {
if (is.null(y)) {
y <- x
}
if (all(y > 100)) {
## subtract 100
y <- y - 100
}
res <- x^y
return(res)
}
track <- tracker(); ## initialize a tracking "object"
track$init(); ## initialize the tracker
a <- 1:10
d <- seq(0,1,0.1)
resFoo <- inspect(foo(a), track=track); ## execute the test function and track
resBar <- inspect(bar(d), track=track); ## execute the test function and track
resTrack <- track$getTrackInfo(); ## get the result of Code Inspector (a list)
printHTML(resTrack, baseDir=tempdir()) ; ## create HTML sites
@
Note, that the tracking object is an global object and must have the name {\tt track}.
The {\tt inspect} function awaits a function call as argument and executes and tracks the function.
The results will be stored in the tracking object.
The result of the function (not of the Tracker) will be returned as usual.
The tracking results will received by tr\$getResult().
With {\tt printHTML} the result of the tracking process will be presented as HTML pages.
\subsubsection{Technical Details}
The general idea for the code tracking is to modify the source code of the function.
Therefore, we use the {\tt parse} and {\tt deparse} functions and the capability of R to generate functions on runtime.
To track the function we try to include a hook in every code line.
That hook calls a function of the tracked object.
The information of the tracking will be stored in the closure of the tracking object (actually a function).
Because the R parser allows very nested expressions, we didn't try to modify every R expression.
This is a task for the future.
A simple example for the modifying process is as follow:\\
original:
<>=
foo <- function(x)
{
y <- 0
for(i in 1:x)
{
y <- y + x
}
return(y)
}
@
modified:
<>=
foo.mod <- function(x)
{
track$bp(1) ;
y <- 0
track$bp(2);
for(i in 1:x)
{
track$bp(4) ;
y <- y +x
}
track$bp(6);
return(y)
}
@
Problematic code lines are:
<>=
if(any(a==1)) {
print("do TRUE")
} else print ("do FALSE");
@
This must be modified to
<>=
if(any(a==1)) {
track$bp(2);
print("do TRUE")
}else{
track$bp(3);
print("do FALSE");
}
@
The problem is the \textit{else} branch, that cannot be modified in the current version.
\section{Future Development Ideas}
Here we briefly list -- in an unordered manner -- some of the avenues for future development we or someone interested in this package could take:
\begin{itemize}
\item{extend the {\tt checkEquals} function to handle complex S4 class objects correctly in comparisons. To this end R core has modified check.equal to handle S4 objects.}
\item{reimplement the internal structures storing the test suite as well as the test result data as S4 classes.}
\item{record all warnings generated during the execution of a test function.}
\item{add tools to create test cases automatically. This is a research project but -- given the importance of testing -- worth the effort. See \cite{junit} for various approaches in other languages.}
\item{improve the export of test suite execution data e.g.~by adding XML data export support.}
\item{add some evaluation methods to the code inspector e.g.~use software metrics to estimate standard measures of code quality, complexity, and performance.}
\item{overcome the problem of nested calls to registered functions for code inspection.}
\item{allow automatic registration of functions \& methods.}
\end{itemize}
\begin{thebibliography}{99}
% \bibliographystyle{plainnat}
\bibitem{xp} http://www.xprogramming.com
\bibitem{beck} http://www.xprogramming.com/testfram.htm
\bibitem{junit} http://www.junit.org/
\bibitem{tfg} http://www.xprogramming.com/xpmag/testFirstGuidelines.htm
\bibitem{runit-sf} https://sourceforge.net/projects/runit/
\end{thebibliography}
\end{document}
RUnit/inst/doc/RUnit.pdf 0000644 0001751 0000144 00000246660 15024242132 014620 0 ustar hornik users %PDF-1.5
%
1 0 obj
<< /Type /ObjStm /Length 3690 /Filter /FlateDecode /N 71 /First 572 >>
stream
x[[s6~_vg'$NfNu6ݝ<(2mTt~UdQv wppHƙbBxecVkeLH -5ȲH:c?o2L&4+d
QLJTT!L[K9fA=ό
h<0+5¬#a[kv?~^,/VMtWs@{O_z5]֘Lul\
JU#8Zģ62N)+af&[RHeW|-Yl>_':Vu|]Q**.T&LZd{jwrT`o5OC㮄}(BrfiH w zY.*wI&W+ڏ9*i!*wgCOSq9+ 弞#sC9}28YV8+qJg,[j ko^{r.'@}XSXځ5ikDh#U?suM#:Ko.Swߎ/9詖52ڏe=EpN'W$$ U~
*ŲX|1/Ox?/bYX@6L^(`rRy@Tƪ[S@aH-{N8,X{R9\NerUF.Kuڬou{D=yu6u>61CʭK)@ZpeD!{?Rr,&
[6:EQa>,.XisQ>,&,0 KX*q',0`_$РUFF5N%^.0ֻQ&zGhcrpi>p1cGF`oIjt}mRenԾcrK8OŲ\\.H1vK x;NVtn _?<
n^t&