mockr/0000755000176200001440000000000014366454362011402 5ustar liggesusersmockr/NAMESPACE0000644000176200001440000000016614203657336012620 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(get_mock_env) export(local_mock) export(with_mock) import(rlang) mockr/README.md0000644000176200001440000001174514365473162012667 0ustar liggesusers # mockr [![rcc](https://github.com/krlmlr/mockr/workflows/rcc/badge.svg)](https://github.com/krlmlr/mockr/actions) [![CRAN\_Status\_Badge](https://www.r-pkg.org/badges/version/mockr)](https://cran.r-project.org/package=mockr) [![Codecov test coverage](https://codecov.io/gh/krlmlr/mockr/branch/main/graph/badge.svg)](https://app.codecov.io/gh/krlmlr/mockr?branch=main) The goal of mockr is to provide a drop-in replacement for [`testthat::local_mock()`](https://testthat.r-lib.org/reference/with_mock.html) and [`testthat::with_mock()`](https://testthat.r-lib.org/reference/with_mock.html) which is deprecated in testthat 3.0.0. The functions [`mockr::local_mock()`](https://krlmlr.github.io/mockr/reference/local_mock.html) and [`mockr::with_mock()`](https://krlmlr.github.io/mockr/reference/local_mock.html) are modeled closely after the original implementation, but now only allow mocking functions in the package under test. In contrast to the original implementation, no fiddling with R’s internals is needed, and the implementation plays well with byte-compiled code. There are some caveats, though: 1. Mocking external functions (in other packages) doesn’t work anymore. This is by design. - If you need to mock an external function, write a wrapper. - If that external function is called by third-party code, you’ll need to perhaps mock that third-party code, or look for a different way of implementing this test or organizing your code. 2. You cannot refer to functions in your package via `your.package::` or `your.package:::` anymore. - Remove the `your.package:::`, your code and tests should run just fine without that. If you encounter other problems, please [file an issue](https://github.com/krlmlr/mockr/issues). ## Example
library(mockr)

access_resource <- function() {
  message("Trying to access resource...")
  # For some reason we can't access the resource in our tests.
  stop("Can't access resource now.")
}

work_with_resource <- function() {
  resource <- access_resource()
  message("Fetched resource: ", resource)
  invisible(resource)
}

# Calling this function gives an error
work_with_resource()
#> Trying to access resource...
#> Error in access_resource(): Can't access resource now.

