#********************************************************************#
#********** 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")
}
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.