# tests/testthat/test_stub.R In mockery: Mocking Library for R

```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))
expect_equal(result, '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[], list(x = 1))
expect_equal(args[], 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[], quote(mock_object(x = 1)))
expect_equal(calls[], 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!')
})
```

## Try the mockery package in your browser

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

mockery documentation built on March 18, 2022, 5:24 p.m.