local({
  # Here, we override the function that raises the error
  local_mock(access_resource = function() 42)

  # No error raised
  work_with_resource()
})
#> Fetched resource: 42
## Installation Install from CRAN via
install.packages("mockr")
------------------------------------------------------------------------ ## Code of Conduct Please note that the mockr project is released with a [Contributor Code of Conduct](https://krlmlr.github.io/mockr/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. mockr/man/0000755000176200001440000000000014366006155012146 5ustar liggesusersmockr/man/local_mock.Rd0000644000176200001440000000572114366146276014556 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/with-mock.R \name{local_mock} \alias{local_mock} \alias{with_mock} \title{Mock functions in a package} \usage{ local_mock( ..., .parent = parent.frame(), .env = get_mock_env(.parent), .defer_env = parent.frame() ) with_mock(..., .parent = parent.frame(), .env = get_mock_env(.parent)) } \arguments{ \item{...}{\verb{[any]}\cr Named arguments redefine mocked functions. An unnamed argument containing code in braces (\code{{}}) should be provided to \code{with_mock()}, it will be evaluated after mocking the functions. Use \verb{:=} to mock functions that start with a dot to avoid potential collision with current or future arguments to \code{with_mock()} or \code{local_mock()}. Passing more than one unnamed argument to \code{with_mock()}, or code that is not inside braces, gives a warning.} \item{.parent}{\verb{[environment]}\cr the environment in which to evaluate the expressions, defaults to \code{\link[=parent.frame]{parent.frame()}}. Usually doesn't need to be changed.} \item{.env}{\verb{[environment]}\cr the environment in which to patch the functions, defaults to \code{\link[=topenv]{topenv()}}. Usually doesn't need to be changed.} \item{.defer_env}{\verb{[environment]}\cr Attach exit handlers to this environment. Typically, this should be either the current environment or a parent frame (accessed through \code{\link[=parent.frame]{parent.frame()}}). This argument is passed on as \code{envir} to \code{\link[withr:defer]{withr::defer()}}.} } \value{ \code{local_mock()} returns \code{NULL}, invisibly. \code{with_mock()} returns the result of the last unnamed argument. Visibility is preserved. } \description{ \code{local_mock()} temporarily substitutes implementations of package functions. This is useful for testing code that relies on functions that are slow, have unintended side effects or access resources that may not be available when testing. \code{with_mock()} substitutes, runs code locally, and restores in one go. } \details{ This works by adding a shadow environment as a parent of the environment in which the expressions are evaluated. Everything happens at the R level, but only functions in your own package can be mocked. Otherwise, the implementation is modeled after the original version in the \code{testthat} package, which is now deprecated. } \examples{ some_func <- function() stop("oops") some_other_func <- function() some_func() my_env <- environment() tester_func <- function() { # The default for .env works well most of the time, # unfortunately not in examples local_mock(some_func = function() 42, .env = my_env) some_other_func() } try(some_other_func()) tester_func() tester_func_with <- function() { with_mock( some_func = function() 42, .env = my_env, { some_other_func() } ) } tester_func_with() } \references{ Suraj Gupta (2012): \href{https://blog.thatbuthow.com/how-r-searches-and-finds-stuff/}{How R Searches And Finds Stuff} } mockr/man/get_mock_env.Rd0000644000176200001440000000230214203657336015075 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/env.R \name{get_mock_env} \alias{get_mock_env} \title{Get environment for mocking} \usage{ get_mock_env(.parent = parent.frame()) } \arguments{ \item{.parent}{\verb{[environment]}\cr the environment in which to evaluate the expressions, defaults to \code{\link[=parent.frame]{parent.frame()}}. Usually doesn't need to be changed.} } \description{ Called by default from \code{\link[=with_mock]{with_mock()}} to determine the environment where to update mocked functions. This function is exported to help troubleshooting. } \details{ This function works differently depending on \code{\link[testthat:is_testing]{testthat::is_testing()}}. Outside testthat, \code{topenv(.parent)} is returned. This was the default for mockr < 0.1.0 and works for many cases. In testthat, \code{asNamespace("")} for the tested package is returned. The tested package is determined via \code{\link[testthat:is_testing]{testthat::testing_package()}}. If this is empty (e.g. if a \code{test_that()} block is run in interactive mode), this function looks in the search path for packages loaded by \code{\link[pkgload:load_all]{pkgload::load_all()}}. } mockr/man/mockr-package.Rd0000644000176200001440000000130214366006155015135 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mockr-package.R \docType{package} \name{mockr-package} \alias{mockr} \alias{mockr-package} \title{mockr: Mocking in R} \description{ Provides a means to mock a package function, i.e., temporarily substitute it for testing. Designed as a drop-in replacement for the now deprecated 'testthat::with_mock()' and 'testthat::local_mock()'. } \seealso{ Useful links: \itemize{ \item \url{https://krlmlr.github.io/mockr/} \item \url{https://github.com/krlmlr/mockr} \item Report bugs at \url{https://github.com/krlmlr/mockr/issues} } } \author{ \strong{Maintainer}: Kirill Müller \email{kirill@cynkra.com} } \keyword{internal} mockr/DESCRIPTION0000644000176200001440000000164014366454362013111 0ustar liggesusersPackage: mockr Title: Mocking in R Version: 0.2.1 Date: 2023-01-30 Authors@R: person(given = "Kirill", family = "M\u00fcller", role = c("aut", "cre"), email = "kirill@cynkra.com") Description: Provides a means to mock a package function, i.e., temporarily substitute it for testing. Designed as a drop-in replacement for the now deprecated 'testthat::with_mock()' and 'testthat::local_mock()'. License: GPL-3 URL: https://krlmlr.github.io/mockr/, https://github.com/krlmlr/mockr BugReports: https://github.com/krlmlr/mockr/issues Imports: rlang, withr Suggests: covr, fs, knitr, pkgload, rmarkdown, testthat, usethis VignetteBuilder: knitr Encoding: UTF-8 RoxygenNote: 7.2.3 NeedsCompilation: no Packaged: 2023-02-01 04:25:50 UTC; kirill Author: Kirill Müller [aut, cre] Maintainer: Kirill Müller Repository: CRAN Date/Publication: 2023-02-01 12:20:02 UTC mockr/build/0000755000176200001440000000000014366364716012504 5ustar liggesusersmockr/build/vignette.rds0000644000176200001440000000031514366364716015042 0ustar liggesusersb```b`abb`b2 1# 'O. MAJd+gd(Uh(Aa ^, &$eyz]R RR@g;<E T [fN*ސ89 d Bw(,/׃ @?{49'ݣ\)%ziE@ wOЮmockr/tests/0000755000176200001440000000000014203657336012540 5ustar liggesusersmockr/tests/testthat/0000755000176200001440000000000014366454362014404 5ustar liggesusersmockr/tests/testthat/test-mock.R0000644000176200001440000001113614203657336016433 0ustar liggesuserscontext("Mock") test_that("direct mocking via with_mock()", { with_mock( mockee = function() 42, { expect_equal(mockee(), 42) } ) }) test_that("direct mocking via local_mock()", { local({ local_mock(mockee = function() 42) expect_equal(mockee(), 42) }) expect_error(mockee()) }) test_that("direct and indirect mocking, also with depth", { local_mock(mockee = function() 42) expect_equal(mockee(), 42) expect_equal(mocker(), 42) expect_equal(mockee3(), 42) }) test_that("direct and indirect mocking with dot (#4)", { local_mock(.mockee = function() 42) expect_equal(.mockee(), 42) expect_equal(.mocker(), 42) }) test_that("infinite depth", { call_mockee <- function() mockee() local_mock(mockee = function() 42) expect_equal(call_mockee(), 42) }) test_that("mocked function is restored on error", { expect_error( with_mock( mockee = function(x, y, ...) list(equal = TRUE, message = "TRUE"), { stop("Simulated error") } ), "Simulated error" ) expect_error(mockee()) }) test_that("non-empty mock with return value", { expect_true( with_mock( mockee = function(x, y, ...) list(equal = TRUE, message = "TRUE"), { TRUE } ) ) }) test_that("nested local_mock()", { local({ local_mock(mockee = function() mockee2()) local_mock(mockee2 = function() 42) expect_equal(mockee(), 42) }) expect_error(mockee()) expect_error(mockee2()) }) test_that("nested with_mock()", { with_mock( mockee = function() mockee2(), { with_mock( mockee2 = function() 42, { expect_equal(mockee(), 42) } ) expect_error(mockee2()) } ) expect_error(mockee()) expect_error(mockee2()) }) test_that("qualified mock names warn", { expect_warning( local_mock("mockr::mockee" = function() 42), "cannot mock functions defined in other packages" ) }) test_that("can't mock non-existing", { expect_error(local_mock(..bogus.. = identity), "[.][.]bogus[.][.] not found in environment mockr") }) test_that("can't mock non-function", { expect_error(local_mock(some_symbol = FALSE), "some_symbol is not a function in environment mockr") }) test_that("empty or no-op mock", { expect_warning(local_mock(), "Not mocking anything") expect_warning(expect_null(with_mock()), "Not (?:mocking|evaluating) anything", all = TRUE) expect_warning(expect_true(with_mock(TRUE)), "Not mocking anything") expect_warning(expect_null(with_mock(mockee = function() {})), "Not evaluating anything") expect_warning(expect_false(withVisible(with_mock(invisible(5)))$visible), "Not mocking anything") }) test_that("multi local_mock()", { local_mock( mockee = function() 1, mockee2 = function() 2 ) expect_equal(mockee(), 1) expect_equal(mockee2(), 2) expect_equal(mockee3(), 1) }) test_that("multi-mock", { expect_equal( with_mock( mockee = function() 1, mockee2 = function() 2, { mockee() } ), 1 ) expect_equal( with_mock( mockee = function() 1, mockee2 = function() 2, { mockee2() } ), 2 ) expect_equal( with_mock( mockee = function() 1, mockee2 = function() 2, { mockee3() } ), 1 ) }) test_that("un-braced (#15)", { expect_warning( expect_true(with_mock(TRUE, mockee = identity)), "braced expression" ) }) test_that("multiple return values", { expect_warning( expect_true(with_mock(FALSE, TRUE, mockee = identity)), "multiple" ) expect_warning( expect_equal(with_mock({ 3 }, mockee = identity, 5), { 5 }), "multiple" ) }) test_that("can access variables defined in function", { x <- 5 expect_equal(with_mock({ x }, mockee = identity), 5) }) test_that("changes to variables are preserved between calls and visible outside", { x <- 1 expect_warning(with_mock( mockee = identity, x <- 3, expect_equal(x, 3) )) expect_equal(x, 3) }) test_that("mocks can access local variables", { value <- TRUE with_mock( { expect_true(mockee()) }, mockee = function() {value} ) }) test_that("mocks can update local variables", { value <- TRUE with_mock( { expect_false(mockee()) }, mockee = function() { value <<- FALSE; value } ) expect_false(value) }) test_that("mocks are overridden by local functons", { mockee <- function() stop("Still not mocking") expect_warning(local_mock(mockee = function() TRUE), "evaluation.*mockee") expect_true(mockee()) }) mockr/tests/testthat.R0000644000176200001440000000006614203657336014525 0ustar liggesuserslibrary(testthat) library(mockr) test_check("mockr") mockr/vignettes/0000755000176200001440000000000014366364716013415 5ustar liggesusersmockr/vignettes/mockr.Rmd0000644000176200001440000001455114203663441015165 0ustar liggesusers--- title: "Mocking with mockr" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Mocking with mockr} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", error = (.Platform$OS.type == "windows") ) set.seed(20201218) ``` The mockr package helps testing code that relies on functions that are slow, have unintended side effects or access resources that may not be available when testing. It allows replacing such functions with deterministic [*mock functions*](https://en.wikipedia.org/wiki/Mock_object). This article gives an overview and introduces a few techniques. ```{r setup} library(mockr) ``` ## General idea Let's assume a function `access_resource()` that accesses some resource. This works in normal circumstances, but not during tests. A function `work_with_resource()` works with that resource. How can we test `work_with_resource()` without adding too much logic to the implementation? ```{r fun-def} access_resource <- function() { message("Trying to access resource...") # For some reason we can't access the resource in our tests. stop("Can't access resource now.") } work_with_resource <- function() { resource <- access_resource() message("Fetched resource: ", resource) invisible(resource) } ``` In our example, calling the worker function gives an error: ```{r example-error, error = TRUE} work_with_resource() ``` We can use `local_mock()` to temporarily replace the implementation of `access_resource()` with one that doesn't throw an error: ```{r example-remedy} access_resource_for_test <- function() { # We return a value that's good enough for testing # and can be computed quickly: 42 } local({ # Here, we override the function that raises the error local_mock(access_resource = access_resource_for_test) work_with_resource() }) ``` The use of `local()` here is required for technical reasons. This package is most useful in conjunction with testthat, the remainder of this article will focus on that use case. ## Create demo package We create a package called {mocktest} for demonstration. For this demo, the package is created in a temporary directory. A real project will live somewhere in your home directory. The `usethis::create_package()` function sets up a package project ready for development. The output shows the details of the package created. ```{r work-around-desc-bug-1, echo = FALSE} # Fixed in https://github.com/r-lib/desc/commit/daece0e5816e17a461969489bfdda2d50b4f5fe5, requires desc > 1.4.0 desc_options <- options(cli.num_colors = 1) ``` ```{r create-package} pkg <- usethis::create_package(file.path(tempdir(), "mocktest")) ``` ```{r work-around-desc-bug-2, echo = FALSE} options(desc_options) ``` In an interactive RStudio session, a new window opens. Users of other environments would change the working directory manually. For this demo, we manually set the active project. ```{r set-focus, include = FALSE} wd <- getwd() knitr::knit_hooks$set( pkg = function(before, options, envir) { if (before) { wd <<- setwd(pkg) } else { setwd(wd) } invisible() } ) knitr::opts_chunk$set(pkg = TRUE) ``` ```{r pkg-location} usethis::proj_set() ``` The infrastructure files and directories that comprise a minimal R package are created: ```{r dir-tree} fs::dir_tree() ``` ## Import function We copy the functions from the previous example (under different names) into the package. Normally we would use a text editor: ```{bash import} cat > R/resource.R <<"EOF" access_resource_pkg <- function() { message("Trying to access resource...") # For some reason we can't access the resource in our tests. stop("Can't access resource now.") } work_with_resource_pkg <- function() { resource <- access_resource_pkg() message("Fetched resource: ", resource) invisible(resource) } EOF ``` Loading the package and calling the function gives the error we have seen before: ```{r run-pkg, error = TRUE} pkgload::load_all() work_with_resource_pkg() ``` ## Adding test with mock We create a test that tests `work_with_resource_pkg()`, mocking `access_resource_pkg()`. We need to prefix with the package name, because testthat provides its own `testthat::local_mock()` which is now deprecated. ```{r test} usethis::use_testthat() ``` ```{bash create-test} cat > tests/testthat/test-resource.R <<"EOF" test_that("Can work with resource", { mockr::local_mock(access_resource_pkg = function() { 42 }) expect_message( expect_equal(work_with_resource_pkg(), 42) ) }) EOF ``` The test succeeds: ```{r error = TRUE} testthat::test_local(reporter = "location") ``` ## Run individual tests mockr is aware of testthat and will work even if executing the tests in the current session. This is especially handy if you want to troubleshoot single tests: ```{r test-manually} test_that("Can work with resource", { mockr::local_mock(access_resource_pkg = function() { 42 }) expect_message( expect_equal(work_with_resource_pkg(), 42) ) }) ``` ## Write wrapper functions mockr can only mock functions in the current package. To substitute implementations of functions in other packages, create wrappers in your package and use these wrappers exclusively. The example below demonstrates a `d6()` function that is used to get the value of a random die throw. Instead of using `runif()` directly, this function uses `my_runif()` which wraps `runif()`. ```{bash runif} cat > R/runif.R <<"EOF" my_runif <- function(...) { runif(...) } d6 <- function() { trunc(my_runif(1, 0, 6)) + 1 } EOF ``` ```{r} pkgload::load_all() ``` This allows testing the behavior of `d6()`: ```{r test-runif} test_that("d6() works correctly", { seq <- c(0.32, 5.4, 5, 2.99) my_runif_mock <- function(...) { on.exit(seq <<- seq[-1]) seq[[1]] } mockr::local_mock(my_runif = my_runif_mock) expect_equal(d6(), 1) expect_equal(d6(), 6) expect_equal(d6(), 6) expect_equal(d6(), 3) }) ``` ## Mock S3 methods mockr cannot substitute implementations of S3 methods. To substitute methods for a class `"foo"`, implement a subclass and add new methods only for that subclass. The pillar package contains [an example](https://github.com/r-lib/pillar/blob/fd6376eca74e9748ed616c49f906529eaee68df9/tests/testthat/helper-unknown-rows.R) where a class with changed behavior for `dim()` and `head()` for the sole purpose of testing. mockr/R/0000755000176200001440000000000014365504211011567 5ustar liggesusersmockr/R/utils.R0000644000176200001440000000020714203657336013061 0ustar liggesusersvlapply <- function(X, FUN, ..., USE.NAMES = TRUE) { vapply(X = X, FUN = FUN, FUN.VALUE = logical(1L), ..., USE.NAMES = USE.NAMES) } mockr/R/with-mock.R0000644000176200001440000001032614366146274013632 0ustar liggesusers#' Mock functions in a package #' #' `local_mock()` temporarily substitutes implementations of package functions. #' This is useful for testing code that relies on functions that are #' slow, have unintended side effects or access resources that may not be #' available when testing. #' #' This works by adding a shadow environment as a parent of the environment #' in which the expressions are evaluated. Everything happens at the R level, #' but only functions in your own package can be mocked. #' Otherwise, the implementation is modeled after the original version in the #' `testthat` package, which is now deprecated. #' #' @param ... `[any]`\cr Named arguments redefine mocked functions. #' An unnamed argument containing code in braces (`{}`) should be provided #' to `with_mock()`, #' it will be evaluated after mocking the functions. #' Use `:=` to mock functions that start with a dot #' to avoid potential collision with current or future arguments #' to `with_mock()` or `local_mock()`. #' Passing more than one unnamed argument to `with_mock()`, #' or code that is not inside braces, gives a warning. #' @param .parent `[environment]`\cr the environment in which to evaluate the expressions, #' defaults to [parent.frame()]. Usually doesn't need to be changed. #' @param .env `[environment]`\cr the environment in which to patch the functions, #' defaults to [topenv()]. Usually doesn't need to be changed. #' @param .defer_env `[environment]`\cr #' Attach exit handlers to this environment. #' Typically, this should be either the current environment #' or a parent frame (accessed through [parent.frame()]). #' This argument is passed on as `envir` to [withr::defer()]. #' @return #' `local_mock()` returns `NULL`, invisibly. #' @references Suraj Gupta (2012): [How R Searches And Finds Stuff](https://blog.thatbuthow.com/how-r-searches-and-finds-stuff/) #' @export #' @examples #' some_func <- function() stop("oops") #' some_other_func <- function() some_func() #' my_env <- environment() #' #' tester_func <- function() { #' # The default for .env works well most of the time, #' # unfortunately not in examples #' local_mock(some_func = function() 42, .env = my_env) #' some_other_func() #' } #' try(some_other_func()) #' tester_func() local_mock <- function(..., .parent = parent.frame(), .env = get_mock_env(.parent), .defer_env = parent.frame()) { dots <- enquos(...) check_dots_env(dots, .parent) if (length(get_code_dots(dots, warn = FALSE)) > 0) { abort("All arguments to `local_mock()` must be named.") } mock_funs <- get_mock_dots(dots) if (length(mock_funs) == 0) { return() } mock_env <- create_mock_env( mock_funs, .env = .env, .parent = .parent, .defer_env = .defer_env ) local_mock_env(mock_env, .parent, .defer_env) invisible() } #' @description #' `with_mock()` substitutes, runs code locally, and restores in one go. #' @return #' `with_mock()` returns the result of the last unnamed argument. #' Visibility is preserved. #' @rdname local_mock #' @export #' @examples #' #' tester_func_with <- function() { #' with_mock( #' some_func = function() 42, #' .env = my_env, #' { #' some_other_func() #' } #' ) #' } #' tester_func_with() with_mock <- function(..., .parent = parent.frame(), .env = get_mock_env(.parent)) { dots <- enquos(...) check_dots_env(dots, .parent) mock_funs <- get_mock_dots(dots) mock_env <- create_mock_env(mock_funs, .env = .env, .parent = .parent) local_mock_env(mock_env, .parent) evaluate_code(get_code_dots(dots), .parent) } get_mock_dots <- function(dots) { mock_qual_names <- names2(dots) if (all(mock_qual_names == "")) { warn("Not mocking anything. Please use named arguments to specify the functions you want to mock.") list() } else { dots[mock_qual_names != ""] } } get_code_dots <- function(dots, warn = TRUE) { mock_qual_names <- names2(dots) if (all(mock_qual_names != "")) { if (warn) { warn("Not evaluating anything. Please use unnamed arguments to specify expressions you want to evaluate.") } list() } else { dots[mock_qual_names == ""] } } mockr/R/mock.R0000644000176200001440000000221414203657336012652 0ustar liggesusersextract_mocks <- function(dots, env) { lapply(stats::setNames(nm = names(dots)), function(qual_name) extract_mock(qual_name, dots[[qual_name]], env)) } extract_mock <- function(qual_name, dot, env) { name <- extract_mock_name(qual_name) check_mock(name, env) mock(name = name, new = eval_tidy(dot)) } extract_mock_name <- function(qual_name) { pkg_rx <- ".*[^:]" colons_rx <- "::(?:[:]?)" name_rx <- ".*" pkg_and_name_rx <- sprintf("^(?:(%s)%s)?(%s)$", pkg_rx, colons_rx, name_rx) pkg_name <- gsub(pkg_and_name_rx, "\\1", qual_name) if (pkg_name != "") { warn("`with_mock()` cannot mock functions defined in other packages.") } name <- gsub(pkg_and_name_rx, "\\2", qual_name) name } check_mock <- function(name, env) { orig <- mget(name, envir = env, ifnotfound = list(NULL))[[1]] if (is.null(orig)) { abort(paste0(name, " not found in environment ", environmentName(env), ".")) } if (!is.function(orig)) { abort(paste0(name, " is not a function in environment ", environmentName(env), ".")) } } mock <- function(name, new) { structure(list(name = as.name(name), new_value = new), class = "mock") } mockr/R/mockr-package.R0000644000176200001440000000006214203657336014424 0ustar liggesusers#' @import rlang #' @keywords internal "_PACKAGE" mockr/R/eval.R0000644000176200001440000000144114203657336012651 0ustar liggesusersevaluate_code <- function(code, .parent) { # Special treatment of last element, shortcut is important! if (length(code) == 0L) { return(invisible(NULL)) } if (length(code) > 1) { warn("Passing multiple pieces of code to `with_mock()` is discouraged, use a braced expression instead.") } else if (!is_call(quo_get_expr(code[[1]]), quote(`{`))) { warn("The code passed to `with_mock()` must be a braced expression to get accurate file-line information for failures.") } # Evaluate the code for (expression in code[-length(code)]) { # Can't use eval_tidy(), otherwise changes to variables # are not visible outside # https://github.com/r-lib/rlang/issues/1077 eval(quo_get_expr(expression), .parent) } eval(quo_get_expr(code[[length(code)]]), .parent) } mockr/R/env.R0000644000176200001440000000753114365643003012513 0ustar liggesusers#' Get environment for mocking #' #' Called by default from [with_mock()] to determine #' the environment where to update mocked functions. #' This function is exported to help troubleshooting. #' #' This function works differently depending on #' [testthat::is_testing()]. #' #' Outside testthat, `topenv(.parent)` is returned. #' This was the default for mockr < 0.1.0 and works for many cases. #' #' In testthat, `asNamespace("")` for the tested package is returned. #' The tested package is determined via [testthat::testing_package()]. #' If this is empty (e.g. if a `test_that()` block is run in interactive mode), #' this function looks in the search path for packages loaded by #' [pkgload::load_all()]. #' #' @inheritParams with_mock #' #' @export get_mock_env <- function(.parent = parent.frame()) { top <- topenv(.parent) testing <- is_installed("testthat") && testthat::is_testing() if (!testing) { return(top) } pkg <- testthat::testing_package() if (pkg != "") { return(asNamespace(pkg)) } env <- parent.env(top) for (i in 1:1000) { name <- attr(env, "name") if (!is.null(name)) { if (grepl("^package:", name)) { ns <- sub("^package:", "", name) ns_env <- asNamespace(ns) if (exists(".__DEVTOOLS__", ns_env)) { return(ns_env) } } } env <- parent.env(env) if (identical(env, empty_env())) { break } } warn("No package loaded, using `topenv()` as mocking environment.") top } check_dots_env <- function(dots, .parent) { same <- vlapply(dots, quo_is_env, .parent) if (!all(same)) { abort("Can only evaluate expressions in the parent environment.") } } quo_is_env <- function(quo, env) { quo_env <- quo_get_env(quo) identical(quo_env, env) || identical(quo_env, rlang::empty_env()) } create_mock_env <- function(dots, .env, .parent, .defer_env = parent.frame()) { if (is.character(.env)) .env <- asNamespace(.env) new_funcs <- extract_new_funcs(dots, .env) # check if functions exist in parent environment, replace those instead eval_env_funcs <- mget(names(new_funcs), .parent, mode = "function", ifnotfound = list(NULL)) eval_env_funcs <- eval_env_funcs[!vlapply(eval_env_funcs, is.null)] if (length(eval_env_funcs) > 0) { warn(paste0( "Replacing functions in evaluation environment: ", paste0("`", names(eval_env_funcs), "()`", collapse = ", ") )) withr::defer(populate_env(.parent, eval_env_funcs), envir = .defer_env) populate_env(.parent, new_funcs[names(eval_env_funcs)]) new_funcs <- new_funcs[!(names(new_funcs) %in% names(eval_env_funcs))] } mock_env <- create_mock_env_with_old_funcs(new_funcs, .env, .parent) populate_env(mock_env, new_funcs) mock_env } extract_new_funcs <- function(dots, .env) { mocks <- extract_mocks(dots = dots, env = .env) new_func_names <- lapply(mocks, "[[", "name") new_funcs <- lapply(mocks, "[[", "new_value") names(new_funcs) <- new_func_names new_funcs } create_mock_env_with_old_funcs <- function(new_funcs, .env, .parent) { # retrieve all functions not mocked old_funcs <- as.list(.env, all.names = TRUE) old_funcs <- old_funcs[vlapply(old_funcs, is.function)] old_funcs <- old_funcs[!(names(old_funcs) %in% names(new_funcs))] # Query value visible from .parent to support nesting. # For some reason, this doesn't always exist (#29). for (i in seq_along(old_funcs)) { old_funcs[[i]] <- get0( names(old_funcs)[[i]], .parent, mode = "function", inherits = TRUE, ifnotfound = old_funcs[[i]] ) } # create and populate mocking environment mock_env <- new.env(parent = parent.env(.parent)) old_funcs <- lapply(old_funcs, `environment<-`, mock_env) populate_env(mock_env, old_funcs) mock_env } populate_env <- function(env, funcs) { lapply(names(funcs), function(x) env[[x]] <- funcs[[x]]) } mockr/R/local.R0000644000176200001440000000032414203657336013013 0ustar liggesuserslocal_mock_env <- function(mock_env, .parent, env = parent.frame()) { old_parent <- parent.env(.parent) withr::defer(parent.env(.parent) <- old_parent, env) parent.env(.parent) <- mock_env invisible() } mockr/R/test.R0000644000176200001440000000037214203657336012703 0ustar liggesuserssome_symbol <- 42 mocker <- function() mockee() .mocker <- function() .mockee() mockee <- function() stop("Not mocking") mockee2 <- function() stop("Not mocking (2)") mockee3 <- function() mockee() .mockee <- function() stop("Not mocking (3)") mockr/NEWS.md0000644000176200001440000000240014366006306012463 0ustar liggesusers # mockr 0.2.1 (2023-01-30) ## Bug fixes - More careful querying of functions to be mocked, to avoid errors for `.onLoad()` when testing interactively (#29). ## Chore - Change maintainer e-mail address. # mockr 0.2.0 (2022-04-02) ## Breaking changes - `with_mock()` now requires braces (so that error locations can be reported more accurately) and supports only one expression (#15). ## Features - Functions declared in evaluation environments are now also replaced, with a warning (#5). - New `local_mock()` (#6). - `with_mock()` works when running a `testthat::test_that()` block interactively (#7). - New `get_mock_env()` to make the mocking environment explicit (#7). - Functions that start with a dot can be mocked (#3, #4). ## Documentation - Add "Getting started" vignette (#22). ## Internal - Switch to rlang (#13). - Switch to GitHub Actions (#10). # mockr 0.1 (2017-04-28) Initial CRAN release. - `with_mock()` modeled closely after `testthat::with_mock()`, can only mock in the package under test but avoids fiddling with R's internals. - The `.env` argument now can be a character, but using this argument may lead to different results than `testthat::with_mock()`. mockr/MD50000644000176200001440000000206114366454362011711 0ustar liggesusersfd4822441e24057b6c4282e3066635b5 *DESCRIPTION a45f763c4c8244e776c2518b5ee3873a *NAMESPACE 5383eac8904b18c16985012da7d83c7d *NEWS.md 8aad11423a7f9939defd537e18290ef7 *R/env.R db96ac4c26e35b39e648404fe54e7939 *R/eval.R f6d63f3b5368c0d921cb939f12803894 *R/local.R 9a4d79f5b910d53620cae79e77913852 *R/mock.R 015e9395bf0df10adf39c4822f546e4e *R/mockr-package.R 4e845be33958851607d459c9aeefae80 *R/test.R ab3ccd4a581bbb13f89a0fe4b5c52bfa *R/utils.R 11d37eb4576ebc528f9217e9bc8809ee *R/with-mock.R 9c14da929679d57e30e6dcec5cd2ef4b *README.md c9a10d5c0c7e47d517c9b3ec85345e19 *build/vignette.rds ec5a20024c9c474d85b4071bf53c959c *inst/doc/mockr.R a6faa18d7f55027105273e13e5ff956e *inst/doc/mockr.Rmd 973c0ec63df430d6bb366f9d3f9aab1d *inst/doc/mockr.html c91e391af97bf88b09c8541e2e79decd *man/get_mock_env.Rd 4b705f75d5c84d89eb37cc2b8b99c2e9 *man/local_mock.Rd 63f78f4db787e4b80a6f7deecfa76ef8 *man/mockr-package.Rd e759628ea2d2f3d56f4b132293f03284 *tests/testthat.R f27c2c2736ef6a8fe111fc912f2563c1 *tests/testthat/test-mock.R a6faa18d7f55027105273e13e5ff956e *vignettes/mockr.Rmd mockr/inst/0000755000176200001440000000000014366364716012362 5ustar liggesusersmockr/inst/doc/0000755000176200001440000000000014366364716013127 5ustar liggesusersmockr/inst/doc/mockr.html0000644000176200001440000010061314366364716015131 0ustar liggesusers Mocking with mockr

