[Sciviews-commits] r284 - in pkg/svUnit: . R inst inst/doc inst/komodo inst/unitTests inst/unitTests/VirtualClass man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Sep 4 11:03:19 CEST 2010
Author: phgrosjean
Date: 2010-09-04 11:03:19 +0200 (Sat, 04 Sep 2010)
New Revision: 284
Modified:
pkg/svUnit/DESCRIPTION
pkg/svUnit/NEWS
pkg/svUnit/R/Log.R
pkg/svUnit/R/check.R
pkg/svUnit/R/guiTestReport.R
pkg/svUnit/R/koUnit.R
pkg/svUnit/R/svSuite.R
pkg/svUnit/R/svSuiteData.R
pkg/svUnit/R/svTest.R
pkg/svUnit/R/svTestData.R
pkg/svUnit/R/svUnit-internal.R
pkg/svUnit/TODO
pkg/svUnit/inst/CITATION
pkg/svUnit/inst/doc/svUnit.Rnw
pkg/svUnit/inst/doc/svUnit.lyx
pkg/svUnit/inst/doc/svUnit.pdf
pkg/svUnit/inst/komodo/sciviewskunit-ko.xpi
pkg/svUnit/inst/unitTests/VirtualClass/runitVirtualClass.R
pkg/svUnit/inst/unitTests/runitsvSuite.R
pkg/svUnit/inst/unitTests/runitsvTest.R
pkg/svUnit/man/Log.Rd
pkg/svUnit/man/check.Rd
pkg/svUnit/man/guiTestReport.Rd
pkg/svUnit/man/koUnit.Rd
pkg/svUnit/man/svSuite.Rd
pkg/svUnit/man/svSuiteData.Rd
pkg/svUnit/man/svTest.Rd
pkg/svUnit/man/svTestData.Rd
pkg/svUnit/man/svUnit-package.Rd
pkg/svUnit/man/unitTests.Rd
Log:
Correction of a bug that sometimes prevented svUnit to load (during checking of the SciViews-K Unit plugin in Komodo Edit/IDE)
Slight reworking of code and man pages
Modified: pkg/svUnit/DESCRIPTION
===================================================================
--- pkg/svUnit/DESCRIPTION 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/DESCRIPTION 2010-09-04 09:03:19 UTC (rev 284)
@@ -4,8 +4,8 @@
Depends: R (>= 1.9.0)
Suggests: svGUI, datasets, utils
Description: A complete unit test system and functions to implement its GUI part
-Version: 0.7-2
-Date: 2010-05-17
+Version: 0.7-3
+Date: 2010-09-03
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svUnit/NEWS
===================================================================
--- pkg/svUnit/NEWS 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/NEWS 2010-09-04 09:03:19 UTC (rev 284)
@@ -1,5 +1,11 @@
= svUnit News
+== svUnit 0.7-3
+
+* Loading of svUnit sometimes failed during checking of the SciViews-K Unit
+ plugin installation in Komodo Edit/IDE. Corrected. Thanks Claudia Beleites.
+
+
== svUnit 0.7-2
* Added a unitname argument in runTest.svSuite() to select one test unit
Modified: pkg/svUnit/R/Log.R
===================================================================
--- pkg/svUnit/R/Log.R 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/R/Log.R 2010-09-04 09:03:19 UTC (rev 284)
@@ -1,33 +1,31 @@
-"Log" <-
-function (description = NULL)
+Log <- function (description = NULL)
{
if (!exists(".Log", envir = .GlobalEnv, inherits = FALSE))
createLog(description = description)
return(get(".Log", envir = .GlobalEnv, inherits = FALSE))
}
-"createLog" <-
-function (description = NULL, deleteExisting = FALSE)
+createLog <- function (description = NULL, deleteExisting = FALSE)
{
- # Create a log consisting in an environment with class svSuiteData
+ ## Create a log consisting in an environment with class svSuiteData
if (isTRUE(deleteExisting) && exists(".Log", envir = .GlobalEnv,
inherits = FALSE)) rm(.Log, envir = .GlobalEnv)
if (!exists(".Log", envir = .GlobalEnv, inherits = FALSE)) {
.Log <<- structure(new.env(parent = .GlobalEnv),
class = c("svSuiteData", "environment"))
- # Add general informations and variables to it
+ ## Add general informations and variables to it
.Log$.time <- Sys.time() # Creation time of the log
.Log$.R.version <- R.version # R version
.Log$.sessionInfo <- sessionInfo() # Information about current session
.Log$.description <- description # Optional description of this log
- # Create ..xxx variables used for test context
- # Note: never delete or put NULL in these variables, use "" instead
+ ## Create ..xxx variables used for test context
+ ## Note: never delete or put NULL in these variables, use "" instead
.Log$..Unit <- ""
.Log$..Msg <- ""
.Log$..Obj <- ""
.Log$..File <- ""
.Log$..Tag <- ""
- # Create .lastTest that contains details from last check...()
+ ## Create .lastTest that contains details from last check...()
naChr <- as.character(NA)
.Log$.lastTest <- structure(
data.frame(msg = naChr, call = naChr,
@@ -35,13 +33,12 @@
obj = naChr, file = naChr, tag = naChr,
stringsAsFactors = FALSE),
class = c("svTestData", "data.frame"))
- # Create .lastSuite with an empty list of test units to run
+ ## Create .lastSuite with an empty list of test units to run
.Log$.lastSuite <- list()
}
}
-"clearLog" <-
-function ()
+clearLog <- function ()
{
if (exists(".Log", envir = .GlobalEnv, inherits = FALSE)) {
rm(list = ".Log", envir = .GlobalEnv)
@@ -49,8 +46,7 @@
} else return(invisible(FALSE))
}
-"errorLog" <-
-function (stopit = TRUE, summarize = TRUE)
+errorLog <- function (stopit = TRUE, summarize = TRUE)
{
.Log <- Log()
Res <- table(stats(.Log)$kind)
@@ -62,16 +58,14 @@
return(invisible(Res))
}
-"lastTest" <-
-function ()
+lastTest <- function ()
{
- # Return a svTestData object with data from last recorded test
+ ## Return a svTestData object with data from last recorded test
Log()$.lastTest
}
-"lastSuite" <-
-function ()
+lastSuite <- function ()
{
- # Return data about last suite run
+ ## Return data about last suite run
Log()$.lastSuite
}
Modified: pkg/svUnit/R/check.R
===================================================================
--- pkg/svUnit/R/check.R 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/R/check.R 2010-09-04 09:03:19 UTC (rev 284)
@@ -1,15 +1,14 @@
-# Define check...() functions in a way they are compatible with same functions
-# in the 'RUnit' package (these functions are directly inspired from those
-# in RUnit). Make version that are more compatible with Komodo/SciViews-K Unit)
+## Define check...() functions in a way they are compatible with same functions
+## in the 'RUnit' package (these functions are directly inspired from those
+## in RUnit). Make version that are more compatible with Komodo/SciViews-K Unit)
-"checkEquals" <-
-function (target, current, msg = "", tolerance = .Machine$double.eps^0.5,
- checkNames = TRUE, ...)
+checkEquals <- function (target, current, msg = "",
+tolerance = .Machine$double.eps^0.5, checkNames = TRUE, ...)
{
val <- FALSE
timing <- as.numeric(system.time({
ret <- try({
- # Run the test
+ ## Run the test
if (isTRUE(checkNames)) {
cn <- "" # Since this is the default value
} else {
@@ -25,14 +24,14 @@
val <- isTRUE(res)
}, silent = TRUE)
}, gcFirst = FALSE)[3])
- # Log this test
+ ## Log this test
test <- .logTest(timing)
- # Decide if recording more info or not
+ ## Decide if recording more info or not
minTiming <- getOption("svUnit.minTiming")
if (is.null(minTiming)) minTiming <- 0.1
if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
&& val) return(invisible(TRUE))
- # Check for error
+ ## Check for error
if (inherits(ret, "try-error")) {
val <- NA
.logTestData(test, msg = msg, call =
@@ -47,13 +46,13 @@
return(invisible(val))
}
-"checkEqualsNumeric" <-
-function (target, current, msg = "", tolerance = .Machine$double.eps^0.5, ...)
+checkEqualsNumeric <- function (target, current, msg = "",
+tolerance = .Machine$double.eps^0.5, ...)
{
val <- FALSE
timing <- as.numeric(system.time({
ret <- try({
- # Run the test
+ ## Run the test
if (!is.numeric(tolerance))
stop("tolerance has to be a numeric value")
if (length(tolerance) != 1)
@@ -63,14 +62,14 @@
val <- isTRUE(res)
}, silent = TRUE)
}, gcFirst = FALSE)[3])
- # Log this test
+ ## Log this test
test <- .logTest(timing)
- # Decide if recording more info or not
+ ## Decide if recording more info or not
minTiming <- getOption("svUnit.minTiming")
if (is.null(minTiming)) minTiming <- 0.1
if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
&& val) return(invisible(TRUE))
- # Check for error
+ ## Check for error
if (inherits(ret, "try-error")) {
val <- NA
.logTestData(test, msg = msg, call =
@@ -85,24 +84,23 @@
return(invisible(val))
}
-"checkIdentical" <-
-function (target, current, msg = "")
+checkIdentical <- function (target, current, msg = "")
{
val <- FALSE
timing <- as.numeric(system.time({
ret <- try({
- # Run the test
+ ## Run the test
val <- identical(target, current)
}, silent = TRUE)
}, gcFirst = FALSE)[3])
- # Log this test
+ ## Log this test
test <- .logTest(timing)
- # Decide if recording more info or not
+ ## Decide if recording more info or not
minTiming <- getOption("svUnit.minTiming")
if (is.null(minTiming)) minTiming <- 0.1
if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
&& val) return(invisible(TRUE))
- # Check for error
+ ## Check for error
if (inherits(ret, "try-error")) {
val <- NA
.logTestData(test, msg = msg, call =
@@ -116,27 +114,26 @@
return(invisible(val))
}
-"checkTrue" <-
-function (expr, msg = "")
+checkTrue <- function (expr, msg = "")
{
val <- FALSE
timing <- as.numeric(system.time({
ret <- try({
- # Run the test
+ ## Run the test
val <- isTRUE(all(expr == TRUE))
}, silent = TRUE)
}, gcFirst = FALSE)[3])
- # Log this test
+ ## Log this test
test <- .logTest(timing)
- # Decide if recording more info or not
+ ## Decide if recording more info or not
minTiming <- getOption("svUnit.minTiming")
if (is.null(minTiming)) minTiming <- 0.1
if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
&& val) return(invisible(TRUE))
- # Get call, without msg
+ ## Get call, without msg
call <- sys.call()
call <- deparse(call[names(call) != "msg"])
- # Check for error
+ ## Check for error
if (inherits(ret, "try-error")) {
val <- NA
.logTestData(test, msg = msg, call =
@@ -150,25 +147,25 @@
return(invisible(val))
}
-"checkException" <-
-function (expr, msg = "", silent = getOption("svUnit.silentException"))
+checkException <- function (expr, msg = "",
+silent = getOption("svUnit.silentException"))
{
val <- FALSE
timing <- as.numeric(system.time({
ret <- try({
- # Run the test
+ ## Run the test
silent <- (is.null(silent) || isTRUE(silent))
val <- inherits(res <- try(expr, silent = silent), "try-error")
}, silent = TRUE)
}, gcFirst = FALSE)[3])
- # Log this test
+ ## Log this test
test <- .logTest(timing)
- # Decide if recording more info or not
+ ## Decide if recording more info or not
minTiming <- getOption("svUnit.minTiming")
if (is.null(minTiming)) minTiming <- 0.1
if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
&& val) return(invisible(TRUE))
- # Check for error
+ ## Check for error
if (inherits(ret, "try-error")) {
val <- NA
.logTestData(test, msg = msg, call =
@@ -183,6 +180,5 @@
return(invisible(val))
}
-DEACTIVATED <-
-function (msg = "")
+DEACTIVATED <- function (msg = "")
stop(msg)
Modified: pkg/svUnit/R/guiTestReport.R
===================================================================
--- pkg/svUnit/R/guiTestReport.R 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/R/guiTestReport.R 2010-09-04 09:03:19 UTC (rev 284)
@@ -1,12 +1,11 @@
-"guiSuiteList" <-
-function (sep = "\t", path = NULL, compare = TRUE)
+guiSuiteList <- function (sep = "\t", path = NULL, compare = TRUE)
{
Suites <- svSuiteList()
if (compare) {
oldSuites <- .getTemp(".guiSuiteListCache", default = "")
- # Compare both versions
+ ## Compare both versions
if (!identical(Suites, oldSuites)) {
- # Keep a copy of the last version in TempEnv
+ ## Keep a copy of the last version in TempEnv
.assignTemp(".guiSuiteListCache", Suites)
Changed <- TRUE
} else Changed <- FALSE
@@ -29,12 +28,11 @@
}
}
-"guiSuiteAutoList" <-
-function (...)
+guiSuiteAutoList <- function (...)
{
- # Is koCmd() available?
+ ## Is koCmd() available?
if (!exists("koCmd", mode = "function")) return(TRUE)
- # Is it something changed in the unit list?
+ ## Is it something changed in the unit list?
res <- guiSuiteList(sep = ",", path = NULL, compare = TRUE)
if (!is.null(res))
ret <- get("koCmd")('sv.r.unit.getRUnitList_Callback("<<<data>>>");',
@@ -42,27 +40,25 @@
return(TRUE)
}
-"guiTestFeedback" <-
-function (object, path = NULL, ...)
+guiTestFeedback <- function (object, path = NULL, ...)
{
- # Give feedback to client about the currently running tests
- ### TODO: feedback about test run
+ ## Give feedback to client about the currently running tests
+ ## TODO: feedback about test run
}
-"guiTestReport" <-
-function (object, sep = "\t", path = NULL, ...)
+guiTestReport <- function (object, sep = "\t", path = NULL, ...)
{
- # Report the results of a test to the GUI client
+ ## Report the results of a test to the GUI client
if (!is.svSuiteData(object))
stop("'object' must be a 'svSuiteData' object")
- # For all 'svTestData' objects, create a table with test results for the GUI
- # Indicate global results of the Unit Test
+ ## For all 'svTestData' objects, create a table with test results for the GUI
+ ## Indicate global results of the Unit Test
Tests <- ls(object)
if (length(Tests) == 0) {
Res <- "<<<svUnitSummary>>>|||0|||0|||0|||0"
} else {
- # Get general information about the tests
+ ## Get general information about the tests
Stats <- stats(object)
Tests <- rownames(Stats) # To make sure we use the same!
Stats$label <- paste(">", sub("^test", "", Tests), " (",
@@ -73,11 +69,11 @@
Kinds <- as.numeric(Stats$kind)
Kinds[Kinds == 4] <- 0 # Use 0 instead of 4 for deactivated tests
Stats$kind <- Kinds
- # Get the type for the objects
+ ## Get the type for the objects
Units <- Stats$unit
Types <- rep("units in packages", length(Units))
Types[Units == ""] <- "other objects"
- ### TODO: include also dirs!
+ ## TODO: include also dirs!
Dir1 <- gsub("\\\\", "/", dirname(Units))
Dir2 <- dirname(Dir1)
Dir3 <- dirname(Dir2)
@@ -85,41 +81,41 @@
Types[Dir1 == TempDir] <- "objects in .GlobalEnv"
Types[tolower(basename(Dir2)) == "inst" ||
tolower(basename(Dir3)) == "inst"] <- "units in sources"
- # Keep only "*" in Units
+ ## Keep only "*" in Units
Units <- basename(Units)
Units[regexpr("^runit.+\\.[rR]$", Units) == -1] <- ""
- Units[Dir1 == TempDir] <- "" # No second level for objects in .GlobalEnv
+ Units[Dir1 == TempDir] <- "" # No second level for objects in .GlobalEnv
Units <- sub("^runit(.+)\\.[rR]$", "\\1", Units)
change <- Units != ""
Units[change] <- paste(">unit", Units[change])
- # Complete label is Type<Unit<Test (x.xxx sec)
+ ## Complete label is Type<Unit<Test (x.xxx sec)
Stats$label <- paste(Types, Units, Stats$label, sep = "")
- # Sort Tests and Stats according to label alphabetically
+ ## Sort Tests and Stats according to label alphabetically
ord <- order(Stats$label)
Stats <- Stats[ord, ]
Tests <- Tests[ord]
- # Get detailed information about each test
+ ## Get detailed information about each test
lastUnit <- ""
for (Test in Tests) {
Data <- Stats[Test, ]
- # Calculate Info
+ ## Calculate Info
tData <- Log()[[Test]]
tStats <- stats(tData)
Info <- paste(c("Pass:", "Fail:", "Errors:"), tStats$kind[1:3],
collapse = " ")
- # Don't print tests that succeed if !all
+ ## Don't print tests that succeed if !all
tData <- tData[tData$kind != "OK", ]
- # Get info about each individual filtered test
+ ## Get info about each individual filtered test
if (nrow(tData) > 0) {
Result <- ifelse(tData$res == "", "",
paste("\n", tData$res, sep = ""))
- Info <- paste(Info, "\n", paste("* ", tData$msg, ": ", tData$call,
- .formatTime(tData$timing, secDigits = 3), " ... ",
- as.character(tData$kind), Result, sep = "", collapse = "\n"),
- sep = "")
+ Info <- paste(Info, "\n", paste("* ", tData$msg, ": ",
+ tData$call, .formatTime(tData$timing, secDigits = 3),
+ " ... ", as.character(tData$kind), Result, sep = "",
+ collapse = "\n"), sep = "")
}
- # Calculate URI (currently, the name of the unit file # and
- # the name of the test function)
+ ## Calculate URI (currently, the name of the unit file
+ ## and the name of the test function)
if (Data$unit == "") URI <- Data$unit else
URI <- paste(Data$unit, Test, sep = "#")
if (Data$unit != lastUnit) {
Modified: pkg/svUnit/R/koUnit.R
===================================================================
--- pkg/svUnit/R/koUnit.R 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/R/koUnit.R 2010-09-04 09:03:19 UTC (rev 284)
@@ -1,7 +1,6 @@
-".koUnit" <-
-function (cmd, warn = FALSE, ...)
+.koUnit <- function (cmd, warn = FALSE, ...)
{
- # Look if koCmd() exists, otherwise, we are probably not connected to Komodo
+ ## Look if koCmd() exists, otherwise, we are probably not connected to Komodo
if (exists("koCmd", mode = "function")) {
res <- get("koCmd")(cmd, ...)
if (isTRUE(warn) & inherits(res, "try-error"))
@@ -13,36 +12,29 @@
}
}
-"koUnit_isAutoTest" <-
-function ()
+koUnit_isAutoTest <- function ()
{
res <- .koUnit('sv.socket.serverWrite(sv.r.unit.isAutoTest());')
return(res == "true")
}
-"koUnit_setAutoTest" <-
-function (state)
+koUnit_setAutoTest <- function (state)
{
if (isTRUE(state)) state <- "true" else state <- "false"
res <- .koUnit('sv.r.unit.setAutoTest(<<<data>>>);', data = state)
}
-"koUnit_runTest" <-
-function ()
-{
+koUnit_runTest <- function ()
res <- .koUnit('sv.r.unit.runTest();')
-}
-"koUnit_showRUnitPane" <-
-function (state)
+koUnit_showRUnitPane <- function (state)
{
if (missing(state)) state <- ""
else if (isTRUE(state)) state <- "true" else state <- "false"
res <- .koUnit('sv.r.unit.showRUnitPane(<<<data>>>);', data = state)
}
-"koUnit_version" <-
-function ()
+koUnit_version <- function ()
{
res <- .koUnit('sv.socket.serverWrite(sv.r.unit.version + "." + sv.r.unit.release);')
return(res)
Modified: pkg/svUnit/R/svSuite.R
===================================================================
--- pkg/svUnit/R/svSuite.R 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/R/svSuite.R 2010-09-04 09:03:19 UTC (rev 284)
@@ -1,18 +1,17 @@
-"svSuite" <-
-function (tests)
+svSuite <- function (tests)
{
- # Check provided tests and build a 'svSuite' object
+ ## Check provided tests and build a 'svSuite' object
tests <- as.character(tests)
- # Remove NAs and empty strings ("") from 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 existence/validity of corresponding tests!
+ ## 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 existence/validity of corresponding tests!
check1 <- (regexpr("^package:[a-zA-Z][a-zA-Z._0-9]*$", tests) > -1)
check2 <- (regexpr("^package:[a-zA-Z][a-zA-Z._0-9]* *\\(.+\\)$", tests) > -1)
check3 <- (regexpr("^dir:.+", tests) > -1)
@@ -22,21 +21,18 @@
if (any(wrong))
stop("Wrong 'tests' data: must be 'package:PKG', 'package:PKG (SUITE)',\n'dir:MYDIR', 'test(OBJ)' or 'OBJ'")
}
- # This is a 'svSuite' object subclassing 'character'
+ ## This is a 'svSuite' object subclassing 'character'
class(tests) <- c("svSuite", "character")
return(tests)
}
-"as.svSuite" <-
-function (x)
+as.svSuite <- function (x)
return(svSuite(x))
-"is.svSuite" <-
-function (x)
+is.svSuite <- function (x)
return(inherits(x, "svSuite"))
-"print.svSuite" <-
-function (x, ...)
+print.svSuite <- function (x, ...)
{
if (!is.svSuite(x))
stop("'x' must be a 'svSuite' object")
@@ -44,7 +40,7 @@
cat("An empty svUnit test suite\n")
} else {
cat("A svUnit test suite definition with:\n")
- # Separate unit tests from tests embedded in objects
+ ## Separate unit tests from tests embedded in objects
isSuite <- regexpr("^[package:|dir:]", x) > -1
if (any(isSuite)) {
Suites <- x[isSuite]
@@ -65,14 +61,13 @@
return(invisible(x))
}
-"svSuiteList" <-
-function (packages = TRUE, objects = TRUE, dirs = getOption("svUnit.dirs"),
+svSuiteList <- function (packages = TRUE, objects = TRUE, dirs = getOption("svUnit.dirs"),
excludeList = getOption("svUnit.excludeList"), pos = .GlobalEnv,
loadPackages = FALSE)
{
- # List unit test (1) in loaded packages (2) in objects in pos and (3) in
- # directories, possibly filtering them using an exclusion list
- # Note: Komodo should list test unit files in loaded projects too!
+ ## List unit test (1) in loaded packages (2) in objects in pos and (3) in
+ ## directories, possibly filtering them using an exclusion list
+ ## Note: Komodo should list test unit files in loaded projects too!
if (length(packages) < 1)
stop("'package' cannot have zero length")
if (length(objects) < 1)
@@ -80,7 +75,7 @@
items <- character()
- # 1) Unit test files in loaded packages
+ ## 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
@@ -88,7 +83,7 @@
Pkgs <- .packages()
}
for (Pkg in Pkgs) {
- # Look for test units in the package
+ ## Look for test units in the package
path <- system.file(package = Pkg, "unitTests")
if (path != "" && file.info(path)$isdir) {
pkgname <- paste("package", Pkg, sep = ":")
@@ -103,7 +98,7 @@
}
}
- # 2) Tests embedded in objects located in 'pos' environment
+ ## 2) Tests embedded in objects located in 'pos' environment
if (objects[1] != FALSE) {
envir = as.environment(pos)
if (is.character(objects)) {
@@ -135,10 +130,10 @@
items <- c(items, sort(tests))
}
- # 3) Additional directories (check that they are valid and existing dirs)
+ ## 3) Additional directories (check that they are valid and existing dirs)
if (!is.null(dirs)) {
- # Check if each entry exists as a directory, exclude it if not
- # Prepend "dir:" to tag them as additional directories
+ ## Check if each entry exists as a directory, exclude it if not
+ ## Prepend "dir:" to tag them as additional directories
Dirs <- character()
for (Dir in dirs)
if (file.exists(Dir) && file.info(Dir)$isdir)
@@ -146,15 +141,15 @@
items <- c(items, sort(Dirs))
}
- # Filter the resulting list with 'excludeList'
+ ## Filter the resulting list with 'excludeList'
if (!is.null(excludeList)) {
for (pattern in excludeList)
items <- items[regexpr(pattern, items) == -1]
}
- # Do we load the package?
+ ## Do we load the package?
if (loadPackages) {
- # Get a list of packages we need for the suite
+ ## Get a list of packages we need for the suite
Pkgs <- items[regexpr("^package:", items)]
PkgsSrch <- unique(sub(" +\\(.+$", "", Pkgs))
l <- length(PkgsSrch)
@@ -172,24 +167,24 @@
}
}
- # Make it a 'svSuite' object subclassing 'character'
+ ## Make it a 'svSuite' object subclassing 'character'
class(items) <- c("svSuite", "character")
return(items)
}
-"makeUnit.svSuite" <-
-function (x, name = make.names(deparse(substitute(x))), dir = tempdir(),
- objfile = "", codeSetUp = NULL, codeTearDown = NULL, pos = .GlobalEnv, ...)
+makeUnit.svSuite <- function (x, name = make.names(deparse(substitute(x))),
+dir = tempdir(), objfile = "", codeSetUp = NULL, codeTearDown = NULL,
+pos = .GlobalEnv, ...)
{
- # Take an 'svSuite' object and make a unit from its function tests
- # that are not written yet in a test unit in a file
- # They are saved in a file named runit<name>.R in 'dir'
+ ## Take an 'svSuite' object and make a unit from its function tests
+ ## that are not written yet in a test unit in a file
+ ## They are saved in a file named runit<name>.R in 'dir'
if (!is.svSuite(x))
stop("'x' must be a 'svSuite' object")
name <- as.character(name)[1]
- # Under Windows, we transform \\ into /
+ ## Under Windows, we transform \\ into /
dir <- gsub("\\\\", "/", as.character(dir)[1])
- # Collect all items that are not 'package:...' or 'dir:...'
+ ## 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
@@ -204,18 +199,18 @@
return(Unit)
}
-"runTest.svSuite" <-
-function (x, name = make.names(deparse(substitute(x))), unitname = NULL, ...)
+runTest.svSuite <- function (x, name = make.names(deparse(substitute(x))),
+unitname = NULL, ...)
{
- # Compile and run the test for this 'svSuite' object
+ ## Compile and run the test for this 'svSuite' object
if (!is.svSuite(x))
stop("'x' must be a 'svSuite' object")
name <- as.character(name[1])
- # Decode tests contained in x
+ ## Decode tests contained in x
tests <- as.character(x)
dirs <- character()
- # Package suites...
+ ## Package suites...
isPkg <- regexpr("^package:", tests) > -1
if (any(isPkg)) {
Pkgs <- tests[isPkg]
@@ -232,32 +227,32 @@
}
}
- # Add directories, and possibly make a temporary unit for test objects
+ ## Add directories, and possibly make a temporary unit for test objects
if (any(!isPkg)) {
tests <- tests[!isPkg]
- # Directories
+ ## Directories
isDir <- regexpr("^dir:", tests) > -1
if (any(isDir))
dirs <- c(sub("^dir:", "", tests[isDir]), dirs)
- # Objects
+ ## Objects
if (any(!isDir)) {
- # make a temporary unit for the tests of these objects
+ ## Make a temporary unit for the tests of these objects
if (!is.null(Unit <- makeUnit(x, name = name))) {
- # Add this path to dirs
+ ## Add this path to dirs
dirs <- c(dirname(Unit), dirs)
}
}
}
- # Now, list all files in these dirs with name being runit*.R
+ ## Now, list all files in these dirs with name being runit*.R
files <- character()
for (dir in dirs)
files <- c(files, list.files(dir, pattern = "^runit.+\\.[rR]$",
full.names = TRUE))
if (length(files) == 0) return(NULL) # Nothing to run!
- # Under Windows, transform all \\ into / in the file names
+ ## Under Windows, transform all \\ into / in the file names
files <- gsub("\\\\", "/", files)
- # Added by Thomas Wurtzler to control which unit test to run
+ ## Added by Thomas Wurtzler to control which unit test to run
if (!is.null(unitname)) {
unitname <- deparse(substitute(unitname))
testNames <- gsub("^.*runit(.+)\\.[rR]$", "\\1", files)
@@ -268,38 +263,38 @@
return(NULL)
}
}
- # Run this test suite now, that is, source each file in .TestSuiteEnv
- # and run each testxxx function in it, using .setUp and .tearDown too
- # Record the list of tests
+ ## Run this test suite now, that is, source each file in .TestSuiteEnv
+ ## and run each testxxx function in it, using .setUp and .tearDown too
+ ## Record the list of tests
.lastSuite <- list()
for (file in files)
.lastSuite[[basename(file)]] <- list(file = file)
.Log <- Log()
.Log$.lastSuite <- .lastSuite
- # Source each runit*.R file in turn
+ ## Source each runit*.R file in turn
for (unit in names(.lastSuite)) {
- # Create a new environment for this suite (created in .GlobalEnv so
- # that we can inspect it in case of stop on error)
+ ## Create a new environment for this suite (created in .GlobalEnv so
+ ## that we can inspect it in case of stop on error)
.TestSuiteEnv <<- new.env(parent = .GlobalEnv)
- # Source the corresponding file
+ ## Source the corresponding file
Unit <- .lastSuite[[unit]]$file
sys.source(Unit, envir = .TestSuiteEnv)
- # Make sure there are .setUp() and .tearDown() functions
+ ## Make sure there are .setUp() and .tearDown() functions
if (!exists(".setUp", envir = .TestSuiteEnv, mode = "function",
inherits = FALSE))
.TestSuiteEnv$.setUp <- function() {}
if (!exists(".tearDown", envir = .TestSuiteEnv, mode = "function",
inherits = FALSE))
.TestSuiteEnv$.tearDown <- function() {}
- # List all test files in the unit
+ ## List all test files in the unit
tests <- ls(.TestSuiteEnv, pattern = "^test.+$")
- # Keep only 'test*' objects that are function
+ ## Keep only 'test*' objects that are function
keep <- unlist(lapply(tests, function(n) exists(n,
envir = .TestSuiteEnv, mode = "function", inherits = FALSE)))
tests <- tests[keep]
.Log$.lastSuite[[unit]]$tests <- tests
- # Run each test in turn
+ ## Run each test in turn
for (test in tests) {
.runTest(envir = .TestSuiteEnv, test = test, unit = Unit)
}
Modified: pkg/svUnit/R/svSuiteData.R
===================================================================
--- pkg/svUnit/R/svSuiteData.R 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/R/svSuiteData.R 2010-09-04 09:03:19 UTC (rev 284)
@@ -1,24 +1,22 @@
-"is.svSuiteData" <-
-function (x)
+is.svSuiteData <- function (x)
{
- # It this a svSuiteData object
+ ## It this a svSuiteData object
return(inherits(x, "svSuiteData"))
}
-"stats.svSuiteData" <-
-function (object, ...)
+stats.svSuiteData <- function (object, ...)
{
if (!is.svSuiteData(object))
stop("'object' must inherit from 'svSuiteData'")
- # Get the list of tests
+ ## Get the list of tests
Tests <- ls(object)
if (length(Tests) == 0) {
- # The object is empty!
+ ## The object is empty!
Res <- data.frame(kind = .kind(logical()), timing = numeric(),
time = numeric(), unit = character(), tag = character(),
msg = character(), stringsAsFactors = FALSE)
} else {
- # Functions to get data for each test
+ ## Functions to get data for each test
getKind <- function(x) .kindMax(x$kind)
getTiming <- function(x) attr(x, "stats")["timing"]
getTime <- function(x) attr(x, "time")
@@ -35,18 +33,16 @@
return(Res)
}
-"metadata" <-
-function (object, ...)
+metadata <- function (object, ...)
UseMethod("metadata")
-"metadata.svSuiteData" <-
-function (object,
+metadata.svSuiteData <- function (object,
fields = c("R.version", "sessionInfo", "time", "description"), ...)
{
- # Extract metadata information from a 'svSuiteData' object
+ ## Extract metadata information from a 'svSuiteData' object
if (!is.svSuiteData(object))
stop("'object' must inherit from 'svSuiteData'")
- # Return a list with all metadata elements found
+ ## Return a list with all metadata elements found
fields <- paste(".", fields, sep = "")
Res <- list()
for (F in fields)
@@ -54,8 +50,7 @@
return(Res)
}
-"print.svSuiteData" <-
-function (x, all = FALSE, file = "", append = FALSE, ...)
+print.svSuiteData <- function (x, all = FALSE, file = "", append = FALSE, ...)
{
if (!is.svSuiteData(x))
stop("'x' must inherit from 'svSuiteData'")
@@ -63,7 +58,7 @@
if (length(Tests) == 0) {
cat("No test records!\n", file = file, append = append)
} else {
- # Print general information about the tests
+ ## Print general information about the tests
Stats <- stats(x)
Tests <- rownames(Stats) # To make sure we use the same!
Timing <- .formatTime(sum(Stats$timing, na.rm = TRUE), secDigits = 1)
@@ -73,35 +68,29 @@
sep = "", collapse = "\n"),
"\n\n", sep = "", file = file, append = TRUE)
- # Print detailed information about each test
+ ## Print detailed information about each test
for (Test in Tests)
print(x[[Test]], all = all, file = file, append = TRUE, ...)
}
return(invisible(x))
}
-"summary.svSuiteData" <-
-function (object, ...)
+summary.svSuiteData <- function (object, ...)
protocol_text.svSuiteData(object, ...)
-"protocol" <-
-function (object, type = "text", file = "", append = FALSE, ...)
+protocol <- function (object, type = "text", file = "", append = FALSE, ...)
UseMethod("protocol")
-"protocol.default" <-
-function (object, type = "text", file = "", append = FALSE, ...)
+protocol.default <- function (object, type = "text", file = "", append = FALSE, ...)
get(paste("protocol", type[1], sep = "_"))(object, file = file, append = append, ...)
-"protocol.svSuiteData" <-
-function (object, type = "text", file = "", append = FALSE, ...)
+protocol.svSuiteData <- function (object, type = "text", file = "", append = FALSE, ...)
get(paste("protocol", type[1], sep = "_"))(object, file = file, append = append, ...)
-"protocol_text" <-
-function (object, file = "", append = FALSE, ...)
+protocol_text <- function (object, file = "", append = FALSE, ...)
UseMethod("protocol_text")
-"protocol_text.svSuiteData" <-
-function (object, file = "", append = FALSE, ...)
+protocol_text.svSuiteData <- function (object, file = "", append = FALSE, ...)
{
if (!is.svSuiteData(object))
stop("'object' must inherit from 'svSuiteData'")
@@ -109,7 +98,7 @@
if (length(Tests) == 0) {
cat("No test records!\n", file = file, append = append)
} else {
- # Print general information about the tests
+ ## Print general information about the tests
Stats <- stats(object)
Tests <- rownames(Stats) # To make sure we use the same!
Timing <- .formatTime(sum(Stats$timing, na.rm = TRUE), secDigits = 1)
@@ -119,7 +108,7 @@
sep = "", collapse = "\n"),
"\n\n", sep = "", file = file, append = TRUE)
- # Summarize each test
+ ## Summarize each test
for (Test in Tests)
summary(object[[Test]], file = file, append = TRUE)
}
Modified: pkg/svUnit/R/svTest.R
===================================================================
--- pkg/svUnit/R/svTest.R 2010-09-04 09:01:29 UTC (rev 283)
+++ pkg/svUnit/R/svTest.R 2010-09-04 09:03:19 UTC (rev 284)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 284
More information about the Sciviews-commits
mailing list