test_that("Event handlers", {
# Check that session, event, data are passed to callback.
result <- NULL
cancel <- event_register_handler("foo",
function(session, event, data) { result <<- list(session, event, data) }
)
on.exit(cancel(), add = TRUE)
event_trigger("session_obj", "foo", "data")
expect_identical(result, list("session_obj", "foo", "data"))
cancel()
# Testing multiple event handlers for same event, checking for order
x <- numeric()
cancel1 <- event_register_handler(
"foo",
function(session, event, data) { x <<- c(x, 1) }
)
on.exit(cancel1(), add = TRUE)
cancel2 <- event_register_handler(
"foo",
function(session, event, data) { x <<- c(x, 2) }
)
on.exit(cancel2(), add = TRUE)
event_trigger(NULL, "foo", NA)
expect_identical(x, c(1, 2))
event_trigger(NULL, "foo", NA)
expect_identical(x, c(1, 2, 1, 2))
# Cancel first handler
expect_true(cancel1())
expect_false(cancel1())
event_trigger(NULL, "foo", NA)
expect_identical(x, c(1, 2, 1, 2, 2))
})
test_that("Event handler input checking", {
# Should error if callback has incorrect args (session, event, data)
expect_error(
event_register_handler("foo", function(session, data) NULL)
)
expect_error(
event_register_handler("foo", function(session, data, event) NULL)
)
# Error for empty event name
expect_error(
event_register_handler("", function(session, event, data) NULL)
)
})
test_that("Errors are converted to warnings", {
n <- 0
f <- function() g()
g <- function() stop("error in g")
cancel1 <- event_register_handler("foo", function(session, event, data) f())
on.exit(cancel1(), add = TRUE)
cancel2 <- event_register_handler("foo", function(session, event, data) n <<- n + 1)
on.exit(cancel2(), add = TRUE)
expect_warning(event_trigger(NULL, "foo", NA), "error in g")
# Other callbacks should still have executed.
expect_identical(n, 1)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.