tests/testthat/helper-mock.R

In pool: Object Pooling

#********************************************************************#
#********** Create Mock Pooled object for testing purposes **********#
#********************************************************************#
MockPooledObj <- R6::R6Class("MockPooledObj",
  public = list(

    closed = NULL,
    valid = NULL,

    initialize = function(closed = FALSE, valid = TRUE) {
      self$closed <- closed
      self$valid <- valid
    },

    invalidate = function() self$valid <- FALSE
  )
)

failOnActivate <- FALSE
failOnPassivate <- FALSE
failOnDestroy <- FALSE
failOnValidate <- FALSE

# Make R6 class available to S4, and set a few MockPooledObj methods
setClass("MockPooledObj")

setMethod("onActivate", "MockPooledObj", function(object) {
  if (failOnActivate) stop("Activation failed...")
})

setMethod("onPassivate", "MockPooledObj", function(object) {
  if (failOnPassivate) stop("Passivation failed...")
})

setMethod("onDestroy", "MockPooledObj", function(object) {
  if (failOnDestroy) stop("Destruction failed...")
  if (object$closed)
    stop("onDestroy called twice on the same object")
  object$closed <- TRUE
})

setMethod("onValidate", "MockPooledObj", function(object, query) {
  if (failOnValidate) stop("Validation failed...")
  if (isTRUE(attr(object, "bad", exact = TRUE))) {
    stop("Bad object")
  }
})