inst/unitTests/runitsvTest.R

## 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))
	checkTrue(is.numeric(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))
	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'")
}

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.