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