## runitsvTest.R test suite
## by Ph. Grosjean <[email protected]>
## 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 () {
	checkEqualsNumeric(2, nrow(mat))

## An example function without test case
foo <- function(x) return(x)

## Another function with a test associated
bar <- function(x) return(x^2)
testbar <- svTest(function () {
	checkEqualsNumeric(4, bar(2))
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'")

Try the svUnit package in your browser

Any scripts or data that you put into this service are public.

svUnit documentation built on May 30, 2017, 4:25 a.m.