Enhance OO mocking (#2303)

Make it possible to mock methods that don't exist, and make it possible to mock the absence of a method.

Fixes #2302

Author: hadley

NEWS.md

@@ -1,5 +1,6 @@
 # testthat 3.3.1
 
+* `local_mocked_s3_method()` and `local_mocked_s4_method()` can now mock methods that don't already exist, and can use `definition = NULL` to temporarily remove a method. `local_mocked_s4_method()` now also works when the generic is defined in another package (#2302).
 * `expect_snapshot()` now reports the original error class for base errors, rather than `rlang_error` (#2286).
 * `expect_success()` and `expect_failure()` are more clear about what the expectation actually did (#2297).
 * The hint to use `snapshot_download_gh()` is now only emitted when running in a job named "R-CMD-check" (#2300).

R/mock-oo.R

@@ -1,15 +1,16 @@
 #' Mock S3 and S4 methods
 #'
 #' @description
-#' These functions allow you to temporarily override S3 and S4 methods that
-#' already exist. It works by using [registerS3method()]/[setMethod()] to
-#' temporarily replace the original definition.
+#' These functions temporarily override S3 or S4 methods. They can mock
+#' methods that don't already exist, or temporarily remove a method by setting
+#' `definition = NULL`.
 #'
 #' Learn more about mocking in `vignette("mocking")`.
 #'
 #' @param generic A string giving the name of the generic.
 #' @param signature A character vector giving the signature of the method.
-#' @param definition A function providing the method definition.
+#' @param definition A function providing the method definition, or `NULL` to
+#'   temporarily remove the method.
 #' @param frame Calling frame which determines the scope of the mock.
 #'   Only needed when wrapping in another local helper.
 #' @export
@@ -29,16 +30,41 @@ local_mocked_s3_method <- function(
 ) {
   check_string(generic)
   check_string(signature)
-  check_function(definition)
+  check_function(definition, allow_null = TRUE)
 
   old <- utils::getS3method(generic, signature, optional = TRUE)
+
+  # Set the new method, or a pass-through stub if removing
+  definition <- definition %||% function(...) NextMethod()
+  registerS3method(generic, signature, definition, envir = frame)
+
+  # On cleanup, restore old method or remove the one we added
   if (is.null(old)) {
-    cli::cli_abort(
-      "Can't find existing S3 method {.code {generic}.{signature}()}."
+    withr::defer(remove_s3_method(generic, signature, envir = frame), frame)
+  } else {
+    withr::defer(
+      registerS3method(generic, signature, old, envir = frame),
+      frame
     )
   }
-  registerS3method(generic, signature, definition, envir = frame)
-  withr::defer(registerS3method(generic, signature, old, envir = frame), frame)
+
+  invisible()
+}
+
+remove_s3_method <- function(generic, class, envir) {
+  # Extracted from registerS3method()
+  group_generics <- c("Math", "Ops", "matrixOps", "Summary", "Complex")
+  if (generic %in% group_generics) {
+    s3_envir <- .BaseNamespaceEnv
+  } else {
+    genfun <- get(generic, envir = envir)
+    s3_envir <- environment(genfun) %||% .BaseNamespaceEnv
+  }
+
+  if (env_has(s3_envir, ".__S3MethodsTable__.")) {
+    table <- env_get(s3_envir, ".__S3MethodsTable__.")
+    env_unbind(table, paste0(generic, ".", class))
+  }
 }
 
 #' @rdname local_mocked_s3_method
@@ -51,20 +77,28 @@ local_mocked_s4_method <- function(
 ) {
   check_string(generic)
   check_character(signature)
-  check_function(definition)
+  check_function(definition, allow_null = TRUE)
 
-  old <- methods::getMethod(generic, signature, optional = TRUE)
-  if (is.null(old)) {
-    name <- paste0(generic, "(", paste0(signature, collapse = ","), ")")
-    cli::cli_abort(
-      "Can't find existing S4 method {.code {name}}."
-    )
+  generic_def <- methods::getGeneric(generic)
+  if (is.null(generic_def)) {
+    cli::cli_abort("Can't find generic {.fn {generic}}.")
   }
-  methods::setMethod(generic, signature, definition, where = topenv(frame))
-  withr::defer(
-    methods::setMethod(generic, signature, old, where = topenv(frame)),
-    frame
-  )
+
+  set_method <- function(generic, signature, def) {
+    env <- topenv(frame)
+    old <- methods::getMethod(generic, signature, optional = TRUE)
+    if (is.null(def)) {
+      methods::removeMethod(generic, signature, env)
+    } else {
+      suppressMessages(methods::setMethod(generic, signature, def, env))
+    }
+    old
+  }
+
+  old <- set_method(generic_def, signature, definition)
+  withr::defer(set_method(generic_def, signature, old), frame)
+
+  invisible()
 }
 
 

man/local_mocked_s3_method.Rd

@@ -14,12 +14,12 @@
       local_mocked_s3_method("mean", "bar", 1)
     Condition
       Error in `local_mocked_s3_method()`:
-      ! `definition` must be a function, not the number 1.
+      ! `definition` must be a function or `NULL`, not the number 1.
     Code
-      local_mocked_s3_method("mean", "bar", function() { })
+      local_mocked_s3_method("notAGeneric", "bar", function() { })
     Condition
-      Error in `local_mocked_s3_method()`:
-      ! Can't find existing S3 method `mean.bar()`.
+      Error in `get()`:
+      ! object 'notAGeneric' not found
 
 ---
 
@@ -37,12 +37,12 @@
       local_mocked_s4_method("mean", "bar", 1)
     Condition
       Error in `local_mocked_s4_method()`:
-      ! `definition` must be a function, not the number 1.
+      ! `definition` must be a function or `NULL`, not the number 1.
     Code
-      local_mocked_s4_method("mean", "bar", function() { })
+      local_mocked_s4_method("notAGeneric", "bar", function() { })
     Condition
       Error in `local_mocked_s4_method()`:
-      ! Can't find existing S4 method `mean(bar)`.
+      ! Can't find generic `notAGeneric()`.
 
 ---
 

tests/testthat/_snaps/mock-oo.md

@@ -16,10 +16,36 @@ test_that("validates its inputs", {
     local_mocked_s3_method(1)
     local_mocked_s3_method("mean", 1)
     local_mocked_s3_method("mean", "bar", 1)
-    local_mocked_s3_method("mean", "bar", function() {})
+    local_mocked_s3_method("notAGeneric", "bar", function() {})
   })
 })
 
+test_that("can mock S3 method that doesn't exist yet", {
+  x <- structure(list(), class = "test_mock_class")
+
+  local({
+    local_mocked_s3_method("length", "test_mock_class", function(x) 42)
+    expect_length(x, 42)
+  })
+
+  # Method should be removed after scope ends
+  expect_length(x, 0)
+})
+
+test_that("can temporarily remove S3 method with NULL", {
+  x <- structure(list(), class = "test_mock_class2")
+  local_mocked_s3_method("length", "test_mock_class2", function(x) 42)
+
+  local({
+    # Now remove it
+    local_mocked_s3_method("length", "test_mock_class2", NULL)
+    expect_length(x, 0)
+  })
+
+  # Method should be restored after scope ends
+  expect_length(x, 42)
+})
+
 # S4 --------------------------------------------------------------------------
 
 test_that("can mock S4 methods", {
@@ -33,14 +59,39 @@ test_that("can mock S4 methods", {
   expect_equal(mock_age(jim), 32)
 })
 
-
 test_that("validates its inputs", {
   expect_snapshot(error = TRUE, {
     local_mocked_s4_method(1)
     local_mocked_s4_method("mean", 1)
     local_mocked_s4_method("mean", "bar", 1)
-    local_mocked_s4_method("mean", "bar", function() {})
+    local_mocked_s4_method("notAGeneric", "bar", function() {})
+  })
+})
+
+test_that("can mock S4 method that doesn't exist yet", {
+  jim <- TestMockPerson(name = "Jim", age = 32)
+
+  local({
+    local_mocked_s4_method("show", "TestMockPerson", function(object) {
+      cat("Person:", object@name, "\n")
+    })
+    expect_output(show(jim), "Person: Jim")
   })
+
+  expect_null(methods::getMethod("show", "TestMockPerson", optional = TRUE))
+})
+
+test_that("can temporarily remove S4 method with NULL", {
+  jim <- TestMockPerson(name = "Jim", age = 32)
+  expect_equal(mock_age(jim), 32)
+
+  local({
+    local_mocked_s4_method("mock_age", "TestMockPerson", NULL)
+    # Method is removed, so this should error
+    expect_error(mock_age(jim), "unable to find")
+  })
+
+  expect_equal(mock_age(jim), 32)
 })
 
 # R6 --------------------------------------------------------------------------