tests/async/test-errors.R

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

test_that("rejection", {
  do <- async(function() {
    dx <- delay(1 / 10000)$then(function() stop("ohno!"))$catch(
      error = function(.) expect_match(.$message, "ohno!")
    )
  })
  synchronise(do())
})

test_that("error propagates", {
  do <- async(function() {
    called <- FALSE
    dx <- delay(1 / 10000)$then(function(.) .)$then(
      function() stop("ohno!")
    )$then(function(x) called <<- TRUE)

    dx$catch(error = function(.) expect_match(.$message, "ohno!"))$then(
      function(x) expect_false(called)
    )
  })
  synchronise(do())
})

test_that("handled error is not an error any more", {
  do <- async(function() {
    delay(1 / 10000)$then(function(x) stop("ohno!"))$catch(
      error = function(x) "OK"
    )$then(function(.) expect_equal(., "OK"))$catch(
      error = function() stop("not called")
    )
  })
  synchronise(do())
})

test_that("catch", {
  do <- async(function() {
    dx <- delay(1 / 1000)$then(function(.) .)$then(
      function() stop("ooops")
    )$then(function() "not this one")$catch(
      error = function(.) "nothing to see here"
    )
  })
  expect_equal(
    synchronise(do()),
    "nothing to see here"
  )
})

test_that("finally", {
  testthat::local_edition(3)
  called <- FALSE
  do <- async(function() {
    delay(1 / 1000)$then(function(.) .)$then(function() stop("oops"))$then(
      function() "not this one"
    )$finally(function() called <<- TRUE)
  })
  expect_snapshot(error = TRUE, synchronise(do()))
  expect_true(called)

  called <- FALSE
  do <- async(function() {
    delay(1 / 1000)$then(function(.) .)$then(function() "this one")$finally(
      function() called <<- TRUE
    )
  })
  expect_equal(synchronise(do()), "this one")
  expect_true(called)
})

test_that("error in action", {
  do <- function() {
    deferred$new(function(resolve, reject) stop("foobar"))
  }

  err <- tryCatch(synchronise(do()), error = identity)
  expect_s3_class(err, "async_rejected")
  expect_match(conditionMessage(err), "foobar")
})

test_that("error in then function", {
  do <- function() {
    delay(1 / 100)$then(function(x) stop("foobar"))
  }

  err <- tryCatch(synchronise(do()), error = identity)
  expect_s3_class(err, "async_rejected")
  expect_match(conditionMessage(err), "foobar")
})

test_that("can catch error in action", {
  do <- function() {
    deferred$new(function(resolve, reject) stop("foobar"))$catch(
      error = function(e) e
    )
  }

  err <- synchronise(do())
  expect_s3_class(err, "async_rejected")
  expect_match(conditionMessage(err), "foobar")
})

test_that("can catch error in then function", {
  do <- function() {
    delay(1 / 100)$then(function(x) stop("foobar"))$catch(error = function(e) e)
  }

  err <- synchronise(do())
  expect_s3_class(err, "async_rejected")
  expect_match(conditionMessage(err), "foobar")
})

test_that("catch handers", {
  spec <- foobar1 <- foobar2 <- NULL
  do <- async(function() {
    async_constant(42)$then(function() {
      err <- structure(
        list(message = "foobar"),
        class = c("foobar", "error", "condition")
      )
      stop(err)
    })$catch(special = function(e) spec <<- e)$catch(
      foobar = function(e) foobar1 <<- e
    )$then(function(e) foobar2 <<- e)$then(function() "ok")
  })

  expect_equal(synchronise(do()), "ok")
  expect_null(spec)
  expect_s3_class(foobar1, "foobar")
  expect_s3_class(foobar1, "error")
  expect_s3_class(foobar2, "foobar")
  expect_s3_class(foobar2, "error")
})