context('servicetests')
fn1 <- function(x, y) { x + y }
# Helpers to be able to test callback functions
.test_env <- new.env()
incr_flag <- function(flag) { assign(flag, get_flag(flag) + 1, envir = .test_env) }
get_flag <- function(flag) {
if (!exists(flag, envir = .test_env)) return(0)
get(flag, envir = .test_env, inherits = FALSE)
}
test_flag <- function(flag) { exists(flag, envir = .test_env) }
reset_flags <- function() { rm(list = ls(.test_env, all = TRUE), envir = .test_env) }
fail_fn <- function(...) { incr_flag('failed') }
pass_fn <- function(...) { incr_flag('passed') }
pass_all_fn <- function() { incr_flag('passed_all') }
fail_any_fn <- function() { incr_flag('failed_any') }
context('registry')
describe('clear_registry', {
it('empties registery', {
# setup
clear_registry()
register_service_call("fn1 A", fn1(1,2))
# exercise
clear_registry()
# verify
reg <- get_registry()
expect_true(identical(reg, list()))
})
})
context('register_service_call')
describe('register_service_call', {
it('is a function', {
# exercise
expect_true(is.function(register_service_call))
})
it ('fails if missing parameters', {
# setup
clear_registry()
expect_error(register_service_call(), "No key provided.")
expect_error(register_service_call("foo"), "No service call provided.")
})
test_that('it registers a service call', {
# setup
clear_registry()
# exercise
register_service_call("fn1", fn1(1, 2))
# # verify
reg <- servicetests:::get_registry()
expect_true(exists('fn1', reg))
obj <- reg[[1]]
expect_true(exists('fname', obj))
expect_true(exists('params', obj))
expect_true(exists('expected', obj))
expect_true(identical(obj$fname, 'fn1'))
expect_true(identical(obj$params, list(1,2)))
expect_true(identical(obj$expected, 3))
})
test_that('it registers service calls with a call as input', {
# setup
clear_registry()
# exercise
register_service_call("fn1", quote(fn1(1, 2)))
# verify
reg <- servicetests:::get_registry()
expect_true(exists('fn1', reg))
obj <- reg[[1]]
expect_true(exists('fname', obj))
expect_true(exists('params', obj))
expect_true(exists('expected', obj))
expect_true(identical(obj$fname, 'fn1'))
expect_true(identical(obj$params, list(1,2)))
expect_true(identical(obj$expected, 3))
})
test_that ("it registeres service calls with a quoted list as input", {
# setup
clear_registry()
# exercise
register_service_call("fn1", quote(list(call = fn1(1,2), match_fn = identical)))
# verify
reg <- servicetests:::get_registry()
expect_true(exists('fn1', reg))
obj <- reg[['fn1']]
expected_names <- c('fname', 'params', 'expected', 'match_fn', 'key', 'hash')
expect_true(all(expected_names %in% names(obj)))
expect_true(identical(obj$fname, 'fn1'))
expect_true(identical(obj$params, list(1,2)))
expect_true(identical(obj$expected, 3))
expect_true(identical(obj$match_fn, "identical"))
})
test_that('it detects service calls that collide', {
# setup
clear_registry()
# exercise/verify
register_service_call("fn1", fn1(1,2))
warning_msg <-
expect_warning(register_service_call("fn1", fn1(1,2)), "Service call is already registered.")
expect_warning(register_service_call("fn1", fn1(3,2)), "Service call is already registered.")
})
test_that('it fails non-service call expressions', {
# setup
clear_registry()
# TODO
# expect_error(register_service_call(1+1), "Expression must begin with a function call")
})
})
context('register_service_calls')
describe('given a list of service calls', {
it ('registers the quoted list and from ...', {
# setup
clear_registry()
call_list <- quote(list(
"fn1 A" = fn1(1,2),
"fn1 B" = fn1(3,4)
))
# exercise
register_service_calls(
call_list = call_list,
"fn1 C" = fn1(5,6),
"fn1 D" = fn1(7,8),
envir = environment()
)
# verify
reg <- get_registry()
expect_equal(4, length(reg))
expect_equal(c('fn1 A', 'fn1 B', 'fn1 C', 'fn1 D'), names(reg))
output_expected <- c(3, 7, 11, 15)
lapply(seq_along(reg), function(i) {
expect_equal(reg[[i]]$fname, "fn1")
expect_equal(reg[[i]]$expected, output_expected[i])
})
})
})
context('test_service')
test_that('it is a function', {
expect_true(is.function(test_service))
})
describe('when a service is registered', {
# setup
clear_registry()
register_service_call("fn1 A", fn1(1,2))
reg <- get_registry()
obj <- reg[[1]]
it('succeeeds when the service call returns the same value', {
#exercise
expect_true(test_service(obj))
})
it('fails when service call returns different values', {
# setup
fn1 <- function(x,y) {FALSE}
# exercise/verify
expect_false(test_service(obj))
# teardown
rm("fn1")
expect_true(test_service(obj))
})
describe ("when given a custom matcher", {
new_obj <- append(obj, list(match_fn = "identical"))
it("succeeds when the service call returns the same value", {
expect_true(test_service(new_obj))
})
it("fails when service call returns different values", {
# setup
fn1 <- function(x,y) {FALSE}
# exercise/verify
expect_false(test_service(new_obj))
# teardown
rm("fn1")
expect_true(test_service(new_obj))
})
it("retains the actual value when the match_fn fails", {
new_obj <- obj
new_obj$match_fn <- function(...) stop("Error")
env <- new.env()
expect_false(test_service(new_obj, on.fail_each =
function(obj, value) { env$value <- value }))
expect_equal(env$value, 3)
})
})
it('fails when service call has a runtime error', {
fn1 <- function(x,y) { stop("beep beep. This is just a test.") }
expect_false(test_service(obj))
rm("fn1")
expect_true(test_service(obj))
})
it('fails when passing a non-function arguments for on.fail, on.pass, on.pass_all', {
#exercise/verify
expect_error(test_service(obj, on.pass = "foo"))
expect_error(test_service(obj, on.fail = "foo"))
expect_error(test_service(obj, on.pass_all = "foo"))
})
it('runs pass callbacks correctly', {
# setup for pass
reset_flags()
# exercise
test_service(obj, on.pass_each = pass_fn, on.fail_each = fail_fn)
# verify
expect_true(test_flag("passed"))
expect_equal(1, get_flag("passed"))
expect_false(test_flag("failed"))
})
it ('runs fail callback correctly', {
# setup
fn1 <- function(x,y) {FALSE}
reset_flags()
# exercise
test_service(obj, on.pass = pass_fn, on.fail = fail_fn)
expect_true(test_flag('failed'))
expect_equal(1, get_flag('failed'))
expect_false(test_flag('passed'))
})
it ("returns stack trace in on.fail callback", {
# setup
fn1 <- function(...) stop("Force error.")
stack_trace <- NULL
examine_stacktrace <- function(obj, actual) {
stack_trace <<- actual
}
# exercise
test_service(obj, on.fail = examine_stacktrace)
expect_true("calls" %in% names(stack_trace))
expect_true(all(Reduce(c, lapply(stack_trace$calls, is.call))))
rm("fn1")
expect_true(test_service(obj))
})
})
context('test_service_calls')
describe ('test_service_calls', {
it('it is a function', {
expect_true(is.function(test_service_calls))
})
it('it errors when passing a non-supported return type', {
expect_error(test_service_calls(return.type = 'unknown'))
})
describe ("when two are regsitered", {
setup_two_registered <- function() {
clear_registry()
register_service_call("fn1 A", fn1(1,2))
register_service_call("fn1 B", fn1(3,4))
}
it('it processes each registered test', {
setup_two_registered()
# exercise
output <- test_service_calls()
# verify
reg <- get_registry()
output_expected <- setNames(list(TRUE, TRUE), names(reg))
expect_true(identical(output, output_expected))
})
it('it fails when service call changes', {
setup_two_registered()
# exercise
fn1 <- function(x,y) { FALSE }
output <- test_service_calls()
# verify
reg <- get_registry()
output_expected <- setNames(list(FALSE, FALSE), names(reg))
expect_true(identical(output, output_expected))
# teardown
fn1 <- NULL
})
it ("can be forced to re-register a service call when response changes", {
setup_two_registered()
fn1 <- function(x,y) { FALSE }
reg <- get_registry()
output <- test_service_calls()
output_expected <- setNames(list(FALSE, FALSE), names(reg))
expect_equal(output, output_expected)
register_service_call("fn1 A", fn1(1,2), envir = environment(), force = TRUE)
reg <- get_registry()
output <- test_service_calls()
output_expected <- setNames(list(TRUE, FALSE), names(reg))
expect_equal(output, output_expected)
rm('fn1')
})
it ("can be forced to re-register a service call when the call changes", {
setup_two_registered()
reg <- get_registry()
output <- test_service_calls()
output_expected <- setNames(list(TRUE, TRUE), names(reg))
expect_equal(output, output_expected)
# exercise
fn2 <- function(x,y) FALSE
register_service_call("fn1 A", fn2(1,2), environment(), force = TRUE)
reg <- get_registry()
# verify that the proper services are registered
expect_identical(setNames(list('fn2', 'fn1'), c('fn1 A', 'fn1 B')), lapply(reg, function(x) x$fname))
# verify that the service tests pass
output <- test_service_calls()
output_expected <- setNames(list(TRUE, TRUE), names(reg))
expect_equal(output, output_expected)
# clean up
rm('fn2')
})
it ('it returns a list when return.type = "verbose"', {
setup_two_registered()
# exercise
output <- test_service_calls(return.type = "verbose")
# verify
expect_is(output, 'list')
})
it ('it returns a logical when return.type = "logical"', {
setup_two_registered()
# exercise
output <- test_service_calls(return.type = "logical")
# verify
expect_is(output, 'logical')
})
it ('runs pass_all callback on pass', {
# setup
setup_two_registered()
reset_flags()
# verify
output <- test_service_calls(on.pass_all = pass_all_fn)
# verify
expect_true(test_flag('passed_all'))
expect_false(test_flag('passed'))
expect_false(test_flag('failed'))
})
describe ('plus one more service test', {
it ('runs callback on more complicated test results', {
# setup: register fn2 then change fn2 response
setup_two_registered()
fn2 <- function(x,y) { x * y }
register_service_call("fn2", fn2(3,4))
reg <- get_registry()
expect_equal(3, length(reg))
fn2 <- function(...) { FALSE }
reset_flags()
# verify
output <- test_service_calls(on.pass_all = pass_all_fn, on.fail_any = fail_any_fn, on.pass = pass_fn, on.fail = fail_fn)
# verify
expect_false(test_flag('passed_all'))
expect_true(test_flag('failed_any'))
expect_true(test_flag('passed'))
expect_true(test_flag('failed'))
expect_equal(1, get_flag('failed'))
expect_equal(2, get_flag('passed'))
})
})
})
})
context('cache registry')
describe ("cache registry", {
default_cache_root <- normalizePath(getOption("servicetest.dir", "~/.R/servicetests"))
it ('saves and loads registry from file', {
# check to make sure cache file does not exist
clear_registry()
cache_file <- "test"
cache_root <- servicetests:::get_cache_root()
expect_identical(default_cache_root, cache_root)
cache_path <- file.path(cache_root, cache_file)
if (file.exists(cache_path)) file.remove(cache_path)
expect_false(file.exists(cache_path))
# add 1 servicetest
register_service_call("fn1 A", fn1(1,2))
expect_equal(1, length(get_registry()))
# save regsitry to cache
save_registry(cache_file)
expect_true(file.exists(cache_path))
# add more servicetests to current registry
register_service_call("fn1 B", fn1(3,4))
expect_equal(2, length(get_registry()))
# load registry from file and see if it revert back to when it was saved
load_registry(cache_file)
expect_equal(1, length(get_registry()))
# teardown
file.remove(cache_path)
expect_false(file.exists(cache_path))
})
it ('can set a cache_path', {
# verify global cache is being used
expect_identical(default_cache_root, servicetests:::get_cache_root())
# setup cache in an empty path
tmp_root <- file.path(tempdir(), 'testing')
expect_false(file.exists(tmp_root))
# exercise
servicetests:::set_cache_root(tmp_root)
# verify that path was created
expect_identical(normalizePath(tmp_root), servicetests:::get_cache_root())
expect_true(file.exists(tmp_root))
# teardown - remove tmp files and restore cache_root to default
file.remove(tmp_root)
expect_false(file.exists(tmp_root))
servicetests:::set_cache_root()
expect_identical(default_cache_root, servicetests:::get_cache_root())
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.