Skip to content

Commit

Permalink
Deprecate old mocking functions
Browse files Browse the repository at this point in the history
  • Loading branch information
hadley committed Aug 23, 2024
1 parent fe38519 commit aeaa1c7
Show file tree
Hide file tree
Showing 10 changed files with 271 additions and 528 deletions.
466 changes: 234 additions & 232 deletions NEWS.md

Large diffs are not rendered by default.

119 changes: 6 additions & 113 deletions R/mock.R
Original file line number Diff line number Diff line change
@@ -1,14 +1,12 @@
#' Mock functions in a package.
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' `with_mock()` and `local_mock()` are superseded in favour of
#' `with_mock()` and `local_mock()` are deprecated in favour of
#' [with_mocked_bindings()] and [local_mocked_bindings()].
#'
#' These works by using some C code to temporarily modify the mocked function
#' _in place_. This is abusive of R's internals, which makes it dangerous, and
#' no longer recommended.
#' These functions worked by using some C code to temporarily modify the mocked
#' function _in place_. This was an abuse of R's internals and it is no longer
#' permitted.
#'
#' @section 3rd edition:
#' `r lifecycle::badge("deprecated")`
Expand All @@ -26,116 +24,11 @@
#' @return The result of the last unnamed parameter
#' @export
with_mock <- function(..., .env = topenv()) {
edition_deprecate(3, "with_mock()", "Please use with_mocked_bindings() instead")

dots <- eval(substitute(alist(...)))
mock_qual_names <- names(dots)

if (all(mock_qual_names == "")) {
warning(
"Not mocking anything. Please use named parameters to specify the functions you want to mock.",
call. = FALSE
)
code_pos <- rep(TRUE, length(dots))
} else {
code_pos <- (mock_qual_names == "")
}
code <- dots[code_pos]

mock_funs <- lapply(dots[!code_pos], eval, parent.frame())
mocks <- extract_mocks(mock_funs, .env = .env)

on.exit(lapply(mocks, reset_mock), add = TRUE)
lapply(mocks, set_mock)

# Evaluate the code
if (length(code) > 0) {
for (expression in code[-length(code)]) {
eval(expression, parent.frame())
}
# Isolate last item for visibility
eval(code[[length(code)]], parent.frame())
}
lifecycle::deprecate_stop("3.3.0", "with_mock()", "with_mocked_bindings()")
}

#' @export
#' @rdname with_mock
local_mock <- function(..., .env = topenv(), .local_envir = parent.frame()) {
edition_deprecate(3, "local_mock()", "Please use local_mocked_bindings() instead")

mocks <- extract_mocks(list(...), .env = .env)
on_exit <- bquote(
on.exit(lapply(.(mocks), .(reset_mock)), add = TRUE),
)

lapply(mocks, set_mock)
eval_bare(on_exit, .local_envir)
invisible()
}

pkg_rx <- ".*[^:]"
colons_rx <- "::(?:[:]?)"
name_rx <- ".*"
pkg_and_name_rx <- sprintf("^(?:(%s)%s)?(%s)$", pkg_rx, colons_rx, name_rx)

extract_mocks <- function(funs, .env) {
if (is.environment(.env)) {
.env <- environmentName(.env)
}
mock_qual_names <- names(funs)

lapply(
stats::setNames(nm = mock_qual_names),
function(qual_name) {
pkg_name <- gsub(pkg_and_name_rx, "\\1", qual_name)

if (is_base_pkg(pkg_name)) {
stop(
"Can't mock functions in base packages (", pkg_name, ")",
call. = FALSE
)
}

name <- gsub(pkg_and_name_rx, "\\2", qual_name)

if (pkg_name == "") {
pkg_name <- .env
}

env <- asNamespace(pkg_name)

if (!exists(name, envir = env, mode = "function")) {
stop("Function ", name, " not found in environment ",
environmentName(env), ".",
call. = FALSE
)
}
mock(name = name, env = env, new = funs[[qual_name]])
}
)
}

