tests/testthat/test-events.R

In learnr: Interactive Tutorials for R

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)
})