tests/async/test-deferred-then.R

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

test_that("HTTP HEAD & synchronous then", {
  do <- function() {
    http_head(http$url("/"))$
      then(function(value) value$status_code)$
      then(function(x) expect_equal(x, 200))
  }
  synchronise(do())
})

test_that("HTTP HEAD & async then", {
  do <- function() {
    http_head(http$url("/"))$
      then(function(value) http_get(value$url))$
      then(function(value) expect_equal(value$status_code, 200))
  }
  synchronise(do())
})

test_that("HTTP HEAD & async then & sync then", {
  do <- function() {
    http_head(http$url("/"))$
      then(function(value) http_get(value$url))$
      then(function(value) value$status_code)$
      then(function(value) expect_equal(value, 200))
  }
  synchronise(do())
})

test_that("then for fulfilled", {
  do <- async(function() {
    dx <- http_head(http$url("/status/404"))
    dx2 <- http_head(http$url("/status/404"))
    dx$then(function() {
      dx2$
        then(function(value) value$status_code)$
        then(function(value) expect_equal(value, 404))
    })
  })
  synchronise(do())
})

test_that("multiple then clauses are not allowed", {
  do <- async(function() {
    dx <- delay(1/1000)
    dx$then(function() 1)
    dx$then(function() 2)
  })

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

test_that("compact function notation", {
  do <- function() {
    http_head(http$url("/"))$
      then(function(.) http_get(.$url))$
      then(function(.) .$status_code)$
      then(function(.) expect_equal(., 200))
  }
  synchronise(do())
})

test_that("embedded then", {
  add1 <- function(n) { n ; delay(10/1000)$then(function(value) n + 1) }
  mul3 <- function(n) { n ; delay(10/1000)$then(function(value) n * 3) }

  do <- function() {
    add1(4)$
      then(mul3)$
      then(function(.) expect_equal(., 15))
  }
  synchronise(do())
})

test_that("more embedded thens", {

  steps <- numeric()
  do <- function() {
    async(function() steps <<- c(steps, 1))()$
      then(function() {
        async_constant()$
          then(function() steps <<- c(steps, 2))$
          then(function() steps <<- c(steps, 3))
      })$
      then(function() {
        async_constant()$
          then(function() steps <<- c(steps, 4))$
          then(function() steps <<- c(steps, 5))
      })$
      then(function() steps <<- c(steps, 6))
  }
  synchronise(do())
  expect_equal(steps, 1:6)
})