1library(testthat)
2
3source("common.R")
4
5describe("visibility", {
6
7  single_fn <- function(value) {
8    info <- withVisible(value)
9    if (info$visible) {
10      info$value
11    } else {
12      invisible(info$value)
13    }
14  }
15  double_fn <- function(value, .visible) {
16    if (.visible) value else invisible(value)
17  }
18
19  # display in block to avoid indent of doom
20  for (add_catch in c("false", "single", "double", "expr")) {
21  for (add_finally in c("false", "expr")) {
22  for (add_then in c("false", "single", "double", "expr")) {
23
24    it(
25      paste0(
26        "survives ", paste0(c(
27          if (add_then != "false") paste0("then-", add_then),
28          if (add_catch != "false") paste0("catch-", add_catch),
29          if (add_finally != "false") paste0("finally-", add_finally),
30          "then"
31        ), collapse = ", ")),
32      {
33
34        p <- promise_resolve(invisible(1))
35
36        p <-
37          switch(add_then,
38            "false" = p,
39            "single" = p %>% then(single_fn),
40            "double" = p %>% then(double_fn),
41            "expr" = p %>% then(~ {
42              info <- withVisible(.)
43              if (info$visible) {
44                info$value
45              } else {
46                invisible(info$value)
47              }
48            })
49          )
50        p <-
51          switch(add_catch,
52            "false" = p,
53            "single" = p %>% catch(single_fn),
54            "double" = p %>% catch(double_fn),
55            "expr" = p %>% catch(~ {})
56          )
57
58        finally_val <- NULL
59        p <-
60          switch(add_finally,
61            "false" = p,
62            "expr" = p %>% finally(~ {
63              finally_val <<- TRUE
64            })
65          )
66
67        extended_val <-
68          p %>%
69          then(function(value, .visible) {
70            list(value = value, visible = .visible)
71          }) %>%
72          extract()
73
74        regular_val <-
75          p %>%
76          then(function(value) {
77            withVisible(value)
78          }) %>%
79          extract()
80
81        if (add_finally != "false") {
82          expect_true(finally_val)
83        }
84
85        expect_identical(extended_val$value, 1)
86        expect_identical(extended_val$visible, FALSE)
87
88        expect_identical(regular_val$value, 1)
89        expect_identical(regular_val$visible, FALSE)
90
91      }
92    )
93  }}}
94})
95