testthat::context('stub')
a = 10
f = function(x) x
g = function(x) f(x) + a
test_that('stubs function with return value', {
# before stubbing
expect_equal(g(20), 30)
# when
stub(g, 'f', 100)
# then
expect_equal(g(20), 110)
})
test_that('values restored after test', {
expect_equal(f(15), 15)
expect_equal(g(15), 25)
})
test_that('stubs function with function', {
# given
a = 10
f = function(x) x
g = function(x) f(x) + a
# before stubbing
expect_equal(g(20), 30)
# when
stub(g, 'f', function(...) 500)
# then
expect_equal(g(10), 510)
})
test_that('stubs function from namespace', {
# given
f = function() testthat::capture_output(print('hello'))
# before stubbing
expect_true(grepl('hello', f()))
# when
stub(f, 'testthat::capture_output', 10)
# then
expect_equal(f(), 10)
})
test_that('does not stub other namespeaced functions', {
# given
f = function() {
a = testthat::capture_output(print('hello'))
b = testthat::is_null('not null')
return(c(a, b))
}
# when
stub(f, 'testthat::is_null', 'stubbed output')
# then
result = f()
expect_true(grepl('hello', result[1]))
expect_equal(result[2], 'stubbed output')
})
test_that('stub multiple functions', {
# given
f = function(x) x + 10
g = function(y) y + 20
h = function(z) f(z) + g(z)
# when
stub(h, 'f', 300)
stub(h, 'g', 500)
# then
expect_equal(h(1), 800)
})
test_that('stub multiple namespaced functions', {
# given
h = function(x) mockery::stub(x) + mockery::get_function_source(x)
# when
stub(h, 'mockery::stub', 300)
stub(h, 'mockery::get_function_source', 500)
# then
expect_equal(h(1), 800)
})
test_that('stub works with do.call', {
# given
f = function(x) x + 10
g = function(x) do.call('f', list(x))
# before stub
expect_equal(g(10), 20)
# stub
stub(g, 'f', 100)
# then
expect_equal(g(10), 100)
})
test_that('stub works with lapply', {
# given
f = function(x) x + 10
g = function(x) lapply(x, 'f')
l = list(1, 2, 3)
# before stub
expect_equal(g(l), list(11, 12, 13))
# stub
stub(g, 'f', 100)
# then
expect_equal(g(l), list(100, 100, 100))
})
test_that('stub works well with mock object', {
# given
f = function(x) x + 10
g = function(x) f(x)
mock_object = mock(100)
stub(g, 'f', mock_object)
# when
result = g(5)
# then
expect_equal(result, 100)
})
f = function(x) x + 10
g = function(x) f(x)
test_that('mock object returns value', {
mock_object = mock(1)
stub(g, 'f', mock_object)
expect_equal(g('anything'), 1)
expect_called(mock_object, 1)
expect_args(mock_object, 1, 'anything')
})
test_that('mock object multiple return values', {
mock_object = mock(1, "a", sqrt(3))
stub(g, 'f', mock_object)
expect_equal(g('anything'), 1)
expect_equal(g('anything'), "a")
expect_equal(g('anything'), sqrt(3))
})
test_that('mock object accessing values of arguments', {
mock_object <- mock()
mock_object(x = 1)
mock_object(y = 2)
expect_equal(length(mock_object), 2)
args <- mock_args(mock_object)
expect_equal(args[[1]], list(x = 1))
expect_equal(args[[2]], list(y = 2))
})
test_that('mock object accessing call expressions', {
mock_object <- mock()
mock_object(x = 1)
mock_object(y = 2)
expect_equal(length(mock_object), 2)
calls <- mock_calls(mock_object)
expect_equal(calls[[1]], quote(mock_object(x = 1)))
expect_equal(calls[[2]], quote(mock_object(y = 2)))
})
library(R6)
some_other_class = R6Class("some_class",
public = list(
external_method = function() {return('this is external output')}
)
)
some_class = R6Class("some_class",
public = list(
some_method = function() {return(some_function())},
some_method_prime = function() {return(some_function())},
other_method = function() {return('method in class')},
method_without_other = function() { self$other_method() },
method_with_other = function() {
other <- some_other_class$new()
other$external_method()
self$other_method()
}
)
)
# Calling function from R6 method
some_function = function() {return("called from within class")}
obj = some_class$new()
test_that('stub works with R6 methods', {
stub(obj$some_method, 'some_function', 'stub has been called')
expect_equal(obj$some_method(), 'stub has been called')
})
test_that('stub works with R6 methods that call internal methods in them', {
stub(obj$method_without_other, 'self$other_method', 'stub has been called')
expect_equal(obj$method_without_other(), 'stub has been called')
})
test_that('stub works with R6 methods that have other objects in them', {
stub(obj$method_with_other, 'self$other_method', 'stub has been called')
expect_equal(obj$method_with_other(), 'stub has been called')
})
test_that('R6 method does not stay stubbed', {
expect_equal(obj$some_method(), 'called from within class')
})
# Calling R6 method from function
other_func = function() {
obj = some_class$new()
return(obj$other_method())
}
test_that('stub works for stubbing R6 methods from within function calls', {
stub(other_func, 'obj$other_method', 'stubbed R6 method')
expect_equal(other_func(), 'stubbed R6 method')
})
test_that('stub does not stay in effect', {
expect_equal(other_func(), 'method in class')
})
test_that('stub out of namespaced functions', {
expect_true(grepl('hello', testthat::capture_output(print('hello'))))
stub(testthat::capture_output, 'paste0', 'stubbed function')
expect_equal(testthat::capture_output(print('hello')), 'stubbed function')
})
test_that('stub multiple namespaced and R6 functions from within test env', {
stub(testthat::capture_output, 'paste0', 'stub 1')
stub(obj$some_method, 'some_function', 'stub 2')
stub(obj$some_method_prime, 'some_function', 'stub 3')
stub(testthat::test_that, 'test_code', 'stub 4')
# all stubs are active
expect_equal(testthat::capture_output(print('hello')), 'stub 1')
expect_equal(obj$some_method(), 'stub 2')
expect_equal(obj$some_method_prime(), 'stub 3')
expect_equal(testthat::test_that('a', print), 'stub 4')
# non mocked R6 and namespaced functions work as expected
expect_equal(obj$other_method(), 'method in class')
testthat::expect_failure(expect_equal(4, 5))
})
h = function(x) 'called h'
g = function(x) h(x)
f = function(x) g(x)
test_that('use can specify depth of mocking', {
stub_string = 'called stub!'
stub(f, 'h', stub_string, depth=2)
expect_equal(f(1), stub_string)
})
h = function(x) 'called h'
g = function(x) h(x)
f = function(x) paste0(h(x), g(x))
test_that('mocked function is mocked at all depths', {
stub_string = 'called stub!'
stub(f, 'h', stub_string, depth=2)
expect_equal(f(1), 'called stub!called stub!')
})
h = function(x) 'called h'
g = function(x) h(x)
r = function(x) g(x)
f = function(x) paste0(h(x), r(x))
test_that('mocked function is mocked at all depths', {
stub_string = 'called stub!'
stub(f, 'h', stub_string, depth=3)
expect_equal(f(1), 'called stub!called stub!')
})
h = function(x) 'called h'
t = function(x) h(x)
g = function(x) h(x)
r = function(x) paste0(t(x), g(x))
u = function(x) paste0(h(x), g(x))
f = function(x) paste0(h(x), r(x), u(x))
t_env = new.env(parent=baseenv())
assign('h', h, t_env)
environment(t) = t_env
u_env = new.env(parent=baseenv())
assign('g', g, u_env)
assign('h', h, u_env)
environment(u) = u_env
f_env = new.env(parent=baseenv())
assign('u', u, f_env)
assign('h', h, f_env)
assign('r', r, f_env)
environment(f) = f_env
a = function(x) x
environment(a) = f_env
test_that('mocked function is mocked at all depths across paths', {
stub_string = 'called stub!'
stub(f, 'h', stub_string, depth=4)
expect_equal(f(1), 'called stub!called stub!called stub!called stub!called stub!')
})
.a = function(x) h(x)
test_that('mocks hidden functions', {
stub_string = 'called stub!'
stub(.a, 'h', stub_string, depth=4)
expect_equal(f(1), 'called stub!called stub!called stub!called stub!called stub!')
})
test_that("Does not error if function contains double quoted assignment functions", {
f <- function(x, nms) {
base::names(x) <- base::tolower(nms)
x
}
stub(f, "base::tolower", toupper)
expect_equal(f(1, "b"), c(B = 1))
stub(f, "base::names<-", function(x, value) stats::setNames(x, "d"))
expect_equal(f(1, "b"), c(d = 1))
})
h = function(x) x
g = function(x) h(x)
f = function(x) g(x)
locked_f_env = new.env(parent = baseenv())
assign('g', g, locked_f_env)
assign('h', h, locked_f_env)
environment(f) <- locked_f_env
lockEnvironment(locked_f_env, bindings=TRUE)
test_that('stubs locked functions', {
stub_string = 'called stub!'
stub(f, 'h', stub_string, depth=2)
expect_equal(f('not stub'), 'called stub!')
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.