mock <- function(name, env, new) {
target_value <- get(name, envir = env, mode = "function")
structure(
list(
env = env,
name = as.name(name),
orig_value = .Call(duplicate_, target_value), target_value = target_value,
new_value = new
),
class = "mock"
)
}

set_mock <- function(mock) {
.Call(reassign_function, mock$name, mock$env, mock$target_value, mock$new_value)
}

reset_mock <- function(mock) {
.Call(reassign_function, mock$name, mock$env, mock$target_value, mock$orig_value)
}

is_base_pkg <- function(x) {
x %in% rownames(utils::installed.packages(priority = "base"))
lifecycle::deprecate_stop("3.3.0", "local_mock()", "local_mocked_bindings()")
}
4 changes: 0 additions & 4 deletions src/init.c
Original file line number Diff line number Diff line change
Expand Up @@ -4,13 +4,9 @@
#include <R_ext/Rdynload.h>

/* .Call calls */
extern SEXP duplicate_(SEXP);
extern SEXP reassign_function(SEXP, SEXP, SEXP, SEXP);
extern SEXP run_testthat_tests(SEXP);

static const R_CallMethodDef CallEntries[] = {
{"duplicate_", (DL_FUNC) &duplicate_, 1},
{"reassign_function", (DL_FUNC) &reassign_function, 4},
{"run_testthat_tests", (DL_FUNC) &run_testthat_tests, 1},
{NULL, NULL, 0}
};
Expand Down
24 changes: 0 additions & 24 deletions src/reassign.c

This file was deleted.

1 change: 1 addition & 0 deletions tests/testthat/_snaps/R4.4/snapshot-file/version.txt
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
R4.4
7 changes: 7 additions & 0 deletions tests/testthat/_snaps/R4.4/snapshot.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
# variants save different values

Code
r_version()
Output
[1] "R4.4"

15 changes: 15 additions & 0 deletions tests/testthat/_snaps/mock.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
# now defunct

Code
local_mock()
Condition
Error:
! `local_mock()` was deprecated in testthat 3.3.0 and is now defunct.
i Please use `local_mocked_bindings()` instead.
Code
with_mock(is_testing = function() FALSE)
Condition
Error:
! `with_mock()` was deprecated in testthat 3.3.0 and is now defunct.
i Please use `with_mocked_bindings()` instead.

4 changes: 1 addition & 3 deletions tests/testthat/test-examples.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,5 @@
test_that("test_examples works with installed packages", {
local_edition(2)

local_mock(test_rd = identity)
local_mocked_bindings(test_rd = identity)
expect_true(length(test_examples()) > 1)
})

Expand Down
154 changes: 5 additions & 149 deletions tests/testthat/test-mock.R
Original file line number Diff line number Diff line change
@@ -1,150 +1,6 @@
test_that("deprecated in 3rd edition", {
expect_warning(local_mock(), "deprecated")
expect_warning(with_mock(is_testing = function() FALSE), "deprecated")
})

test_that("can change value of internal function", {
local_edition(2)

with_mock(
test_mock_internal2 = function() 5,
expect_equal(test_mock_internal(), 5)
)

# and value is restored on error
expect_error(
with_mock(
test_mock_internal2 = function() 5,
stop("!")
)
)
expect_equal(test_mock_internal(), "y")
})


test_that("mocks can access local variables", {
local_edition(2)
x <- 5

with_mock(
test_mock_internal2 = function() x,
expect_equal(test_mock_internal(), 5)
)
})

test_that("non-empty mock with return value", {
local_edition(2)
expect_true(with_mock(
compare = function(x, y, ...) list(equal = TRUE, message = "TRUE"),
TRUE
))
})

test_that("nested mock", {
local_edition(2)
with_mock(
all.equal = function(x, y, ...) TRUE,
{
with_mock(
expect_warning = expect_error,
{
expect_warning(stopifnot(!compare(3, "a")$equal))
}
)
},
.env = asNamespace("base")
)
expect_false(isTRUE(all.equal(3, 5)))
expect_warning(warning("test"))
})

