Mock in more places (#1748)

Since the package environment is locked, we can only change bindings there, not add them. But that's ok because if we're trying to mock something that's not in the package, it must be imported from another namespace.

Author: hadley

NAMESPACE

@@ -15,7 +15,6 @@ S3method(format,expectation_success)
 S3method(format,mismatch_character)
 S3method(format,mismatch_numeric)
 S3method(is_informative_error,default)
-S3method(mockable_generic,integer)
 S3method(output_replay,character)
 S3method(output_replay,error)
 S3method(output_replay,message)
@@ -30,6 +29,7 @@ S3method(print,testthat_results)
 S3method(snapshot_replay,character)
 S3method(snapshot_replay,condition)
 S3method(snapshot_replay,source)
+S3method(test_mock_method,integer)
 S3method(testthat_print,default)
 export("%>%")
 export(CheckReporter)

NEWS.md

@@ -1,5 +1,8 @@
 # testthat (development version)
 
+* `with_mocked_bindings()` and `local_mocked_bindings()` can now bind in the
+  imports namespace too.
+
 # testthat 3.1.7
 
 * `expect_setequal()` gives more actionable feedback (#1657).

R/mock.R

@@ -151,8 +151,3 @@ reset_mock <- function(mock) {
 is_base_pkg <- function(x) {
   x %in% rownames(utils::installed.packages(priority = "base"))
 }
-
-test_mock1 <- function() {
-  test_mock2()
-}
-test_mock2 <- function() 10

R/mock2.R

@@ -30,11 +30,21 @@ local_mocked_bindings <- function(..., .package = NULL, .env = caller_env()) {
   .package <- .package %||% dev_package()
   ns_env <- ns_env(.package)
 
-  # Unlock bindings and set values
-  nms <- names(bindings)
-  locked <- env_binding_unlock(ns_env, nms)
-  withr::defer(env_binding_lock(ns_env, nms[locked]), envir = .env)
-  local_bindings(!!!bindings, .env = ns_env, .frame = .env)
+  # Rebind, first looking in package namespace, then imports, then the base
+  # namespace, then the global environment
+  envs <- c(list(ns_env), env_parents(ns_env))
+  bindings_found <- rep_named(names(bindings), FALSE)
+  for (env in envs) {
+    this_bindings <- env_has(env, names(bindings)) & !bindings_found
+
+    local_bindings_unlock(!!!bindings[this_bindings], .env = env, .frame = .env)
+    bindings_found <- bindings_found | this_bindings
+  }
+
+  if (any(!bindings_found)) {
+    missing <- names(bindings)[!bindings_found]
+    cli::cli_abort("Can't find binding for {.arg {missing}}")
+  }
 
   invisible()
 }
@@ -48,6 +58,23 @@ with_mocked_bindings <- function(code, ..., .package = NULL) {
 
 # helpers -----------------------------------------------------------------
 
+# Wrapper around local_bindings() that automatically unlocks and takes
+# list of bindings.
+local_bindings_unlock <- function(..., .env = .frame, .frame = caller_env()) {
+  bindings <- list2(...)
+  if (length(bindings) == 0) {
+    return()
+  }
+
+  nms <- names(bindings)
+  locked <- env_binding_unlock(.env, nms)
+  withr::defer(env_binding_lock(.env, nms[locked]), envir = .frame)
+
+  local_bindings(!!!bindings, .env = .env, .frame = .frame)
+
+  invisible()
+}
+
 dev_package <- function() {
   if (is_testing() && testing_package() != "") {
     testing_package()
@@ -81,11 +108,29 @@ check_bindings <- function(x, error_call = caller_env()) {
   }
 }
 
-# In package
-mockable_generic <- function(x) {
-  UseMethod("mockable_generic")
+# For testing -------------------------------------------------------------
+
+test_mock_package <- function() {
+  test_mock_package2()
+}
+test_mock_package2 <- function() "y"
+
+test_mock_base <- function() {
+  identity("y")
+}
+
+test_mock_imports <- function() {
+  as.character(sym("x"))
+}
+
+test_mock_namespaced <- function() {
+  as.character(rlang::sym("x"))
+}
+
+test_mock_method <- function(x) {
+  UseMethod("test_mock_method")
 }
 #' @export
-mockable_generic.integer <- function(x) {
-  1
+test_mock_method.integer <- function(x) {
+  "y"
 }

tests/testthat/_snaps/mock2.md

@@ -11,3 +11,11 @@
       Error in `local_mocked_bindings()`:
       ! All elements of `...` must be functions.
 
+# can't mock bindings that don't exist
+
+    Code
+      local_mocked_bindings(f = function() "x")
+    Condition
+      Error in `local_mocked_bindings()`:
+      ! Can't find binding for `f`
+

tests/testthat/test-mock.R

@@ -7,18 +7,18 @@ test_that("can change value of internal function", {
   local_edition(2)
 
   with_mock(
-    test_mock2 = function() 5,
-    expect_equal(test_mock1(), 5)
+    test_mock_package2 = function() 5,
+    expect_equal(test_mock_package(), 5)
   )
 
   # and value is restored on error
   expect_error(
     with_mock(
-      test_mock2 = function() 5,
+      test_mock_package2 = function() 5,
       stop("!")
     )
   )
-  expect_equal(test_mock1(), 10)
+  expect_equal(test_mock_package(), "y")
 })
 
 
@@ -27,8 +27,8 @@ test_that("mocks can access local variables", {
   x <- 5
 
   with_mock(
-    test_mock2 = function() x,
-    expect_equal(test_mock1(), 5)
+    test_mock_package2 = function() x,
+    expect_equal(test_mock_package(), 5)
   )
 })
 

tests/testthat/test-mock2.R

@@ -1,40 +1,43 @@
 test_that("with_mocked_bindings affects local bindings", {
-  out <- with_mocked_bindings(test_mock1(), test_mock2 = function() "x")
+  out <- with_mocked_bindings(
+    test_mock_package(),
+    test_mock_package2 = function() "x"
+  )
   expect_equal(out, "x")
-
-  expect_equal(test_mock1(), 10)
+  expect_equal(test_mock_package(), "y")
 })
 
 test_that("local_mocked_bindings affects local bindings", {
   local({
-    local_mocked_bindings(test_mock2 = function() "x")
-    expect_equal(test_mock1(), "x")
+    local_mocked_bindings(test_mock_package2 = function() "x")
+    expect_equal(test_mock_package(), "x")
   })
 
-  expect_equal(test_mock1(), 10)
+  expect_equal(test_mock_package(), "y")
 })
 
-test_that("local_mocked_bindings affects S3 methods", {
-  skip("currently fails")
+test_that("unlocks and relocks binding if needed", {
+  expect_true(env_binding_are_locked(base_env(), "identity"))
 
   local({
-    local_mocked_bindings(mockable_generic.integer = function(x) 2)
-    expect_equal(mockable_generic(1L), 2)
+    local_mocked_bindings(identity = function(...) "x")
+    expect_false(env_binding_are_locked(base_env(), "identity"))
   })
-  expect_equal(mockable_generic(1L), 1)
+
+  expect_true(env_binding_are_locked(base_env(), "identity"))
 })
 
 test_that("can make wrapper", {
   local_mock_x <- function(env = caller_env()) {
-    local_mocked_bindings(test_mock2 = function() "x", .env = env)
+    local_mocked_bindings(test_mock_package2 = function() "x", .env = env)
   }
 
   local({
     local_mock_x()
-    expect_equal(test_mock1(), "x")
+    expect_equal(test_mock_package(), "x")
   })
 
-  expect_equal(test_mock1(), 10)
+  expect_equal(test_mock_package(), "y")
 })
 
 test_that("with_mocked_bindings() validates its inputs", {
@@ -43,3 +46,34 @@ test_that("with_mocked_bindings() validates its inputs", {
     with_mocked_bindings(1 + 1, x = 2)
   })
 })
+
+# -------------------------------------------------------------------------
+
+test_that("can mock bindings from imports", {
+  local_mocked_bindings(readLines = function(...) "x")
+  expect_equal(test_mock_imports(), "x")
+})
+
+test_that("can mock bindings from base", {
+  local_mocked_bindings(identity = function(...) "x")
+  expect_equal(test_mock_base(), "x")
+})
+
+test_that("can mock binding in another package", {
+  local_mocked_bindings(sym = function(...) "x", .package = "rlang")
+  expect_equal(test_mock_namespaced(), "x")
+})
+
+test_that("can mock S3 methods", {
+  skip("currently fails")
+
+  local({
+    local_mocked_bindings(test_mock_method.integer = function(...) "x")
+    expect_equal(test_mock_method(1L), "x")
+  })
+  expect_equal(test_mock_method(1L), "y")
+})
+
+test_that("can't mock bindings that don't exist", {
+  expect_snapshot(local_mocked_bindings(f = function() "x"), error = TRUE)
+})