Nothing
# runitsvTest.R test suite
# by Ph. Grosjean <phgrosjean@sciviews.org>
# Run it simply by example(unitTests.svUnit)
# Create a few objects we need for tests
# An R object (matrix)
mat <- matrix(rnorm(4), ncol = 2)
# Create very simple test cases for matrix 'mat'
testmat <- svTest(function() {
checkEquals(2, nrow(mat), checkNames = FALSE)
checkEquals(2, ncol(mat), checkNames = TRUE) # Not important here
checkTrue(is.numeric(mat))
})
# An example function without test case
foo <- function(x)
x
# Another function with a test associated
bar <- function(x)
x^2
testbar <- svTest(function() {
checkEqualsNumeric(4, bar(2))
checkException(bar("xx"))
})
test(bar) <- testbar
# The test cases
.setUp <- function() {
# Executed before each test function
# ...
}
.tearDown <- function() {
# Executed after each test function
# ...
}
testis.test <- function() {
checkTrue(!is.test(foo), "No associated test cases to 'foo'")
checkTrue(is.test(testbar), "Is testbar a 'svTest'?")
checkTrue(is.test(bar), "Associated test cases to 'bar'")
checkTrue(!is.test(mat), "No associated test cases to 'mat'")
checkTrue(is.test(testmat), "Is an 'svTest' object a test?")
if (exists(".Log"))
.Log$..Obj <- "test" # Switch the context to test()
checkTrue(is.test(test(foo)), "Return dummy test if no test cases")
checkIdentical(testbar, test(bar), "test of 'bar' identical to 'testbar'")
if (exists(".Log"))
.Log$..Obj <- "test<-" # Switch the context to `test<-`()
checkException(test(foo) <- "x", "Strange value to assign as 'test'")
checkException(test(foo) <- function(y) y,
"Try assign a function with arguments")
# Add test cases to an object
mat2 <- mat
checkTrue(is.test(test(mat2) <- testmat),
"'mat2' valid test case association")
checkIdentical(testmat, test(mat2),
"test of 'mat2' identical to 'testmat'")
# Strange,... but allowed
test(testbar) <- testbar
checkIdentical(testbar, test(testbar),
"Assigning test cases to oneself")
if (exists(".Log"))
.Log$..Obj <- "is.test" # Switch context back to is.test()
checkTrue(!is.test("x"), "'x' is is not a 'svTest' object")
checkTrue(!is.test(NULL), "NULL is not a 'svTest' object")
checkTrue(!is.test(NA), "NA is not a 'svTest' object")
}
testsvTest <- function() {
checkException(svTest(foo), "Functions with arguments not allowed")
checkException(svTest("x"), "Strange argument to svTest")
checkTrue(is.svTest(svTest(function() {})),
"Creation of a minimal 'svTest' object")
if (exists(".Log"))
.Log$..Obj <- "is.svTest" # Switch context to is.svTest()
checkTrue(is.svTest(testmat), "Is testmat a 'svTest' object?")
checkTrue(is.svTest(testbar), "Is testbar a 'svTest' object?")
checkTrue(is.svTest(test(bar)), "Is test(bar) a 'svTest' object?")
checkTrue(!is.svTest(foo), "'foo' is not a 'svTest' object")
checkTrue(!is.svTest("x"), "'x' is not a 'svTest' object")
checkTrue(!is.svTest(NULL), "NULL is not a 'svTest' object")
checkTrue(!is.svTest(NA), "NA is not a 'svTest' object")
checkTrue(!is.svTest(function() {}), "A function is not a 'svTest' object")
if (exists(".Log"))
.Log$..Obj <- "as.svTest" # Switch context to as.svTest()
checkTrue(is.svTest(as.svTest(testmat)),
"Coercion to a 'svTest' object")
checkException(as.svTest("x"),
"Try coercion on wrong object")
checkException(as.svTest(function(y) y),
"Try coercion on function with arguments")
}
testrunTest <- function() {
checkTrue(inherits(runTest(testbar), "svTestData"),
"result of runTest(testbar) is 'svTestData'")
# Following tests fail currently for reasons I haven't spotted yet,
# but runTest() works wine outside of these tests... So, I deactivate them
DEACTIVATED("runTest(bar) does not work inside test functions")
checkTrue(inherits(runTest(test(bar)), "svTestData"),
"result of runTest(test(bar)) is 'svTestData'")
checkTrue(inherits(runTest(bar), "svTestData"),
"result of runTest(bar) is 'svTestData'")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.