Mocking with mockr

The mockr package helps testing code that relies on functions that are slow, have unintended side effects or access resources that may not be available when testing. It allows replacing such functions with deterministic mock functions. This article gives an overview and introduces a few techniques.

library(mockr)

General idea

Let’s assume a function access_resource() that accesses some resource. This works in normal circumstances, but not during tests. A function work_with_resource() works with that resource. How can we test work_with_resource() without adding too much logic to the implementation?

access_resource <- function() {
  message("Trying to access resource...")
  # For some reason we can't access the resource in our tests.
  stop("Can't access resource now.")
}

work_with_resource <- function() {
  resource <- access_resource()
  message("Fetched resource: ", resource)
  invisible(resource)
}

In our example, calling the worker function gives an error:

work_with_resource()
#> Trying to access resource...
#> Error in access_resource(): Can't access resource now.

We can use local_mock() to temporarily replace the implementation of access_resource() with one that doesn’t throw an error:

access_resource_for_test <- function() {
  # We return a value that's good enough for testing
  # and can be computed quickly:
  42
}

local({
  # Here, we override the function that raises the error
  local_mock(access_resource = access_resource_for_test)

  work_with_resource()
})
#> Fetched resource: 42

The use of local() here is required for technical reasons. This package is most useful in conjunction with testthat, the remainder of this article will focus on that use case.