test_that("can't mock non-existing", {
local_edition(2)
expect_error(with_mock(..bogus.. = identity, TRUE), "Function [.][.]bogus[.][.] not found in environment testthat")
})

test_that("can't mock non-function", {
local_edition(2)
expect_error(with_mock(pkg_and_name_rx = FALSE, TRUE), "Function pkg_and_name_rx not found in environment testthat")
})

test_that("empty or no-op mock", {
local_edition(2)
expect_warning(
expect_null(with_mock()),
"Not mocking anything. Please use named parameters to specify the functions you want to mock.",
fixed = TRUE
)
expect_warning(
expect_true(with_mock(TRUE)),
"Not mocking anything. Please use named parameters to specify the functions you want to mock.",
fixed = TRUE
)
})

test_that("visibility", {
local_edition(2)
expect_warning(expect_false(withVisible(with_mock())$visible))
expect_true(withVisible(with_mock(compare = function() {}, TRUE))$visible)
expect_false(withVisible(with_mock(compare = function() {}, invisible(5)))$visible)
})

test_that("multiple return values", {
local_edition(2)
expect_true(with_mock(FALSE, TRUE, compare = function() {}))
expect_equal(with_mock(3, compare = function() {}, 5), 5)
})

test_that("can access variables defined in function", {
local_edition(2)
x <- 5
expect_equal(with_mock(x, compare = function() {}), 5)
})

test_that("can mock if package is not loaded", {
local_edition(2)
if ("package:curl" %in% search()) {
skip("curl is loaded")
}
skip_if_not_installed("curl")
with_mock(`curl::curl` = identity, expect_identical(curl::curl, identity))
})

test_that("changes to variables are preserved between calls and visible outside", {
local_edition(2)
x <- 1
with_mock(
show_menu = function() {},
x <- 3,
expect_equal(x, 3)
)
expect_equal(x, 3)
})

test_that("mock extraction", {
local_edition(2)
expect_identical(
extract_mocks(list(compare = compare), .env = asNamespace("testthat"))$compare$name,
as.name("compare")
)
expect_error(
extract_mocks(list(..bogus.. = identity), "testthat"),
"Function [.][.]bogus[.][.] not found in environment testthat"
)
expect_equal(
length(extract_mocks(list(not = identity, show_menu = identity), "testthat")),
2
)
})
# local_mock --------------------------------------------------------------

test_that("local_mock operates locally", {
local_edition(2)
f <- function() {
local_mock(compare = function(x, y) FALSE)
compare(1, 1)
}

expect_false(f())
expect_equal(compare(1, 1), no_difference())
test_that("now defunct", {
expect_snapshot(error = TRUE, {
local_mock()
with_mock(is_testing = function() FALSE)
})
})
5 changes: 2 additions & 3 deletions tests/testthat/test-reporter-debug.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
test_that("produces consistent output", {
withr::local_options(testthat.edition_ignore = TRUE)
local_edition(2)
local_mock(
local_mocked_bindings(
show_menu = function(choices, title = NULL) {
cat(paste0(format(seq_along(choices)), ": ", choices, sep = "\n"), "\n", sep = "")
0L
Expand All @@ -22,7 +22,7 @@ get_frame_from_debug_reporter <- function(choice, fun, envir = parent.frame()) {
force(choice)
test_debug_reporter_parent_frame <- NULL

with_mock(
with_mocked_bindings(
show_menu = function(choices, title = NULL) {
# if (choice > 0) print(choices)
my_choice <- choice
Expand Down Expand Up @@ -178,4 +178,3 @@ test_that("browser() is called for the correct frame for skips", {
expect_equal(get_vars_from_debug_reporter(3, fun_3), "g")
expect_equal(get_vars_from_debug_reporter(4, fun_3), character())
})

0 comments on commit aeaa1c7

Please sign in to comment.