Add examples how to mock objects

[maciekbanas]

With 3.2.1 it is reported that great functions local_mocked_bindings() (really, I love them, started to switch from mockery) can mock also objects.
Still, there is no example how to do it in function docs. Can you provide it?

[hadley]

Like local_mocked_bindings(x = 1) ?

[maciekbanas]

I'll try it :D

[maciekbanas]

I just have no idea how to do it for R6:

TestObject <- R6::R6Class(
  "TestObject",
  private = list(
    one_function = function() {
      go <- TRUE
      return(go)
    }
  ))

test_that("test", {
  with_mocked_bindings({
    test_object <- TestObject$new()
    test_object_priv <- test_object$.__enclos_env__$private
    test_object_priv$one_function()
  },
  go = FALSE
  )
})

[hadley]

What are you trying to do?

[maciekbanas]

I will try to give more real-life example. I tried to minimize my code to reprex.
Let's say I have such R6 private method in my object (this is a GraphQL API client):

get_files_from_org = function(org, repos, file_paths) {
  org <- URLdecode(org)
  files_query <- self$gql_query$files_by_org()
  files_response <- self$gql_response(
      gql_query = files_query,
      vars = list(
        "org" = org,
        "file_paths" = file_paths
      )
    )
  if (private$is_complexity_error(files_response)) {
    files_query <- self$get_files_from_org_per_repo(
      org = org,
      repos = repos,
      file_paths = file_paths
    )
  }
  return(files_query)
}

I want to test the if condition so it returns TRUE. To make it happen I would like to mock the files_response object with a list returning error message that query is too complex. Something like:

files_response = list(
    "error" = list(
      "message" = "Query has complexity"
    )
  )

Such messages are returned by GraphQL API when queries are too large, but I don't want to connect to API in this test.

[maciekbanas]

@hadley I did it more reprex 😃 :

TestObject <- R6::R6Class(
  "TestObject",
  public = list(
    request_method_one = function() {
      "assuming nice response"
    },
    request_method_two = function() {
      "for sure nice response"
    }
  ),
  private = list(
    method_wrapper = function() {
      response <- self$request_method_one()
      if (private$is_wrong(response)) {
        message("Switching to method two.")
        response <- self$request_method_two()
      }
      return(response)
    },
    is_wrong = function(response) {
      any(grepl("wrong", response))
    }
  )
)

So as shown above, I want to mock response object. But it does not seem to work when I run it:

> test_that("TestObject turns to method two if method one is wrong", {
+     with_mocked_bindings({
+         test_object <- TestObject$new()
+         expect_message(test_object$.__enclos_env__$private$method_wrapper(), 
+                        "Switching to method two.")
+     },
+     response = list("wrong")
+     )
+ })
-- Error: TestObject turns to method two if method one is wrong ----------------
Error in `local_mocked_bindings(..., .package = .package)`: Can't find binding for `response`
Backtrace:
    x
 1. \-testthat::with_mocked_bindings(...)
 2.   \-testthat::local_mocked_bindings(..., .package = .package)
 3.     \-cli::cli_abort("Can't find binding for {.arg {missing}}")
 4.       \-rlang::abort(...) at cli/R/rlang.R:45:3

Error:
! Test failed
Backtrace:
    x
 1. +-testthat::test_that(...)
 2. | \-withr (local) `<fn>`()
 3. \-reporter$stop_if_needed()
 4.   \-rlang::abort("Test failed", call = NULL)

[hadley]

I feel like for R6 objects the natural way to mock them is to create a subclass. e.g. something like this:

TestObject <- R6::R6Class(
  "TestObject",
  public = list(
    method_wrapper = function() {
      response <- self$request_method_one()
      if (private$is_wrong(response)) {
        message("Switching to method two.")
        response <- self$request_method_two()
      }
      response
    },
    request_method_one = function() {
      "assuming nice response"
    },
    request_method_two = function() {
      "for sure nice response"
    }
  ),
  private = list(
    is_wrong = function(response) {
      any(grepl("wrong", response))
    }
  )
)

R6Mock <- function(class, public = list(), private = list()) {
  R6::R6Class(
    paste0("Mocked", class$classname),
    inherit = class,
    private = private,
    public = public
  )$new()
}

test_that("test", {
  x <- R6Mock(TestObject, private = list(
    is_wrong = function(response) {
      TRUE
    }
  ))

  expect_equal(x$method_wrapper(), "for sure nice response")
})

[maciekbanas]

Thanks @hadley this looks pretty cool! Definitely I will make use of it. For the time being I still used mockery::stub() for R6 methods, which worked quite fine, but your solution looks more elegant.

Still, would be great to have such example anywhere in testthat docs/vignettes.