Create demo package

We create a package called {mocktest} for demonstration. For this demo, the package is created in a temporary directory. A real project will live somewhere in your home directory. The usethis::create_package() function sets up a package project ready for development. The output shows the details of the package created.

pkg <- usethis::create_package(file.path(tempdir(), "mocktest"))
#> ✔ Creating '/var/folders/dj/yhk9rkx97wn_ykqtnmk18xvc0000gn/T/Rtmp2PXiXa/mocktest/'
#> ✔ Setting active project to '/private/var/folders/dj/yhk9rkx97wn_ykqtnmk18xvc0000gn/T/Rtmp2PXiXa/mocktest'
#> ✔ Creating 'R/'
#> ✔ Writing 'DESCRIPTION'
#> Package: mocktest
#> Title: What the Package Does (One Line, Title Case)
#> Version: 0.0.0.9000
#> Authors@R (parsed):
#>     * First Last <first.last@example.com> [aut, cre] (YOUR-ORCID-ID)
#> Description: What the package does (one paragraph).
#> License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a
#>     license
#> Encoding: UTF-8
#> Roxygen: list(markdown = TRUE)
#> RoxygenNote: 7.2.3
#> ✔ Writing 'NAMESPACE'
#> ✔ Setting active project to '<no active project>'

In an interactive RStudio session, a new window opens. Users of other environments would change the working directory manually. For this demo, we manually set the active project.

