tests/async/test-errors.R

In r-lib/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", {
  called <- FALSE
  do <- async(function() {
    delay(1/1000)$
      then(function(.) .)$
      then(function() stop("oops"))$
      then(function() "not this one")$
      finally(function() called <<- TRUE)
  })
  expect_error(synchronise(do()), "oops")
  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")
})