1 2context("async_debug") 3 4test_that("async_next", { 5 6 new_el <- push_event_loop() 7 on.exit({ new_el$cancel_all(); pop_event_loop() }, add = TRUE) 8 `__async_synchronise_frame__` <- TRUE 9 10 eps <- 0 11 res <- delay(eps)$ 12 then(function() delay(eps))$ 13 then(function() delay(eps)) 14 priv <- get_private(res) 15 priv$null() 16 priv$run_action() 17 18 al <- async_list() 19 expect_equal(nrow(al), 3) 20 expect_true(all(al$state == "pending")) 21 22 async_next() 23 al <- async_list() 24 expect_equal(sort(al$state), c("fulfilled", rep("pending", 2))) 25 26 async_next() 27 al <- async_list() 28 expect_equal(sort(al$state), c("pending", "pending")) 29 30 async_next() 31 al <- async_list() 32 expect_equal(sort(al$state), c("fulfilled", "pending")) 33}) 34 35test_that("async_list", { 36 new_el <- push_event_loop() 37 on.exit({ new_el$cancel_all(); pop_event_loop() }, add = TRUE) 38 `__async_synchronise_frame__` <- TRUE 39 40 eps <- 1/100000 41 p1 <- delay(eps) 42 p2 <- p1$then(function() "foo") 43 res <- p2$then(function() "bar") 44 45 priv <- get_private(res) 46 priv$null() 47 priv$run_action() 48 49 sh <- get_private(p1)$id - 1L 50 al <- async_list() 51 expect_equal(al$id, 3:1 + sh) 52 expect_equal(unclass(al$parents), list(2L + sh, 1L + sh, integer())) 53 expect_equal(vcapply(al$call, typeof), rep("language", 3)) 54 expect_equal( 55 as.character(al$call), 56 c("p2$then(function() \"bar\")", 57 "p1$then(function() \"foo\")", 58 "delay(eps)") 59 ) 60 expect_equal(unclass(al$children), list(integer(), 3L + sh, 2L + sh)) 61 expect_match(al$type[1], "^then-") 62 expect_match(al$type[2], "^then-") 63 expect_equal(al$type[3], "delay") 64 expect_true(all(al$running)) 65 expect_equal(al$state, rep("pending", 3)) 66 expect_true(all(!al$cancelled)) 67 expect_true(all(!al$shared)) 68}) 69 70test_that("async_tree", { 71 new_el <- push_event_loop() 72 on.exit({ new_el$cancel_all(); pop_event_loop() }, add = TRUE) 73 `__async_synchronise_frame__` <- TRUE 74 75 eps <- 1/100000 76 p1 <- delay(eps) 77 p2 <- p1$then(function() "foo") 78 res <- p2$then(function() "bar") 79 80 priv <- get_private(res) 81 priv$null() 82 priv$run_action() 83 84 tree <- async_tree() 85 expect_s3_class(tree, "tree") 86 prn <- format(tree) 87 expect_equal(length(prn), 3) 88 expect_match(prn[1], "p2$then", fixed = TRUE) 89 expect_match(prn[2], "p1$then", fixed = TRUE) 90 expect_match(prn[3], "delay(eps)", fixed = TRUE) 91}) 92 93test_that("async_debug", { 94 new_el <- push_event_loop() 95 on.exit({ new_el$cancel_all(); pop_event_loop() }, add = TRUE) 96 `__async_synchronise_frame__` <- TRUE 97 98 eps <- 0 99 p1 <- delay(eps) 100 tf <- function() "foo" 101 p2 <- p1$then(tf) 102 res <- p2$then(function() "bar") 103 104 priv <- get_private(res) 105 priv$null() 106 priv$run_action() 107 108 async_debug(get_private(p2)$id) 109 expect_true(isdebugged(get_private(p2)$parent_resolve)) 110 expect_true(isdebugged(get_private(p2)$parent_reject)) 111 112 async_wait_for(get_private(p1)$id) 113 expect_message(async_debug(get_private(p1)$id), "already resolved") 114 115 res <- deferred$new() 116 priv <- get_private(res) 117 priv$null() 118 expect_message(async_debug(get_private(res)$id), "has no action") 119 120 res <- deferred$new(action = function() { }) 121 priv <- get_private(res) 122 priv$null() 123 expect_message(async_debug(get_private(res)$id), "debugging action") 124}) 125 126test_that("async_wait_for", { 127 new_el <- push_event_loop() 128 on.exit({ new_el$cancel_all(); pop_event_loop() }, add = TRUE) 129 `__async_synchronise_frame__` <- TRUE 130 131 eps <- 1/100000 132 p1 <- delay(eps) 133 p2 <- p1$then(function() "foo") 134 res <- p2$then(function() "bar") 135 136 priv <- get_private(res) 137 priv$null() 138 priv$run_action() 139 140 async_wait_for(get_private(p2)$id) 141 expect_equal(get_private(p1)$state, "fulfilled") 142 expect_equal(get_private(p2)$state, "fulfilled") 143 expect_equal(get_private(res)$state, "pending") 144}) 145 146test_that("async_where", { 147 148 id <- NULL 149 do <- function() { 150 p <- delay(1/10000)$ 151 then(function() "foo")$ 152 then(function() async_where()) 153 id <<- get_private(p)$id 154 p 155 } 156 157 res <- synchronise(do()) 158 expect_true(any(res$async)) 159 aframe <- utils::tail(which(res$async), 1) 160 expect_equal(res$def_id[aframe], id) 161 expect_equal(res$def_cb_type[aframe], "parent") 162 expect_equal(typeof(res$def_call[[aframe]]), "language") 163}) 164 165test_that("format.async_where", { 166 id <- NULL 167 do <- function() { 168 p <- delay(1/10000)$ 169 then(function() "foo")$ 170 then(function() async_where()) 171 id <<- get_private(p)$id 172 p 173 } 174 175 res <- synchronise(do()) 176 prn <- format(res) 177 expect_match(prn, paste0(id, " parent .*async_where")) 178}) 179