usethis::proj_set()
#> ✔ Setting active project to
#> '/private/var/folders/dj/yhk9rkx97wn_ykqtnmk18xvc0000gn/T/Rtmp2PXiXa/mocktest'

The infrastructure files and directories that comprise a minimal R package are created:

fs::dir_tree()
#> .
#> ├── DESCRIPTION
#> ├── NAMESPACE
#> └── R

Import function

We copy the functions from the previous example (under different names) into the package. Normally we would use a text editor:

cat > R/resource.R <<"EOF"
access_resource_pkg <- function() {
  message("Trying to access resource...")
  # For some reason we can't access the resource in our tests.
  stop("Can't access resource now.")
}

work_with_resource_pkg <- function() {
  resource <- access_resource_pkg()
  message("Fetched resource: ", resource)
  invisible(resource)
}
EOF

Loading the package and calling the function gives the error we have seen before:

pkgload::load_all()
#> ℹ Loading mocktest
work_with_resource_pkg()
#> Trying to access resource...
#> Error in access_resource_pkg(): Can't access resource now.

Adding test with mock

We create a test that tests work_with_resource_pkg(), mocking access_resource_pkg(). We need to prefix with the package name, because testthat provides its own testthat::local_mock() which is now deprecated.

usethis::use_testthat()
#> ✔ Adding 'testthat' to Suggests field in DESCRIPTION
#> ✔ Setting Config/testthat/edition field in DESCRIPTION to '3'
#> ✔ Creating 'tests/testthat/'
#> ✔ Writing 'tests/testthat.R'
#> • Call `use_test()` to initialize a basic test file and open it for editing.
cat > tests/testthat/test-resource.R <<"EOF"
test_that("Can work with resource", {
  mockr::local_mock(access_resource_pkg = function() {
    42
  })

  expect_message(
    expect_equal(work_with_resource_pkg(), 42)
  )
})
EOF

