tests/testthat/test-event-emitter-async.R

In gaborcsardi/async: Asynchronous Computation and 'I/O'

test_that("outside of async context errors", {
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() {  })
    x$emit("foo")
  }

  expect_error(do(), "async context",
               class = "async_synchronization_barrier_error")
})

test_that("can create event emitter", {
  do <- function() {
    x <- event_emitter$new(async = TRUE)
  }
  expect_silent(run_event_loop(do()))
})

test_that("can add a listener", {
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() {  })
  }
  expect_silent(run_event_loop(do()))
})

test_that("can add a one-shot listener", {
  do <- function() {
    x <- event_emitter$new()
    x$listen_once("foo", function() {  })
  }
  expect_silent(run_event_loop(do()))
})

test_that("no listeners", {
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$emit("foo")
  }
  expect_silent(run_event_loop(do()))
})

test_that("listener is called on event", {
  called <- FALSE
  deadline <- Sys.time() + as.difftime(2, units = "secs")
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() { called <<- TRUE })
    x$emit("foo")
  }
  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_true(called)
})

test_that("listener called multiple times", {
  called <- 0L
  deadline <- Sys.time() + as.difftime(2, units = "secs")
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() { called <<- called + 1L })
    x$emit("foo")
    x$emit("foo")
    x$emit("foo")
  }
  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_equal(called, 3L)
})

test_that("listener gets arguments", {
  arg1 <- arg2 <- NULL
  deadline <- Sys.time() + as.difftime(2, units = "secs")
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function(a1, a2) {
      arg1 <<- a1
      arg2 <<- a2
    })
    x$emit("foo", 1, 2)
  }
  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_equal(arg1, 1)
  expect_equal(arg2, 2)
})

test_that("named arguments to listeners", {
  arg1 <- arg2 <- arg3 <- NULL

  deadline <- Sys.time() + as.difftime(2, units = "secs")

  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function(a1, a2, a3) {
      arg1 <<- a1
      arg2 <<- a2
      arg3 <<- a3
    })
    x$emit("foo", a3 = 3, a2 = 2, 1)
  }
  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_equal(arg1, 1)
  expect_equal(arg2, 2)
  expect_equal(arg3, 3)
})

test_that("all listeners are called", {
  arg1 <- arg2 <- arg3 <- NULL
  arg11 <- arg12 <- arg13 <- NULL

  deadline <- Sys.time() + as.difftime(2, units = "secs")

  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function(a1, a2, a3) {
      arg1 <<- a1
      arg2 <<- a2
      arg3 <<- a3
    })
    x$listen_on("foo", function(a1, a2, a3) {
      arg11 <<- a1
      arg12 <<- a2
      arg13 <<- a3
    })
    x$emit("foo", a3 = 3, a2 = 2, 1)
  }
  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_equal(arg1, 1)
  expect_equal(arg2, 2)
  expect_equal(arg3, 3)
  expect_equal(arg11, 1)
  expect_equal(arg12, 2)
  expect_equal(arg13, 3)
})

test_that("one shot listener is only called once", {
  called <- called1 <- 0L

  deadline <- Sys.time() + as.difftime(2, units = "secs")

  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() { called <<- called + 1L })
    x$listen_once("foo", function() { called1 <<- called1 + 1L })
    x$emit("foo")
    x$emit("foo")
    x$emit("foo")
  }
  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_equal(called, 3L)
  expect_equal(called1, 1L)
})

test_that("can remove listener", {
  called <- called2 <- 0L

  deadline <- Sys.time() + as.difftime(2, units = "secs")

  cb1 <- function() { called <<- called + 1L }
  cb2 <- function(x = 1) { called2 <<- called2 + 1L }
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", cb1)
    x$listen_on("foo", cb2)
    x$emit("foo")
    x$listen_off("foo", cb2)
    x$emit("foo")
    x$emit("foo")
    x$listen_off("foo", cb1)
    x$emit("foo")
  }

  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_equal(called, 3L)
  expect_equal(called2, 1L)
})

test_that("only removes one listener instance", {
  called <- 0L

  deadline <- Sys.time() + as.difftime(2, units = "secs")

  cb <- function() { called <<- called + 1L }
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", cb)
    x$listen_on("foo", cb)
    x$emit("foo")                       # + 2
    x$listen_off("foo", cb)
    x$emit("foo")                       # + 1
    x$emit("foo")                       # + 1
    x$listen_off("foo", cb)
    x$emit("foo")                       # + 0
  }

  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_equal(called, 4L)
})

