Shiny模块测试异常：Observer仅在检查Output时触发

自定义Shiny模块代码 #

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"), "掷骰子", 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$out的情况下，内部Observer才会触发，否则测试失败。

测试代码如下：

library(testthat)

outer_reactive <- reactiveVal(1L)

testServer(
  inner_mod_server, {
    outer_reactive(2L)
    ## 取消下一行注释后测试通过！
    # expect_equal(output$out, "[1] 2")
    expect_equal(internal_state(), 1L)
  },
  args = list(
    outer_reactive = outer_reactive,
    pos = 2
  )
)

注释掉expect_equal(output$out, "[1] 2")后，测试报错：

Error: internal_state() (actual) not equal to 1L (expected).

actual: 0 expected: 1

但保留该行时测试完全通过。

问题原因 #

这是Shiny反应式系统的特性导致的：在testServer环境中，反应式依赖只有在被主动订阅时才会触发计算流程。output$out依赖outer_reactive，当你访问output$out时，会强制触发outer_reactive的更新，进而触发绑定了它的Observer。如果不访问output$out，outer_reactive的变化不会被立即处理——因为没有任何订阅者，反应式系统会延迟处理这个更新，导致internal_state还没来得及更新就被检查。

解决方法 #

方法1：手动刷新反应式系统 #

在修改outer_reactive后，调用session$flushReact()强制处理所有待处理的反应式更新：

library(testthat)

outer_reactive <- reactiveVal(1L)

testServer(
  inner_mod_server, {
    outer_reactive(2L)
    session$flushReact() # 强制刷新反应式队列
    expect_equal(internal_state(), 1L)
  },
  args = list(
    outer_reactive = outer_reactive,
    pos = 2
  )
)

方法2：显式触发依赖的反应式 #

如果你不想依赖output对象，可以直接调用outer_reactive()来触发它的计算，间接推动Observer执行：

library(testthat)

outer_reactive <- reactiveVal(1L)

testServer(
  inner_mod_server, {
    outer_reactive(2L)
    outer_reactive() # 显式触发反应式计算
    expect_equal(internal_state(), 1L)
  },
  args = list(
    outer_reactive = outer_reactive,
    pos = 2
  )
)

内容的提问来源于stack exchange，提问作者thothal