The test succeeds:

testthat::test_local(reporter = "location")
#> 
#> Attaching package: 'testthat'
#> The following objects are masked from 'package:mockr':
#> 
#>     local_mock, with_mock
#> Start test: Can work with resource
#>   'test-resource.R:6' [success]
#>   'test-resource.R:6' [success]
#> End test: Can work with resource

Run individual tests

mockr is aware of testthat and will work even if executing the tests in the current session. This is especially handy if you want to troubleshoot single tests:

test_that("Can work with resource", {
  mockr::local_mock(access_resource_pkg = function() {
    42
  })

  expect_message(
    expect_equal(work_with_resource_pkg(), 42)
  )
})
#> Test passed 🥳

Write wrapper functions

mockr can only mock functions in the current package. To substitute implementations of functions in other packages, create wrappers in your package and use these wrappers exclusively.

The example below demonstrates a d6() function that is used to get the value of a random die throw. Instead of using runif() directly, this function uses my_runif() which wraps runif().

cat > R/runif.R <<"EOF"
my_runif <- function(...) {
  runif(...)
}

d6 <- function() {
  trunc(my_runif(1, 0, 6)) + 1
}
EOF
pkgload::load_all()
#> ℹ Loading mocktest

This allows testing the behavior of d6():

test_that("d6() works correctly", {
  seq <- c(0.32, 5.4, 5, 2.99)
  my_runif_mock <- function(...) {
    on.exit(seq <<- seq[-1])
    seq[[1]]
  }

  mockr::local_mock(my_runif = my_runif_mock)

  expect_equal(d6(), 1)
  expect_equal(d6(), 6)
  expect_equal(d6(), 6)
  expect_equal(d6(), 3)
})
#> Test passed 😸

