I have the following module:
library(shiny)
library(magrittr)
inner_mod_ui <- function(id) {
ns <- NS(id)
verbatimTextOutput(ns("out"))
}
inner_mod_server <- function(id, outer_reactive, pos) {
moduleServer(id, function(input, output, session) {
internal_state <- reactiveVal(0)
observe({
req(outer_reactive() == pos)
print("fire")
internal_state(internal_state() + 1)
}) %>% bindEvent(outer_reactive())
output$out <- renderPrint(outer_reactive())
})
}
which I use in the following way:
outer_mod_ui <- function(id) {
ns <- NS(id)
fluidRow(
column(
width = 2,
actionButton(ns("btn"), "Role The Die", icon = icon("dice"))
),
column(
width = 10,
inner_mod_ui(ns("inner"))
)
)
}
outer_mod_server <- function(id) {
moduleServer(id, function(input, output, session) {
value <- reactiveVal(1)
inner <- inner_mod_server("inner", value, 2)
observe({
value(sample(6, 1))
}) %>%
bindEvent(input$btn)
})
}
ui <- fluidPage(
outer_mod_ui("outer")
)
server <- function(input, output, session) {
outer <- outer_mod_server("outer")
}
shinyApp(ui, server)
and the module works the way it is intened.
However, I am trying now to write some unit tests for this module and I can not figure out why the heck the observer is fireing only if I also check the output element:
library(testthat)
outer_reactive <- reactiveVal(1L)
testServer(
inner_mod_server, {
outer_reactive(2L)
## remove the comment of the next line and the test passes!?!?!
# expect_equal(output$out, "[1] 2")
expect_equal(internal_state(), 1L)
},
args = list(
outer_reactive = outer_reactive,
pos = 2
)
)
results in
Error: internal_state() (
actual
) not equal to 1L (expected
).
actual
: 0expected
: 1
but if I keep the line expect_equal(output$out, "[1] 2")
the test passes.
The problem can be solved by making sure that the reactive system is flushed, b/c for some obscure reason changing the dependency of the server is not enough, but if the reactive system is flushed (for instance by requesting the output, or by a manual request as below) it works. Thus, we can add session$flushReact()
and it works:
testServer(
inner_mod_server, {
outer_reactive(2L)
session$flushReact()
expect_equal(internal_state(), 1L)
},
args = list(
outer_reactive = outer_reactive,
pos = 2
)
)