测试闪亮模块：观察者不开火

Question

我有以下模块：

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())
  })
}

我按以下方式使用：

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)

模块按照预期的方式工作。

但是，我现在正在尝试为该模块编写一些单元测试，但我无法弄清楚为什么观察者会触发仅，如果我还检查output元素：

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

结果

错误：internal_state() (

actual

) 不等于 1L (

expected

)。

actual

：0

expected

：1

但是如果我坚持下去

expect_equal(output$out, "[1] 2")

测试就会通过。

Answer 1

问题可以通过确保刷新反应式系统来解决，b/c由于某些晦涩的原因改变服务器的依赖关系是不够的，但是如果反应式系统被刷新（例如通过请求输出，或者通过手动请求如下）它有效。因此，我们可以添加

session$flushReact()

并且它可以工作：

testServer(
  inner_mod_server, {
    outer_reactive(2L)
    session$flushReact()
    expect_equal(internal_state(), 1L)
  },
  args = list(
    outer_reactive = outer_reactive,
    pos = 2
  )
)