tests/async/test-until.R

In pkgcache: Cache 'CRAN'-Like Metadata and R Packages

test_that("async_until", {
  count <- 1

  result <- synchronise(async_until(
    function() count == 5,
    function() {
      delay(1 / 1000)$then(function(value) count <<- count + 1)
    }
  ))

  expect_equal(count, 5)
  expect_equal(result, 5)
})

test_that("async_until is always called once", {
  called <- FALSE

  result <- synchronise(async_until(
    function() TRUE,
    function() {
      delay(1 / 1000)$then(function(value) called <<- TRUE)
    }
  ))

  expect_true(called)
  expect_true(result)
})

test_that("error", {
  testthat::local_edition(3)
  do <- function() {
    async_until(
      function() i > 5,
      function()
        delay(1 / 1000)$then(function(value) {
          i <<- i + 1
          if (i >= 3) stop("doh")
        })
    )
  }

  i <- 1
  expect_snapshot(error = TRUE, synchronise(do()))

  i <- 1
  do2 <- function() {
    do()$catch(error = function(e) expect_equal(conditionMessage(e), "doh"))
  }
  synchronise(do2())
})

test_that("test function throws", {
  testthat::local_edition(3)
  called <- FALSE

  do <- function() {
    async_until(
      function() stop("doh"),
      function() {
        delay(1 / 1000)$then(function(value) called <<- TRUE)
      }
    )
  }

  expect_snapshot(error = TRUE, synchronise(do()))
  expect_true(called)

  called <- FALSE
  do2 <- function() {
    do()$catch(error = function(e) expect_equal(conditionMessage(e), "doh"))
  }
  synchronise(do2())
  expect_true(called)
})