rshinytestthat

Test shiny module: observer does not fire


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: 0 expected: 1

but if I keep the line expect_equal(output$out, "[1] 2") the test passes.


Solution

  • 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
      )
    )