Mock S3 methods

mockr cannot substitute implementations of S3 methods. To substitute methods for a class "foo", implement a subclass and add new methods only for that subclass. The pillar package contains an example where a class with changed behavior for dim() and head() for the sole purpose of testing.

mockr/inst/doc/mockr.Rmd0000644000176200001440000001455114203663441014677 0ustar liggesusers--- title: "Mocking with mockr" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Mocking with mockr} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", error = (.Platform$OS.type == "windows") ) set.seed(20201218) ``` The mockr package helps testing code that relies on functions that are slow, have unintended side effects or access resources that may not be available when testing. It allows replacing such functions with deterministic [*mock functions*](https://en.wikipedia.org/wiki/Mock_object). This article gives an overview and introduces a few techniques. ```{r setup} library(mockr) ``` ## General idea Let's assume a function `access_resource()` that accesses some resource. This works in normal circumstances, but not during tests. A function `work_with_resource()` works with that resource. How can we test `work_with_resource()` without adding too much logic to the implementation? ```{r fun-def} access_resource <- function() { message("Trying to access resource...") # For some reason we can't access the resource in our tests. stop("Can't access resource now.") } work_with_resource <- function() { resource <- access_resource() message("Fetched resource: ", resource) invisible(resource) } ``` In our example, calling the worker function gives an error: ```{r example-error, error = TRUE} work_with_resource() ``` We can use `local_mock()` to temporarily replace the implementation of `access_resource()` with one that doesn't throw an error: ```{r example-remedy} access_resource_for_test <- function() { # We return a value that's good enough for testing # and can be computed quickly: 42 } local({ # Here, we override the function that raises the error local_mock(access_resource = access_resource_for_test) work_with_resource() }) ``` The use of `local()` here is required for technical reasons. This package is most useful in conjunction with testthat, the remainder of this article will focus on that use case. ## Create demo package We create a package called {mocktest} for demonstration. For this demo, the package is created in a temporary directory. A real project will live somewhere in your home directory. The `usethis::create_package()` function sets up a package project ready for development. The output shows the details of the package created. ```{r work-around-desc-bug-1, echo = FALSE} # Fixed in https://github.com/r-lib/desc/commit/daece0e5816e17a461969489bfdda2d50b4f5fe5, requires desc > 1.4.0 desc_options <- options(cli.num_colors = 1) ``` ```{r create-package} pkg <- usethis::create_package(file.path(tempdir(), "mocktest")) ``` ```{r work-around-desc-bug-2, echo = FALSE} options(desc_options) ``` In an interactive RStudio session, a new window opens. Users of other environments would change the working directory manually. For this demo, we manually set the active project. ```{r set-focus, include = FALSE} wd <- getwd() knitr::knit_hooks$set( pkg = function(before, options, envir) { if (before) { wd <<- setwd(pkg) } else { setwd(wd) } invisible() } ) knitr::opts_chunk$set(pkg = TRUE) ``` ```{r pkg-location} usethis::proj_set() ``` The infrastructure files and directories that comprise a minimal R package are created: ```{r dir-tree} fs::dir_tree() ``` ## Import function We copy the functions from the previous example (under different names) into the package. Normally we would use a text editor: ```{bash import} cat > R/resource.R <<"EOF" access_resource_pkg <- function() { message("Trying to access resource...") # For some reason we can't access the resource in our tests. stop("Can't access resource now.") } work_with_resource_pkg <- function() { resource <- access_resource_pkg() message("Fetched resource: ", resource) invisible(resource) } EOF ``` Loading the package and calling the function gives the error we have seen before: ```{r run-pkg, error = TRUE} pkgload::load_all() work_with_resource_pkg() ``` ## Adding test with mock We create a test that tests `work_with_resource_pkg()`, mocking `access_resource_pkg()`. We need to prefix with the package name, because testthat provides its own `testthat::local_mock()` which is now deprecated. ```{r test} usethis::use_testthat() ``` ```{bash create-test} cat > tests/testthat/test-resource.R <<"EOF" test_that("Can work with resource", { mockr::local_mock(access_resource_pkg = function() { 42 }) expect_message( expect_equal(work_with_resource_pkg(), 42) ) }) EOF ``` The test succeeds: ```{r error = TRUE} testthat::test_local(reporter = "location") ``` ## Run individual tests mockr is aware of testthat and will work even if executing the tests in the current session. This is especially handy if you want to troubleshoot single tests: ```{r test-manually} test_that("Can work with resource", { mockr::local_mock(access_resource_pkg = function() { 42 }) expect_message( expect_equal(work_with_resource_pkg(), 42) ) }) ``` ## Write wrapper functions mockr can only mock functions in the current package. To substitute implementations of functions in other packages, create wrappers in your package and use these wrappers exclusively. The example below demonstrates a `d6()` function that is used to get the value of a random die throw. Instead of using `runif()` directly, this function uses `my_runif()` which wraps `runif()`. ```{bash runif} cat > R/runif.R <<"EOF" my_runif <- function(...) { runif(...) } d6 <- function() { trunc(my_runif(1, 0, 6)) + 1 } EOF ``` ```{r} pkgload::load_all() ``` This allows testing the behavior of `d6()`: ```{r test-runif} test_that("d6() works correctly", { seq <- c(0.32, 5.4, 5, 2.99) my_runif_mock <- function(...) { on.exit(seq <<- seq[-1]) seq[[1]] } mockr::local_mock(my_runif = my_runif_mock) expect_equal(d6(), 1) expect_equal(d6(), 6) expect_equal(d6(), 6) expect_equal(d6(), 3) }) ``` ## Mock S3 methods mockr cannot substitute implementations of S3 methods. To substitute methods for a class `"foo"`, implement a subclass and add new methods only for that subclass. The pillar package contains [an example](https://github.com/r-lib/pillar/blob/fd6376eca74e9748ed616c49f906529eaee68df9/tests/testthat/helper-unknown-rows.R) where a class with changed behavior for `dim()` and `head()` for the sole purpose of testing. mockr/inst/doc/mockr.R0000644000176200001440000000626114366364716014372 0ustar liggesusers## ---- include = FALSE--------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", error = (.Platform$OS.type == "windows") ) set.seed(20201218) ## ----setup-------------------------------------------------------------------- library(mockr) ## ----fun-def------------------------------------------------------------------ access_resource <- function() { message("Trying to access resource...") # For some reason we can't access the resource in our tests. stop("Can't access resource now.") } work_with_resource <- function() { resource <- access_resource() message("Fetched resource: ", resource) invisible(resource) } ## ----example-error, error = TRUE---------------------------------------------- work_with_resource() ## ----example-remedy----------------------------------------------------------- access_resource_for_test <- function() { # We return a value that's good enough for testing # and can be computed quickly: 42 } local({ # Here, we override the function that raises the error local_mock(access_resource = access_resource_for_test) work_with_resource() }) ## ----work-around-desc-bug-1, echo = FALSE------------------------------------- # Fixed in https://github.com/r-lib/desc/commit/daece0e5816e17a461969489bfdda2d50b4f5fe5, requires desc > 1.4.0 desc_options <- options(cli.num_colors = 1) ## ----create-package----------------------------------------------------------- pkg <- usethis::create_package(file.path(tempdir(), "mocktest")) ## ----work-around-desc-bug-2, echo = FALSE------------------------------------- options(desc_options) ## ----set-focus, include = FALSE----------------------------------------------- wd <- getwd() knitr::knit_hooks$set( pkg = function(before, options, envir) { if (before) { wd <<- setwd(pkg) } else { setwd(wd) } invisible() } ) knitr::opts_chunk$set(pkg = TRUE) ## ----pkg-location------------------------------------------------------------- usethis::proj_set() ## ----dir-tree----------------------------------------------------------------- fs::dir_tree() ## ----run-pkg, error = TRUE---------------------------------------------------- pkgload::load_all() work_with_resource_pkg() ## ----test--------------------------------------------------------------------- usethis::use_testthat() ## ----error = TRUE------------------------------------------------------------- testthat::test_local(reporter = "location") ## ----test-manually------------------------------------------------------------ test_that("Can work with resource", { mockr::local_mock(access_resource_pkg = function() { 42 }) expect_message( expect_equal(work_with_resource_pkg(), 42) ) }) ## ----------------------------------------------------------------------------- pkgload::load_all() ## ----test-runif--------------------------------------------------------------- test_that("d6() works correctly", { seq <- c(0.32, 5.4, 5, 2.99) my_runif_mock <- function(...) { on.exit(seq <<- seq[-1]) seq[[1]] } mockr::local_mock(my_runif = my_runif_mock) expect_equal(d6(), 1) expect_equal(d6(), 6) expect_equal(d6(), 6) expect_equal(d6(), 3) })