test_that("multiple events", {
  foo <- bar <- FALSE

  deadline <- Sys.time() + as.difftime(2, units = "secs")

  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() { foo <<- TRUE })
    x$listen_on("bar", function() { bar <<- TRUE })
    x$emit("foo")
    x$emit("bar")
  }
  expect_silent(run_event_loop(do()))
  expect_true(Sys.time() < deadline)
  expect_true(foo)
  expect_true(bar)
})

test_that("list event names", {
  n1 <- n2 <- n3 <- n4 <- n5 <- 0L
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    n1 <<- x$get_event_names()
    cb1 <- function() { foo <<- TRUE }
    cb2 <- function() { bar <<- TRUE }
    x$listen_on("foo", cb1)
    n2 <<- x$get_event_names()
    x$listen_on("bar", cb2)
    n3 <<- x$get_event_names()
    x$listen_off("foo", cb1)
    n4 <<- x$get_event_names()
    x$listen_off("bar", cb2)
    n5 <<- x$get_event_names()
  }
  expect_silent(run_event_loop(do()))
  expect_equal(n1, character())
  expect_equal(n2, "foo")
  expect_equal(n3, c("foo", "bar"))
  expect_equal(n4, "bar")
  expect_equal(n5, character())
})

test_that("get listener count for event", {
  n1 <- n2 <- n3 <- n4 <- n5 <- 0L
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    cb <- function() { foo <<- TRUE }
    n1 <<- x$get_listener_count("foo")
    x$listen_on("foo", cb)
    n2 <<- x$get_listener_count("foo")
    x$listen_on("foo", cb)
    n3 <<- x$get_listener_count("foo")
    x$listen_off("foo", cb)
    n4 <<- x$get_listener_count("foo")
    x$listen_off("foo", cb)
    n5 <<- x$get_listener_count("foo")
  }
  expect_silent(run_event_loop(do()))
  expect_equal(n1, 0L)
  expect_equal(n2, 1L)
  expect_equal(n3, 2L)
  expect_equal(n4, 1L)
  expect_equal(n5, 0L)
})

test_that("remove all listeners", {
  called <- FALSE
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() called <<- TRUE)
    x$listen_on("foo", function() called <<- TRUE)
    x$listen_on("foo", function() called <<- TRUE)
    x$listen_on("foo", function() called <<- TRUE)
    x$remove_all_listeners("foo")
    x$emit("foo")
    x$emit("foo")
    x$emit("foo")
  }
  expect_silent(run_event_loop(do()))
  expect_false(called)
})

test_that("error callback is called on error", {
  err <- NULL
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() stop("foobar"))
    x$listen_on("error", function(e) err <<- e)
    x$emit("foo")
  }

  expect_silent(run_event_loop(do()))
  expect_false(is.null(err))
  expect_s3_class(err, "error")
  expect_equal(err$event, "foo")
  expect_equal(conditionMessage(err), "foobar")
})

test_that("fail stage if no error callback", {
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() stop("foobar"))
    x$emit("foo")
  }

  expect_error(run_event_loop(do()), "foobar")
})

test_that("all error callbacks are called", {
  err1 <- err2 <- NULL
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() stop("foobar"))
    x$listen_on("error", function(e) err1 <<- e)
    x$listen_on("error", function(e) err2 <<- e)
    x$emit("foo")
  }

  expect_silent(run_event_loop(do()))
  expect_false(is.null(err1))
  expect_false(is.null(err2))
  expect_s3_class(err1, "error")
  expect_equal(err1$event, "foo")
  expect_equal(conditionMessage(err1), "foobar")
  expect_s3_class(err2, "error")
  expect_equal(err2$event, "foo")
  expect_equal(conditionMessage(err2), "foobar")
})

test_that("error within error callback", {
  err <- NULL
  do <- function() {
    x <- event_emitter$new(async = TRUE)
    x$listen_on("foo", function() stop("foobar"))
    x$listen_on("error", function(e) { err <<- e; stop("baz")  })
    x$emit("foo")
  }

  expect_error(run_event_loop(do()), "baz")
  expect_false(is.null(err))
  expect_s3_class(err, "error")
  expect_equal(conditionMessage(err), "foobar")
})