[Sciviews-commits] r9 - in pkg: . svIDE svIDE/R svIDE/man svMisc/R svUnit svUnit/R svUnit/inst svUnit/inst/unitTests svUnit/inst/unitTests/VirtualClass svUnit/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jun 12 01:13:08 CEST 2008
Author: phgrosjean
Date: 2008-06-12 01:13:08 +0200 (Thu, 12 Jun 2008)
New Revision: 9
Added:
pkg/svUnit/
pkg/svUnit/DESCRIPTION
pkg/svUnit/NAMESPACE
pkg/svUnit/NEWS
pkg/svUnit/R/
pkg/svUnit/R/runUnit.R
pkg/svUnit/R/svTest.R
pkg/svUnit/R/svUnit.R
pkg/svUnit/TODO
pkg/svUnit/inst/
pkg/svUnit/inst/CITATION
pkg/svUnit/inst/unitTests/
pkg/svUnit/inst/unitTests/VirtualClass/
pkg/svUnit/inst/unitTests/VirtualClass/runit.VirtualClass.R
pkg/svUnit/inst/unitTests/runit.svTest.R
pkg/svUnit/inst/unitTests/runit.svUnit.R
pkg/svUnit/man/
pkg/svUnit/man/runUnit.Rd
pkg/svUnit/man/svTest.Rd
pkg/svUnit/man/svUnit.Rd
pkg/svUnit/man/unitTests.Rd
Modified:
pkg/svIDE/NEWS
pkg/svIDE/R/guiDDEInstall.R
pkg/svIDE/man/guiDDEInstall.Rd
pkg/svMisc/R/CallTip.R
Log:
svUnit added + small changes in svIDE/guiDDEInstall
Modified: pkg/svIDE/NEWS
===================================================================
--- pkg/svIDE/NEWS 2008-06-09 21:51:43 UTC (rev 8)
+++ pkg/svIDE/NEWS 2008-06-11 23:13:08 UTC (rev 9)
@@ -10,7 +10,7 @@
* A change in argument names for guiCalltip() and guiComplete() prevented the
DDE server to work properly for those two commands (Tinn-R). This bug is
fixed (Tcl does not support names with dots, like max.width). Hence, the
- argument is changed to maxWidth. Same for only.args that becomes onlyArgs.
+ argument is changed to width. Same for only.args that becomes onlyargs.
== Changes in svIDE 0.9-41
* One bug corrected in trObjSearch(): incorrect output of the results in a
Modified: pkg/svIDE/R/guiDDEInstall.R
===================================================================
--- pkg/svIDE/R/guiDDEInstall.R 2008-06-09 21:51:43 UTC (rev 8)
+++ pkg/svIDE/R/guiDDEInstall.R 2008-06-11 23:13:08 UTC (rev 9)
@@ -1,21 +1,21 @@
"guiCallTip" <-
-function(code, file = NULL, onlyArgs = FALSE, maxWidth = 60, location = FALSE) {
+function(code, file = NULL, onlyargs = FALSE, width = 60, location = FALSE) {
# This is an interface to CallTip for external programs
# Clear ::SciViewsR_CallTip
.Tcl("set ::SciViewsR_CallTip {}")
# Using a callback, all args are strings => convert
if (length(file) == 0 || file == "" || file == "NULL") file <- NULL
- onlyArgs <- as.logical(onlyArgs[1])
- maxWidth <- as.integer(maxWidth[1])
+ onlyargs <- as.logical(onlyargs[1])
+ width <- as.integer(width[1])
# Get the call tip
- ctip <- CallTip(code, only.args = onlyArgs, location = location)
+ ctip <- CallTip(code, only.args = onlyargs, location = location)
# Possibly break long lines at reasonables widths
- if (onlyArgs) Exdent <- 0 else Exdent <- 4
- if (!is.null(maxWidth) && !maxWidth < 1)
- ctip <- paste(strwrap(ctip, width = maxWidth, exdent = Exdent), collapse = "\n")
+ if (onlyargs) Exdent <- 0 else Exdent <- 4
+ if (!is.null(width) && !width < 1)
+ ctip <- paste(strwrap(ctip, width = width, exdent = Exdent), collapse = "\n")
# Copy the result to a Tcl variable
.Tcl(paste("set ::SciViewsR_CallTip {", ctip, "}", sep = ""))
@@ -103,8 +103,8 @@
# Install callbacks for guiXXXX functions, for DDE clients to access them
# guiCallTip()... Take care: must be adapted if you change guiCallTip()!
res <- .Tcl.args(guiCallTip)
- .Tcl(paste("proc guiCallTip {code {file \"\"} {onlyArgs FALSE}",
- " {maxWidth 60} {location FALSE} }", gsub("%", "$", res), sep = ""))
+ .Tcl(paste("proc guiCallTip {code {file \"\"} {onlyargs FALSE}",
+ " {width 60} {location FALSE} }", gsub("%", "$", res), sep = ""))
# guiComplete()... Take care: must be adapted if you change guiComplete()!
res <- .Tcl.args(guiComplete)
Modified: pkg/svIDE/man/guiDDEInstall.Rd
===================================================================
--- pkg/svIDE/man/guiDDEInstall.Rd 2008-06-09 21:51:43 UTC (rev 8)
+++ pkg/svIDE/man/guiDDEInstall.Rd 2008-06-11 23:13:08 UTC (rev 9)
@@ -10,7 +10,7 @@
}
\usage{
guiDDEInstall()
-guiCallTip(code, file = NULL, onlyArgs = FALSE, maxWidth = 60, location = FALSE)
+guiCallTip(code, file = NULL, onlyargs = FALSE, width = 60, location = FALSE)
guiComplete(code, file = NULL, givetype = FALSE, sep = "|")
}
@@ -18,8 +18,8 @@
\item{code}{ A piece of R code (in a character string) to analyze }
\item{file}{ A file where to return the result ("", or NULL for none). You
can use "clipboard" to send the result to the clipboard under Windows only }
- \item{onlyArgs}{ Do we return the whole calltip or only the function arguments? }
- \item{maxWidth}{ Reformat the calltip to max.with (use 0 for not reformatting it) }
+ \item{onlyargs}{ Do we return the whole calltip or only the function arguments? }
+ \item{width}{ Reformat the calltip to with (use 0 for not reformatting it) }
\item{location} { If \code{TRUE} then the location (in which package the
function resides) is appended to the calltip between square brackets }
\item{givetype}{ Return also the type of each object in the completion list (possibly
Modified: pkg/svMisc/R/CallTip.R
===================================================================
--- pkg/svMisc/R/CallTip.R 2008-06-09 21:51:43 UTC (rev 8)
+++ pkg/svMisc/R/CallTip.R 2008-06-11 23:13:08 UTC (rev 9)
@@ -1,5 +1,5 @@
"CallTip" <-
-function(code, only.args = FALSE, location = FALSE) {
+function(code, onlyargs = FALSE, location = FALSE) {
# Get a call tip, given a part of the code
# Extract the last variable name, given it is either at the end,
# or terminated by '('
Added: pkg/svUnit/DESCRIPTION
===================================================================
--- pkg/svUnit/DESCRIPTION (rev 0)
+++ pkg/svUnit/DESCRIPTION 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,11 @@
+Package: svUnit
+Title: SciViews GUI API - Unit testing
+Depends: R (>= 1.9.0), RUnit
+Suggests: svGUI
+Description: Functions to implement the GUI part of a unit test system based on RUnit
+Version: 0.4-0
+Date: 2008-06-11
+Author: Philippe Grosjean
+Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
+License: GPL 2 or above
+URL: http://www.sciviews.org/SciViews-R
Added: pkg/svUnit/NAMESPACE
===================================================================
--- pkg/svUnit/NAMESPACE (rev 0)
+++ pkg/svUnit/NAMESPACE 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,30 @@
+import(RUnit)
+
+export(svTest,
+ as.svTest,
+ is.svTest,
+ is.test,
+ test,
+ "test<-",
+ makeUnit,
+ runTest,
+ svUnit,
+ as.svUnit,
+ is.svUnit,
+ svUnitList,
+ runUnit,
+ unitClear,
+ unitError)
+
+S3method(makeUnit, default)
+S3method(makeUnit, svTest)
+S3method(makeUnit, svUnit)
+
+S3method(runTest, default)
+S3method(runTest, svTest)
+S3method(runTest, svUnit)
+
+S3method(print, svUnit)
+
+S3method(print, svUnitData)
+S3method(summary, svUnitData)
Added: pkg/svUnit/NEWS
===================================================================
--- pkg/svUnit/NEWS (rev 0)
+++ pkg/svUnit/NEWS 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,4 @@
+= svUnit News
+
+== svUnit 0.1-0
+First version compiled as a package and distributed on R-Forge.
Added: pkg/svUnit/R/runUnit.R
===================================================================
--- pkg/svUnit/R/runUnit.R (rev 0)
+++ pkg/svUnit/R/runUnit.R 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,245 @@
+runUnit <-
+function(name, dirs, print.errors = !interactive(), warn = print.errors,
+ rngKind = "Marsaglia-Multicarry", rngNormalKind = "Kinderman-Ramage") {
+ # Define a test suite and run it more silently than done in RUnit
+ # Also, increment counters with errors, failings and deactivated
+
+ # Define a test suite and run it (same as defineTestSuite() in RUnit)
+ testSuite <- list(name = name, dirs = dirs,
+ testFileRegexp = "^runit.+\\.[rR]$", testFuncRegexp = "^test.+",
+ rngKind = rngKind, rngNormalKind = rngNormalKind)
+ class(testSuite) <- "RUnitTestSuite"
+
+ # runTestSuite() prints results of tests, but we prefer to run it
+ # more silently than in RUnit
+ runSuite <- function (testSuite) {
+ file <- textConnection("rval", "w", local = TRUE)
+ sink(file, type = "output")
+ sink(file, type = "message")
+ on.exit({
+ sink(type = "output")
+ sink(type = "message")
+ close(file)
+ })
+ return(runTestSuite(testSuites = testSuite))
+ }
+ res <- runSuite(testSuite)
+
+ # Check that res is a 'RUnitTestData' object
+ if (!inherits(res, "RUnitTestData"))
+ stop("Result of runTestSuite() is not a 'RUnitTestData' object")
+
+ # If there are errors, failures or deactivated items, increment counters
+ err <- list(nErr = 0, nDeactivated = 0, nFail = 0, nTestFunc = 0)
+ for (i in seq(length = length(res))) {
+ err$nErr <- err$nErr + res[[i]]$nErr
+ err$nDeactivated <- err$nDeactivated + res[[i]]$nDeactivated
+ err$nFail <- err$nFail + res[[i]]$nFail
+ }
+
+ if (err$nErr > 0) {
+ if (exists(".tests.errors", envir = .GlobalEnv, inherits = FALSE)) {
+ nErr <- get(".tests.errors", envir = .GlobalEnv, inherits = FALSE)
+ } else nErr <- 0
+ assign(".tests.errors", nErr + err$nErr, envir = .GlobalEnv)
+ }
+ if (err$nFail > 0) {
+ if (exists(".tests.failures", envir = .GlobalEnv, inherits = FALSE)) {
+ nFail <- get(".tests.failures", envir = .GlobalEnv, inherits = FALSE)
+ } else nFail <- 0
+ assign(".tests.failures", nFail + err$nFail, envir = .GlobalEnv)
+ }
+ if (err$nDeactivated > 0) {
+ if (exists(".tests.deactivated", envir = .GlobalEnv, inherits = FALSE)) {
+ nDeactivated <- get(".tests.deactivated", envir = .GlobalEnv,
+ inherits = FALSE)
+ } else nDeactivated <- 0
+ assign(".tests.deactivated", nDeactivated + err$nDeactivated, envir = .GlobalEnv)
+ if (warn) warning("Test unit '", name, "' has ", err$nDeactivated, " deactivated items")
+ }
+
+ # Change class to c('svUnitData', 'RUnitTestData') to overload summary()
+ class(res) <- c('svUnitData', 'RUnitTestData')
+
+ # Do we print a summary of these tests in case of errors or failures?
+ if (print.errors && (err$nErr + err$nFail) > 0)
+ summary(res)
+
+ return(invisible(res))
+}
+
+print.svUnitData <-
+function(x, ...) {
+ if (!inherits(x, "svUnitData"))
+ stop("'x' must be a 'svUnitData' object")
+ if (length(x) == 0) {
+ cat("no test cases\n")
+ return(invisible(TRUE))
+ }
+ err <- list(nErr = 0, nDeactivated = 0, nFail = 0, nTestFunc = 0)
+ for (i in seq(length = length(x))) {
+ err$nErr <- err$nErr + x[[i]]$nErr
+ err$nDeactivated <- err$nDeactivated + x[[i]]$nDeactivated
+ err$nFail <- err$nFail + x[[i]]$nFail
+ err$nTestFunc <- err$nTestFunc + x[[i]]$nTestFunc
+ }
+ cat("Number of test functions:", err$nTestFunc, "\n")
+ if (err$nDeactivated > 0)
+ cat("Number of deactivated test functions:", err$nDeactivated, "\n")
+ cat("Number of errors:", err$nErr, "\n")
+ cat("Number of failures:", err$nFail, "\n")
+ return(invisible(x))
+}
+
+summary.svUnitData <-
+function(object, ...) {
+ if (!inherits(object, "svUnitData"))
+ stop("'object' must be a 'svUnitData' object")
+
+ sop <- function(number, word, plext = "s") {
+ ifelse(number == 1, paste(number, word), paste(number,
+ paste(word, plext, sep = "")))
+ }
+
+ if (length(object) == 0) {
+ cat("no test cases\n")
+ return(invisible(object))
+ }
+ err <- list(nErr = 0, nDeactivated = 0, nFail = 0, nTestFunc = 0)
+ for (i in seq(length = length(object))) {
+ err$nErr <- err$nErr + object[[i]]$nErr
+ err$nDeactivated <- err$nDeactivated + object[[i]]$nDeactivated
+ err$nFail <- err$nFail + object[[i]]$nFail
+ err$nTestFunc <- err$nTestFunc + object[[i]]$nTestFunc
+ }
+ cat("Number of test functions:", err$nTestFunc, "\n")
+ if (err$nDeactivated > 0)
+ cat("Number of deactivated test functions:", err$nDeactivated, "\n")
+ cat("Number of errors:", err$nErr, "\n")
+ cat("Number of failures:", err$nFail, "\n")
+
+ if (err$nErr + err$nDeactivated + err$nFail == 0)
+ return(invisible(object))
+
+ cat("Details:\n")
+ traceBackCutOff <- 9 # Cut unintersting part of the traceBack
+ for (tsName in names(object)) {
+ tsList <- object[[tsName]]
+ cat("===========================\n")
+ cat("Test Suite:", tsName, "\n")
+ if (length(tsList$dirs) == 0) {
+ cat("No directories !\n")
+ } else {
+ res <- tsList$sourceFileResults
+ testFileNames <- names(res)
+ if (length(res) == 0) {
+ cat("no test files\n")
+ } else {
+ for (testFileName in testFileNames) {
+ testFuncNames <- names(res[[testFileName]])
+ if (length(testFuncNames) > 0) {
+ cat("---------------------------\n")
+ cat("Test file:", testFileName, "\n")
+ for (testFuncName in testFuncNames) {
+ testFuncInfo <- res[[testFileName]][[testFuncName]]
+ if (testFuncInfo$kind == "success") {
+ cat(testFuncName, ":", " ... OK (", testFuncInfo$time,
+ " seconds)\n", sep = "")
+ } else {
+ if (testFuncInfo$kind == "error") {
+ cat(testFuncName, ": ERROR !!\n", sep = "")
+ } else if (testFuncInfo$kind == "failure") {
+ cat(testFuncName, ": FAILURE !! (check number ",
+ testFuncInfo$checkNum, ")\n", sep = "")
+ } else if (testFuncInfo$kind == "deactivated") {
+ cat(testFuncName, ": DEACTIVATED, ")
+ } else {
+ cat(testFuncName, ": unknown error kind\n", sep = "")
+ }
+ cat(testFuncInfo$msg)
+ if (length(testFuncInfo$traceBack) > 0) {
+ cat(" Call Stack:\n")
+ if (traceBackCutOff > length(testFuncInfo$traceBack)) {
+ cat(" (traceBackCutOff argument larger than length of trace back: full trace back printed)")
+ for (i in 1:length(testFuncInfo$traceBack)) {
+ cat(" ", i, ": ", testFuncInfo$traceBack[i],
+ "\n", sep = "")
+ }
+ } else {
+ for (i in traceBackCutOff:length(testFuncInfo$traceBack)) {
+ cat(" ", 1 + i - traceBackCutOff,
+ ": ", testFuncInfo$traceBack[i],
+ "\n", sep = "")
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(invisible(TRUE))
+}
+
+unitClear <-
+function () {
+ # Clear .tests.errors.tests.failures and .tests.deactivated from .GlobalEnv
+ if (exists(".tests.errors", envir = .GlobalEnv, inherits = FALSE)) {
+ nErr <- get(".tests.errors", envir = .GlobalEnv, inherits = FALSE)
+ rm(".tests.errors", envir = .GlobalEnv, inherits = FALSE)
+ } else nErr <- 0
+ if (exists(".tests.failures", envir = .GlobalEnv, inherits = FALSE)) {
+ nFail <- get(".tests.failures", envir = .GlobalEnv, inherits = FALSE)
+ rm(".tests.failures", envir = .GlobalEnv, inherits = FALSE)
+ } else nFail <- 0
+ if (exists(".tests.deactivated", envir = .GlobalEnv, inherits = FALSE)) {
+ nDeactivated <- get(".tests.deactivated", envir = .GlobalEnv,
+ inherits = FALSE)
+ rm(".tests.deactivated", envir = .GlobalEnv, inherits = FALSE)
+ } else nDeactivated <- 0
+ return(invisible(list(nErr = nErr, nDeactivated = nDeactivated,
+ nFail = nFail)))
+}
+
+unitError <-
+function (errors = TRUE, failures = TRUE, deactivated = TRUE,
+stopit = TRUE) {
+ # Read the content of .tests.errors and .tests.failures from .GlobalEnv
+ allErr <- 0
+ if (errors) {
+ if (exists(".tests.errors", envir = .GlobalEnv, inherits = FALSE)) {
+ nErr <- get(".tests.errors", envir = .GlobalEnv, inherits = FALSE)
+ allErr <- nErr
+ } else nErr <- 0
+ } else nErr <- NA
+
+ if (failures) {
+ if (exists(".tests.failures", envir = .GlobalEnv, inherits = FALSE)) {
+ nFail <- get(".tests.failures", envir = .GlobalEnv, inherits = FALSE)
+ allErr <- allErr + nFail
+ } else nFail <- 0
+ } else nFail <- NA
+
+ # Are there deactivated items?
+ if (deactivated) {
+ if (exists(".tests.deactivated", envir = .GlobalEnv, inherits = FALSE)) {
+ nDeactivated <- get(".tests.deactivated", envir = .GlobalEnv,
+ inherits = FALSE)
+ if (stopit) # Issue a warning!
+ warning("There are ", nDeactivated, " deactivated tests!")
+ } else nDeactivated <- 0
+ } else nDeactivated <- NA
+
+ # Do we stop in case of any error?
+ if (stopit && allErr > 0) {
+ msg <- paste("\nUnit test errors: ", nErr, "\n")
+ msg <- paste(msg, "Unit test failures: ", nFail, sep = "")
+ stop(msg)
+ }
+ res <- (allErr == 0)
+ attr(res, "errors") <- list(nErr = nErr, nDeactivated = nDeactivated,
+ nFail = nFail)
+ return(invisible(res))
+}
Added: pkg/svUnit/R/svTest.R
===================================================================
--- pkg/svUnit/R/svTest.R (rev 0)
+++ pkg/svUnit/R/svTest.R 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,129 @@
+svTest <-
+function (testFun) {
+ # Create a 'svTest' object, using testFun: a function without arguments
+ if (!is.function(testFun))
+ stop("'testFun' must be a function or a 'svTest' object")
+ # Check that there are no arguments
+ if (length(formals(testFun)) > 0)
+ stop("'testFun' must be a function without any arguments")
+ # This is a S3 object of class 'svTest'
+ class(testFun) <- "svTest"
+ return(testFun)
+}
+
+as.svTest <-
+function (x) {
+ # Coercion to a 'svTest' object
+ return(svTest(x))
+}
+
+is.svTest <-
+function (x) {
+ # It this a svTest object
+ return(inherits(x, "svTest"))
+}
+
+is.test <-
+function (x) {
+ # Is this a test object (indeed a 'svTest' one)
+ # or do this object contain a non NULL 'test' attribute
+ return(is.svTest(x) || !is.null(attr(x, "test")))
+}
+
+test <-
+function (x) {
+ # If x is a 'svTest' object, return it, otherwise,
+ # get the 'test' attribute from the object, if it exists
+ if (is.svTest(x)) {
+ return(x)
+ } else {
+ return(attr(x, "test"))
+ }
+}
+
+`test<-` <-
+function (x, value) {
+ # Add 'value' as a 'test' attribute to 'x' after coercing to 'svTest'
+ attr(x, "test") <- as.svTest(value)
+ return(x)
+}
+
+makeUnit <-
+function(x, ...)
+ UseMethod("makeUnit")
+
+makeUnit.default <-
+function(x, name = make.names(deparse(substitute(x))), dir = tempdir(), ...) {
+ # Take an object and make a unit from the tests it contains
+ # It is saved in a file runit.<name>.R in 'dir'
+ name <- as.character(name[1])
+ dir <- as.character(dir[1])
+ # Check that dir exists (do not create it!)
+ if (!file.exists(dir) || !file.info(dir)$isdir)
+ stop("'dir' must be an existing directory")
+
+ Unit <- file.path(dir, paste("runit", name, "R", sep = "."))
+ cat("# Test unit '", name, "'\n", sep = "", file = Unit)
+
+ # Just get the test from the object
+ Test <- test(x)
+ # Make sure the name start with "test."
+ if (regexpr("^test\\.", name) > -1) testname <- name else
+ testname <- paste("test", name, sep = ".")
+ testname <- make.names(testname)
+ cat('\n"', testname, '" <-\n', sep = "", file = Unit, append = TRUE)
+ if (is.null(Test)) {
+ # Create a dummy test with DEACTIVATED entry
+ body <- c(
+ 'function() {',
+ paste('\tDEACTIVATED("Object', deparse(substitute(x)), 'has no tests!")'),
+ '}\n')
+ } else {
+ capture.body <-
+ function(Data) {
+ rval <- NULL
+ File <- textConnection("rval", "w", local = TRUE)
+ sink(File)
+ on.exit({ sink(); close(File) })
+ dput(Data, file = File, control = "useSource")
+ on.exit()
+ sink()
+ close(File)
+ return(rval)
+ }
+ body <- capture.body(Test)
+ }
+ cat(body, sep = "\n", file = Unit, append = TRUE)
+
+ return(Unit)
+}
+
+makeUnit.svTest <-
+function(x, name = make.names(deparse(substitute(x))), dir = tempdir(), ...)
+ return(makeUnit.default(x, name = name, dir = dir, ...))
+
+runTest <-
+function(x, ...)
+ UseMethod("runTest")
+
+runTest.default <-
+function(x, name = make.names(deparse(substitute(x))), ...) {
+ # Run the test for the 'test' attribute of this object
+ Test <- test(x)
+ if (is.null(Test) || !inherits(Test, "svTest"))
+ Test <- svTest(function () DEACTIVATED("Object has no tests!"))
+ return(runTest(Test, name = name, ...))
+}
+
+runTest.svTest <-
+function(x, name = make.names(deparse(substitute(x))), ...) {
+ # Make a test unit with the test data
+ Unit <- makeUnit(x, name = name, ...)
+ if (is.null(Unit)) return(NULL) # No tests to run!
+ # Make sure that the temporary test unit file is destroyed when done
+ on.exit(unlink(Unit))
+
+ # Run the tests now
+ res <- runUnit(name = name, dirs = dirname(Unit), ...)
+ return(res)
+}
Added: pkg/svUnit/R/svUnit.R
===================================================================
--- pkg/svUnit/R/svUnit.R (rev 0)
+++ pkg/svUnit/R/svUnit.R 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,245 @@
+svUnit <-
+function (tests) {
+ # Check provided tests and build a 'svUnit' object
+ tests <- as.character(tests)
+ # Remove NAs and empty strings ("") from tests
+ tests <- tests[!is.na(tests) & !(tests == "")]
+ if (length(tests) > 0) {
+ # Tests must be character strings like:
+ # * package:PKG
+ # * package:PKG (TESTSUITE)
+ # * dir:MYDIR
+ # * test(OBJ) where OBJ is any object with a 'test' attribute
+ # * OBJ being a 'svTest' object (with non "exotic" name!),
+ # Syntax is checked, but not the existence/validity of corresponding tests!
+ check1 <- (regexpr("^package:[a-zA-Z._]+$", tests) > -1)
+ check2 <- (regexpr("^package:[a-zA-Z._]+ *\\(.+\\)$", tests) > -1)
+ check3 <- (regexpr("^dir:.+", tests) > -1)
+ check4 <- (regexpr("^test\\(.+\\)$", tests) > -1)
+ check5 <- (regexpr("^[a-zA-Z0-9_.]+$", tests) > -1)
+ wrong <- ((check1 + check2 + check3 + check4 + check5) == 0)
+ if (any(wrong))
+ stop("Wrong 'test' data: must be 'package:PKG', 'package:PKG (SUITE)',\n'dir:MYDIR', 'test(OBJ)' or 'OBJ'")
+ }
+ class(tests) <- "svUnit"
+ return(tests)
+}
+
+as.svUnit <-
+function (x)
+ return(svUnit(x))
+
+is.svUnit <-
+function (x)
+ return(inherits(x, "svUnit"))
+
+print.svUnit <-
+function (x, ...) {
+ if (!is.svUnit(x))
+ stop("'x' must be a 'svUnit' object")
+ if (length(x) < 1) {
+ cat("An empty svUnit test suite\n")
+ } else {
+ cat("A svUnit test suite definition with:\n")
+ # Separate unit tests from tests embedded in objects
+ isSuite <- regexpr("^[package:|dir:]", x) > -1
+ if (any(isSuite)) {
+ Suites <- x[isSuite]
+ msg <- ifelse (length(Suites) == 1, "\n- Test suite:\n",
+ "\n- Test suites:\n")
+ cat(msg)
+ print(Suites)
+ }
+
+ if (any(!isSuite)) {
+ Objs <- x[!isSuite]
+ msg <- ifelse (length(Objs) == 1, "\n- Test function:\n",
+ "\n- Test functions:\n")
+ cat(msg)
+ print(Objs)
+ }
+ }
+ return(invisible(x))
+}
+
+svUnitList <-
+function (packages = TRUE, objects = TRUE, pos = .GlobalEnv) {
+ # List unit test (1) in loaded packages and (2) in objects in pos
+ # Note: Komodo should list test files in loaded projects too!
+ if (length(packages) < 1)
+ stop("'package' cannot have zero length")
+ if (length(objects) < 1)
+ stop("'objects' cannot have zero length")
+
+ items <- character()
+
+ # 1) Unit test files in loaded packages
+ if (packages[1] != FALSE) {
+ if (is.character(packages)) { # We assume it is a list of packages
+ Pkgs <- packages
+ } else { # We use the list of all loaded packages
+ Pkgs <- .packages()
+ }
+ for (Pkg in Pkgs) {
+ path <- system.file(package = Pkg, "unitTests")
+ if (path != "" && file.info(path)$isdir) {
+ pkgname <- paste("package", Pkg, sep = ":")
+ items <- c(items, pkgname)
+ Files <- list.files(path = path, full.names = TRUE)
+ for (File in Files) { # Add all subdirectories too
+ if (file.info(File)$isdir)
+ items <- c(items, paste(pkgname, " (", basename(File),
+ ")", sep = ""))
+ }
+ }
+ }
+ }
+
+ # 2) Test embedded in objects located in 'pos' environment
+ if (objects[1] != FALSE) {
+ envir = as.environment(pos)
+ if (is.character(objects)) {
+ tests <- character()
+ for (Oname in objects) {
+ if (exists(Oname, envir = envir, inherits = FALSE)) {
+ Obj <- get(Oname, envir = envir, inherits = FALSE)
+ if (is.svTest(Obj)) {
+ tests <- c(tests, Oname)
+ } else if (is.test(Obj)) {
+ tests <- c(tests, paste("test(", Oname, ")", sep = ""))
+ }
+ }
+ }
+ } else { # We list all objects in pos
+ Objs <- mget(ls(envir = envir), envir = envir)
+ Onames <- names(Objs)
+ tests <- character()
+ if (length(Objs) > 0) {
+ for (i in 1:length(Objs)) {
+ if (is.svTest(Objs[[i]])) {
+ tests <- c(tests, Onames[i])
+ } else if (is.test(Objs[[i]])) {
+ tests <- c(tests, paste("test(", Onames[i], ")", sep = ""))
+ }
+ }
+ }
+ }
+ items <- c(items, sort(tests))
+ }
+ # Make it a 'svUnit' object
+ class(items) <- "svUnit"
+ return(items)
+}
+
+makeUnit.svUnit <-
+function(x, name = make.names(deparse(substitute(x))), dir = tempdir(),
+pos = .GlobalEnv, ...) {
+ # Take an 'svUnit' object and make a unit from its function tests
+ # It is saved in a file runit.<name>.R in 'dir'
+ if (!is.svUnit(x))
+ stop("'x' must be a 'svUnit' object")
+ name <- as.character(name[1])
+ dir <- as.character(dir[1])
+ # Check that dir exists (do not create it!)
+ if (!file.exists(dir) || !file.info(dir)$isdir)
+ stop("'dir' must be an existing directory")
+
+ # Collect all items that are not 'package:...' or 'dir:...'
+ isObj <- regexpr("^[package:|dir:]", x) == -1
+ Objs <- sub("^test[(](.+)[)]$", "\\1", x[isObj])
+ if (length(Objs) == 0) {
+ # No objects, return NULL
+ return(NULL)
+ }
+
+ Unit <- file.path(dir, paste("runit", name, "R", sep = "."))
+ cat("# Test unit '", name, "'\n", sep = "", file = Unit)
+
+ # Collect all tests from Objs together in the test unit
+ # We provide the name of objects located in 'pos' environment
+ for (objname in Objs) {
+ if (regexpr("^test\\.", objname) > -1) testname <- objname else
+ testname <- paste("test", objname, sep = ".")
+ testname <- make.names(testname)
+ cat('\n"', testname, '" <-\n', sep = "", file = Unit, append = TRUE)
+ if (!exists(objname, where = pos)) {
+ # Create a dummy test with DEACTIVATED entry
+ body <- c(
+ 'function() {',
+ paste('\tDEACTIVATED("Object', objname, 'not found!")'),
+ '}\n')
+ } else {
+ Test <- test(get(objname, pos = pos))
+ if (is.null(Test)) {
+ # Create a dummy test with DEACTIVATED entry
+ body <- c(
+ 'function() {',
+ paste('\tDEACTIVATED("Object', objname, 'has no tests!")'),
+ '}\n')
+ } else {
+ capture.body <-
+ function(Data) {
+ rval <- NULL
+ File <- textConnection("rval", "w", local = TRUE)
+ sink(File)
+ on.exit({ sink(); close(File) })
+ dput(Data, file = File, control = "useSource")
+ on.exit()
+ sink()
+ close(File)
+ return(rval)
+ }
+ body <- capture.body(Test)
+ }
+ }
+ cat(body, sep = "\n", file = Unit, append = TRUE)
+ }
+ return(Unit)
+}
+
+runTest.svUnit <-
+function(x, name = make.names(deparse(substitute(x))), ...) {
+ # Compile and run the test for this 'svUnit' object
+ if (!is.svUnit(x))
+ stop("'x' must be a 'svUnit' object")
+ name <- as.character(name[1])
+
+ # Decode tests contained in x
+ tests <- as.character(x)
+ dirs <- character()
+ # Package suites...
+ isPkg <- regexpr("^package:", tests) > -1
+ if (any(isPkg)) {
+ Pkgs <- tests[isPkg]
+ Subdirs <- sub("^.+[(](.+)[)] *$", "\\1", Pkgs)
+ Subdirs[Subdirs == Pkgs] <- ""
+ Pkgs <- sub("^package:([^ ]+).*$", "\\1", Pkgs)
+ for (i in 1:length(Pkgs)) {
+ dir <- system.file(package = Pkgs[i], "unitTests", Subdirs[i])
+ if (dir != "") dirs <- c(dirs, dir)
+ }
+ }
+
+ # Add directories, and possibly make a temporary unit for test objects
+ if (any(!isPkg)) {
+ tests <- tests[!isPkg]
+ # Directories
+ isDir <- regexpr("^dir:", tests) > -1
+ if (any(isDir))
+ dirs <- c(dirs, sub("^dir:", "", tests[isDir]))
+ # Objects
+ if (any(!isDir)) {
+ # make a temporary unit for the tests of these objects
+ if (!is.null(Unit <- makeUnit(x, name = name))) {
+ # Add this path to dirs, and make sure that the temporary file
+ # is destroyed at the end
+ dirs <- c(dirs, dirname(Unit))
+ on.exit(unlink(Unit))
+ }
+ }
+ }
+
+ # Run these tests now
+ res <- runUnit(name = name, dirs = dirs)
+ return(invisible(res))
+}
Added: pkg/svUnit/TODO
===================================================================
--- pkg/svUnit/TODO (rev 0)
+++ pkg/svUnit/TODO 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,40 @@
+= svUnit To Do list
+
+* Install SciViews-K Unit Komodo extension
+
+* Mean to save and load vUnit objects; also automatically load concerned packages
+
+* Output results in wiki format
+
+* butler: benchmark and profiling => check it
+
+* Split example test into smaller test functions
+
+* Make a vignette (and perhaps a demo) for this package
+
+* Translate this package
+
+* In RUnit/share/R, there are checkCode.r and compareRUnitTestData.r. The former
+ provides functions for test R code in R files, the latter does a comparison of
+ timings in two test set runs, using a tolerance value. Worth checking and
+ integrating later on!
+
+* In RUnit: checkException() -> get silent argument value from
+ getOption("RUnit.silent")
+
+* In RUnit, make a CheckWarning() function
+
+* In RUnit: one bug is reported on RUnit SourceForge area for RUnit 0.4.17.
+ Follow this to make sure it is corrected (or work on a patch!)
+
+ myfun <- function(a, b = 98, c = 99){
+ cat("a = ", a, ", b = ", b, ", c = ", c, "\n")
+ }
+ myfun(1, c = 2)
+ # So far so good. Now let's inspect myfun:
+
+ library(RUnit)
+ track <- tracker()
+ track$init()
+ inspect(myfun(1, c = 2), track = track)
+ # Here, we see that myfun is calld with argument not matched by names!
Added: pkg/svUnit/inst/CITATION
===================================================================
--- pkg/svUnit/inst/CITATION (rev 0)
+++ pkg/svUnit/inst/CITATION 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,22 @@
+citHeader("To cite SciViews-R in publications use:")
+
+citEntry(entry="Manual",
+ title = "SciViews-R: A GUI API for R",
+ author = "Philippe Grosjean",
+ organization = "UMH",
+ address = "Mons, Belgium",
+ year = version$year,
+ url = "http://www.sciviews.org/SciViews-R",
+
+ textVersion =
+ paste("Grosjean, Ph. (", version$year, "). ",
+ "SciViews: A GUI API for R. ",
+ "UMH, Mons, Belgium. ",
+ "URL http://www.sciviews.org/SciViews-R.",
+ sep="")
+ )
+
+citFooter("We have invested a lot of time and effort in creating SciViews-R,",
+ "please cite it when using it together with R.",
+ "See also", sQuote("citation()"),
+ "for citing R.")
Added: pkg/svUnit/inst/unitTests/VirtualClass/runit.VirtualClass.R
===================================================================
--- pkg/svUnit/inst/unitTests/VirtualClass/runit.VirtualClass.R (rev 0)
+++ pkg/svUnit/inst/unitTests/VirtualClass/runit.VirtualClass.R 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,118 @@
+# runit.VirtualClass.R test suite
+# Just one example take from RUnit
+
+# --- Test setup ---
+
+if (FALSE) {
+ # Not really needed, but can be handy when writing tests
+ library("RUnit")
+ library("testRUnit")
+}
+
+# package 'methods' is usually loaded, but make sure it is
+checkTrue(require(methods))
+
+# Define class (not exported yet by the program, and defined in .GlobalEnv!)
+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 at 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 at x <- value
+ return(object)
+ }, where = .GlobalEnv)
+
+
+# --- Test functions ---
+
+.setUp <- function() {
+ # Executed before each test function
+}
+
+.tearDown <- function() {
+ # Executed after each test function
+}
+
+test.createClass <- function() {
+ setClass("A", contains = "numeric", where = .GlobalEnv)
+ a <- new("A")
+ checkTrue(validObject(a))
+ removeClass("A", where = .GlobalEnv) # Better to use on.exit() here!
+ checkException(new("A"))
+}
+
+testMyVirtualBaseClass.getX <- function() {
+ 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() {
+ 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))
+}
Added: pkg/svUnit/inst/unitTests/runit.svTest.R
===================================================================
--- pkg/svUnit/inst/unitTests/runit.svTest.R (rev 0)
+++ pkg/svUnit/inst/unitTests/runit.svTest.R 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,82 @@
+# runit.svTest.R test suite
+# by Ph. Grosjean <phgrosjean at sciviews.org>
+# run it simply by example(unitTests.svUnit)
+
+.setUp <- function () {
+ # Executed before each test function
+ # ... your code here
+}
+
+.tearDown <- function () {
+ # Executed after each test function
+ # ... your code here
+}
+
+test.svTest <- function () {
+ # An R object
+ mat <- matrix(rnorm(4), ncol = 2)
+ # An example function
+ foo <- function(x) return(x)
+
+ checkTrue(!is.test(mat), "No associated test cases to 'mat'") #1
+ checkTrue(!is.test(foo), "No associated test cases to 'foo'") #2
+ checkTrue(is.null(test(foo)), "Return NULL if no test cases") #3
+ checkTrue(!is.test(test(foo)), "No 'svTest' object if no test cases") #4
+ checkTrue(!is.test(mat), "This is not a 'svTest' object (1)") #5
+ checkTrue(!is.test(foo), "This is not a 'svTest' object (2)") #6
+ checkTrue(!is.svTest(foo), "This is not a 'svTest' object (3)") #7
+ checkTrue(!is.test("x"), "This is not a 'svTest' object (4)") #8
+ checkTrue(!is.test(NULL), "This is not a 'svTest' object (5)") #9
+ checkTrue(!is.test(NA), "This is not a 'svTest' object (6)") #10
+
+ # Create very simple test cases for matrix 'mat' and function 'foo'
+ test.mat <- svTest(function () {
+ checkEqualsNumeric(nrow(mat), 2)
+ checkTrue(is.numeric(mat))
+ })
+
+ test.foo <- function () {
+ checkEqualsNumeric(foo(2), 2)
+ checkException(foo("xx"))
+ }
+
+ checkTrue(is.test(svTest(test.foo)), "Creation of a 'svTest' object") #11
+ checkTrue(is.test(as.svTest(test.foo)), "Coercion to a 'svTest' object") #12
+ checkException(svTest(foo), "Functions with arguments not allowed") #13
+ checkException(svTest("x"), "Strange argument to svTest") #14
+
+ # Add test cases to an object
+ test(mat) <- test.mat
+
+ checkTrue(is.test(mat), "'mat' has associated test cases") #15
+ checkIdentical(test(mat), test.mat, "test of 'mat' identical to 'test.mat'")#16
+ checkTrue(is.test(test.mat), "Is this a 'svTest' object (1)?") #17
+ checkTrue(is.svTest(test.mat), "Is this a 'svTest' object (2)?") #18
+
+
+ # Use a function as test
+ test(foo) <- test.foo
+
+ checkTrue(has.test(foo), "'foo' has associated test cases") #19
+ checkEquals(test(foo), svTest(test.foo), "test of 'foo' equals 'test.foo'") #20
+ checkTrue(!is.test(test.foo), "Is this a 'svTest' object (3)?") #21
+ checkTrue(is.svTest(test.foo), "Is this a 'svTest' object (4)?") #22
+
+
+ # Transform into a svTest object and use it as test
+ test.foo <- as.svTest(test.foo)
+ test(foo) <- test.foo
+
+ checkIdentical(test(test.foo), test.foo, "'test' returns a 'svTest' object") #23
+ checkTrue(is.test(test.foo), "Is this a 'svTest' (5)?") #24
+ checkTrue(is.test(foo), "'foo' has associated test cases") #25
+ checkIdentical(test(foo), test.foo, "test of 'foo' identical to 'test.foo'")#26
+
+ checkException(test(foo) <- "x", "Strange value to assign as 'test'") #27
+ checkException(test(foo) <- function(y) y, "Try assign a function with arguments") #28
+
+ # Strange,... but allowed
+ test(test.foo) <- test.foo
+
+ checkIdentical(test(test.foo), test.foo, "Assigning test to oneself") #29
+}
Added: pkg/svUnit/inst/unitTests/runit.svUnit.R
===================================================================
--- pkg/svUnit/inst/unitTests/runit.svUnit.R (rev 0)
+++ pkg/svUnit/inst/unitTests/runit.svUnit.R 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,51 @@
+# runit.unitFunctions.R test suite
+# by Ph. Grosjean <phgrosjean at sciviews.org>
+# run it simply by example(unitTests.svUnit)
+
+.setUp <- function () {
+ # Executed before each test function
+ # ... your code here
+}
+
+.tearDown <- function () {
+ # Executed after each test function
+ # ... your code here
+}
+
+test.svUnit <- function () {
+ checkTrue(is.svUnit(svUnitList()), "svUnitList() returns a 'svUnit' object")#1
+ checkTrue("package:svUnit" %in% svUnitList(), "svUnitList() lists 'svUnit' package") #2
+ checkTrue("package:svUnit (VirtualClass)" %in% svUnitList(), "svUnitList() lists 'VirtualClass' suite") #3
+
+ # Create a 'svTest' object and another object containing a test in .GlobalEnv
+ test.R <<- svTest(function () {
+ checkTrue(1 < 2)
+ })
+
+ foo <- function(x) return(x)
+ test(foo) <- function () {
+ checkEqualsNumeric(foo(2), 2)
+ checkException(foo("xx"))
+ }
+ Foo <<- foo # Place a copy of 'foo' in .GlobalEnv
+
+ checkTrue("test.R" %in% svUnitList(), "svUnitList() lists 'svTest' objects") #4
+ checkTrue("test(Foo)" %in% svUnitList(), "svUnitList() lists objects with tests") #5
+ rm(foo)
+ rm(test.R, Foo, pos = .GlobalEnv)
+}
+
+test.runTest <- function () {
+ # A simple svTest object
+ test.R <- svTest(function () {
+ checkTrue(1 < 2)
+ })
+ checkTrue(inherits(runTest(test.R), "svUnitData"), "result of runTest(svTest) is svUnitData") #1
+
+ ### TODO: more tests!
+ rm(test.R)
+}
+
+test.unitErrorClear <- function() {
+ ### TODO: tests for unitError() and unitClear()
+}
\ No newline at end of file
Added: pkg/svUnit/man/runUnit.Rd
===================================================================
--- pkg/svUnit/man/runUnit.Rd (rev 0)
+++ pkg/svUnit/man/runUnit.Rd 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,75 @@
+\name{runUnit}
+\alias{runUnit}
+\alias{unitClear}
+\alias{unitError}
+\alias{print.svUnitData}
+\alias{summary.svUnitData}
+
+\title{ Compile and run a complete test unit }
+\description{
+ Compile a test unit and run it silently. Increment counters for errors,
+ failings, and deactivated items. Manage the errors and warnings in a
+ different depending if we run in interactive mode, or not (R CMD check). In
+ this last case, make sure to break checking of package in case of errors or
+ failings, but not otherwise.
+}
+
+\usage{
+runUnit(name, dirs, print.errors = !interactive(), warn = print.errors,
+ rngKind = "Marsaglia-Multicarry", rngNormalKind = "Kinderman-Ramage")
+
+unitClear()
+unitError(errors = TRUE, failures = TRUE, deactivated = TRUE, stopit = TRUE)
+
+\method{print}{svUnitData}(x, \dots)
+\method{summary}{svUnitData}(object, \dots)
+}
+
+\arguments{
+ \item{name}{ The name of the test suite to build and run }
+ \item{dirs}{ The directories where to look for \code{runit*.R} test files.
+ These test files must be sourceable and must contain one or more
+ \code{test.*()} functions implementing the different tests }
+ \item{print.errors}{ Do we print explicit messages for each error of failing? }
+ \item{warn}{ Do we issue a warning if there are deactivated items? }
+ \item{rngKind}{ Name of a valid RNG version (see \code{RNGkind}) }
+ \item{rngNormalKind}{ Name of a valid rnorm RNG version (see \code{RNGkind}) }
+ \item{errors}{ If \code{TRUE}, check if there where errors in any test of all
+ test suites run since last \code{unitClear()} }
+ \item{failures}{ If \code{TRUE}, check if there where failures in any test of
+ all test suites run since last \code{unitClear()} }
+ \item{deactivated}{ If \code{TRUE}, check if there where deactivated tests in
+ any test suites run since last \code{unitClear()} }
+ \item{stopit}{ Do we stop execution of the code in case of any detected error
+ or failure? }
+ \item{x}{ A 'svUnitData' object to print }
+ \item{object}{ A 'svUnitData' object to summarize }
+ \item{\dots}{ Not used for\code{summary()} }
+}
+
+\value{
+ \code{unitRun()} returns an object of class 'svUnitData', similar to
+ 'RUnitTestData' in the RUnit package with all results from the tests run.
+
+ \code{unitClear()} returns a list with the number of errors (nErr) and the
+ number of deactivated tests (nDeactivated) and the number of failures (nFail)
+ invisibly. The function is called for its side effect of clearing these counters.
+
+ \code{unitError()} returns \code{TRUE} if there are any errors and/or failures
+ recorded in the global counters. This function is useful for integrating your
+ test units with the "R CMD check" mechanism of checking R packages (see the
+ manual "Writing R extensions"). Just create an example that run all the test
+ suites you want to integrate, and then, finish your example with
+ \code{unitError()}. See \code{?unitTests.svUnit} for an example.
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{svTest}}, \code{\link{svUnit}},
+ \code{\link[RUnit]{defineTestSuite}} }
+
+\examples{
+### TODO...
+}
+
+\keyword{ utilities }
Added: pkg/svUnit/man/svTest.Rd
===================================================================
--- pkg/svUnit/man/svTest.Rd (rev 0)
+++ pkg/svUnit/man/svTest.Rd 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,111 @@
+\name{svTest}
+\alias{svTest}
+\alias{as.svTest}
+\alias{is.svTest}
+\alias{test}
+\alias{test<-}
+\alias{is.test}
+\alias{makeUnit}
+\alias{makeUnit.default}
+\alias{makeUnit.svTest}
+\alias{runTest}
+\alias{runTest.default}
+\alias{runTest.svTest}
+
+\title{ Create, attach to and manipulate test functions in R objects }
+\description{
+ Test functions are functions without arguments with class 'svTest' containing
+ one or more assertions using \code{checkXXX()} functions from RUnit (see
+ examples). They can be attached to any object as a 'test' attribute, written
+ to unit files or run.
+}
+
+\usage{
+svTest(testFun)
+as.svTest(x)
+is.svTest(x)
+
+test(x)
+test(x) <- value
+is.test(x)
+
+makeUnit(x, \dots)
+\method{makeUnit}{default}(x, name = make.names(deparse(substitute(x))),
+ dir = tempdir(), \dots)
+\method{makeUnit}{svTest}(x, name = make.names(deparse(substitute(x))),
+ dir = tempdir(), \dots)
+
+runTest(x, \dots)
+\method{runTest}{default}(x, name = make.names(deparse(substitute(x))), \dots)
+\method{runTest}{svTest}(x, name = make.names(deparse(substitute(x))), \dots)
+}
+
+\arguments{
+ \item{testFun}{ A function without arguments defining assertions for tests to
+ be transformed into a 'svTest' object }
+ \item{x}{ Any kind of object }
+ \item{value}{ The tests to place in the object (as 'test' attribute).
+ Could be a 'svTest' object, or a function without arguments with assertions
+ (\code{checkXXX()} functions) }
+ \item{name}{ The name of a test unit }
+ \item{dir}{ The directory where to create a test unit }
+ \item{\dots}{ Further arguments to the method (not used yet) }
+}
+
+\value{
+ A 'svTest' object for \code{svTest()}, \code{as.svTest()}
+ and \code{test()}. Function \code{is.svTest()} returns \code{TRUE} if 'x' is
+ a 'svTest' object, and \code{is.test()} does the same but also looks in the
+ 'test' attribute if the class of 'x' is not 'svTest' and returns \code{TRUE}
+ if it finds something there.
+
+ \code{makeUnit()} takes an object, extract its test function and write it in
+ a sourceable test unit on the disk. RUnit functions need such files.
+
+ \code{runTest()} returns a 'svUnitData' object identical (for the moment) to
+ the 'RUnitTestData' objects returned by \code{runTestSuite()} in package
+ RUnit.
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{svUnit}}, \code{\link{runUnit}},
+ \code{\link[RUnit]{checkTrue}}, \code{\link[RUnit]{runTestSuite}} }
+
+\examples{
+foo <- function(x, y = 2) return(x * y)
+is.test(foo) # No
+# Create test cases for this function
+test(foo) <- function () {
+ checkEqualsNumeric(foo(2), 4)
+ checkEqualsNumeric(foo(2, 3), 6)
+ checkTrue(is.test(foo))
+ checkTrue(is.test(test(foo)))
+ checkIdentical(test(foo), attr(foo, "test"))
+ checkException(foo(2, "aa"))
+ checkException(foo("bb"))
+}
+is.test(foo) # Yes
+
+\dontrun{
+# Create a test unit on disk and view it
+unit <- makeUnit(foo)
+file.show(unit, delete.file = TRUE)
+}
+
+# Run the test
+(runTest(foo))
+# Same as
+bar <- test(foo)
+(runTest(bar))
+
+is.svTest(test(foo)) # Yes, of course!
+# When an object without associated test is passed to runTest(), a simple
+# test containing only a DEACTIVATED entry is build
+x <- 1:10
+summary(runTest(x))
+
+rm(foo, bar, x)
+}
+
+\keyword{ utilities }
Added: pkg/svUnit/man/svUnit.Rd
===================================================================
--- pkg/svUnit/man/svUnit.Rd (rev 0)
+++ pkg/svUnit/man/svUnit.Rd 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,131 @@
+\name{svUnit}
+\alias{svUnit}
+\alias{as.svUnit}
+\alias{is.svUnit}
+\alias{svUnitList}
+\alias{print.svUnit}
+\alias{makeUnit.svUnit}
+\alias{runTest.svUnit}
+
+\title{ Create and run test units by collecting together RUnit tests and tests
+ defined in objects }
+\description{
+ A 'svUnit' object is essentially a list of test units directories, and of
+ object names containing tests to add to the test unit. These must be formatted
+ in a concise way as described for the 'tests' argument.
+
+ \code{svUnitList()} lists all loaded packages having /unitTests/runit*.R files
+ (or similar files in subdirectories), and all objects in the user workspace
+ that have a 'test' attribute, or are 'svTest' objects (by default). It is a
+ rather exhaustive list of all test items currently available in this session.
+
+ \code{makeUnit()} writes a test unit on disk with the tests from the objects
+ lised in 'svUnit'. \code{runTest()} runs all the test in packages, directories
+ and objects listed in the 'svUnit' object.
+}
+
+\usage{
+svUnit(tests)
+
+as.svUnit(x)
+is.svUnit(x)
+
+svUnitList(packages = TRUE, objects = TRUE, pos = .GlobalEnv)
+
+\method{print}{svUnit}(x, \dots)
+\method{makeUnit}{svUnit}(x, name = make.names(deparse(substitute(x))),
+ dir = tempdir(), pos = .GlobalEnv, \dots)
+\method{runTest}{svUnit}(x, name = make.names(deparse(substitute(x))), \dots)
+}
+
+\arguments{
+ \item{tests}{ A character string with items to include in the test suite.
+ It could be 'package:PKG' for including test units located in the /unitTests
+ subdirectory of the package PGK, or 'package:PKG (SUITE)' for test units
+ located in the subdirectory /unitTests/SUITE of package PKG, or 'dir:MYDIR'
+ for including test units in MYDIR, or 'test(OBJ)' for tests embedded in an
+ object, or 'OBJ' for 'svTest' object directly }
+ \item{x}{ Any kind of object }
+ \item{packages}{ Do we list test units available in loaded packages?
+ Alternatively one can provide a character vector of package names, and it
+ will be used to filter packages (take care: in this case it will look at
+ installed packages, not only loaded packages!) }
+ \item{objects}{ Do we list test available in objects? Alternatively, one can
+ provide a character vector of object names, and it will filter objects in
+ 'pos' according to this vector }
+ \item{pos}{ The environment to look for 'objects' (environment, character
+ string with name of an environment, or interger with position of the
+ environment in the search path }
+ \item{\dots}{ Further arguments to pass to \code{makeUnit()} and
+ \code{defineTestsuite()} from the RUnit package }
+ \item{name}{ The name of the test suite to build. }
+ \item{dir}{ The directory where to create the test unit file }
+}
+
+\value{
+ \code{svUnit()}, \code{as.svUnit()} and \code{svUnitList} return a 'svUnit'
+ object. \code{is.svUnit()} returns \code{TRUE} if the object is an 'svUnit'.
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{runUnit}}, \code{\link{svTest}},
+ \code{\link[RUnit]{defineTestSuite}} }
+
+\examples{
+svUnitList() # List all currently available test units and test cases
+
+# Two functions that include their test cases
+Square <- function(x) return(x^2)
+test(Square) <- function() {
+ checkEquals(Square(3), 9)
+ checkEquals(Square(1:3), c(1, 4, 9))
+ checkException(Square("xx"))
+}
+
+Cube <- function(x) return(x^3)
+test(Cube) <- function() {
+ checkEquals(Cube(3), 27)
+ checkEquals(Cube(1:3), c(1, 8, 28))
+ checkException(Cube("xx"))
+}
+
+# A separate test case object
+test.R <- svTest(function() {
+ checkTrue(1 < 2, "check1")
+ v <- 1:3
+ w <- 1:3
+ checkEquals(v, w)
+})
+
+# A function without test cases
+foo <- function(x) return(x)
+
+# Look now what tests are available
+svUnitList()
+
+# Only objects, no package units
+svUnitList(packages = FALSE)
+
+\dontrun{
+# Create the test unit file for the objects
+unit <- makeUnit(svUnitList(), name = "AllTests")
+file.show(unit, delete.file = TRUE)
+}
+
+# Filter objects using a list
+svUnitList(objects = c("foo", "bar"))
+
+# Create another svUnit object with selected test items
+(myunit <- svUnit(c("package:svUnit (VirtualClass)", "test(foo)")))
+is.svUnit(myunit) # Should be!
+
+\dontrun{
+# Run all the tests
+summary(runTest(svUnitList(), name = "AllTests"))
+}
+
+rm(Square, Cube, foo, test.R, myunit, unit)
+}
+
+\keyword{ utilities }
Added: pkg/svUnit/man/unitTests.Rd
===================================================================
--- pkg/svUnit/man/unitTests.Rd (rev 0)
+++ pkg/svUnit/man/unitTests.Rd 2008-06-11 23:13:08 UTC (rev 9)
@@ -0,0 +1,42 @@
+\name{unitTests}
+\alias{unitTests.svUnit}
+
+\title{ Unit tests for the package svUnit }
+\description{
+ Performs unit tests defined in this package by running
+ \code{example(unitTests.svUnit)}. Tests are in \code{runit*.R} files located
+ in the '/unitTests' subdirectory or one of its subdirectories ('/inst/unitTests'
+ and subdirectories in package sources).
+}
+
+\author{Philippe Grosjean (\email{phgrosjean at sciviews.org})}
+
+\examples{
+# Make sure to clear log of errors and failures first
+unitClear()
+
+# Run all test units defined in the 'svUnit' package
+(runTest(svUnit("package:svUnit"), "svUnit"))
+
+\donttest{
+# Tests to run with example() but not with R CMD check
+# Run all test units defined in the /unitTests/VirtualClass subdir of 'svUnit'
+(runTest(svUnit("package:svUnit (VirtualClass)"), "VirtualClass"))
+}
+
+\dontrun{
+# Tests to present in ?unitTests.svUnit but to never run automatically
+# Run all currently loaded test cases and test suites of all loaded packages
+(runTest(svUnitList(), "AllTests"))
+}
+
+\dontshow{
+# Put here test units you want to run during R CMD check but don't want to show
+# or run with example(unitTests.svUnit)
+}
+
+# Check errors at the end of the process (needed for R CMD check)
+unitError()
+}
+
+\keyword{utilities}
More information about the Sciviews-commits
mailing list