r语言 - 测试包含其他模块的闪亮模块

Question

在一个大型的Shiny App中，我在其他模块中有很多模块。这些嵌套模块有时也有输入控件，例如textInput()或actionButton，它们也会在父模块中触发某些事件。

以下 MWE 显示了该问题。 模块summaryServer打印一个值的摘要，但等待由按钮触发的rangeServer的反应。我想要一个特定于summaryServer的测试testServer()具有 Shiny 的功能，但是我如何"单击"包含的rangeServer模块中的按钮以继续？这是关于模拟闪亮会议的事情吗？

### TESTING ###
x <- reactiveVal(1:10)
testServer(summaryServer, args = list(var = x), {
cat("var active?", d_act(),"n")
# -----------------------------
# How to click "go" here?
# -----------------------------

cat("var active?", d_act(), "n")
})

### The app ###
summaryUI <- function(id) {
tagList(
textOutput(NS(id, "min")),
textOutput(NS(id, "mean")),
textOutput(NS(id, "max")),
rangeUI(NS(id, "range"))
)
}
summaryServer <- function(id, var) {
stopifnot(is.reactive(var))

moduleServer(id, function(input, output, session) {

d_act = reactiveVal("Haha nope")
range_val = rangeServer("range", var = var)

# waits to range_val
observeEvent(range_val(),{
d_act("TRUE")
message(range_val())
output$min <- renderText(range_val()[[1]])
output$max <- renderText(range_val()[[2]])
output$mean <- renderText(mean(var()))
})
})
}
rangeUI = function(id) {
textInput(inputId = NS(id, "go"), label = "Go")
}
rangeServer = function(id, var){
moduleServer(id, function(input, output, session){
# when button gets clicked
eventReactive(input$go,{
range(var(), na.rm = TRUE)

}, ignoreInit = TRUE, ignoreNULL = TRUE)
})
}
library(shiny)
ui <- fluidPage(
summaryUI("sum")
)
server <- function(input, output, session) {
x = reactiveVal(1:10)
summaryServer("sum", x)
}
# shinyApp(ui, server)

Answer 1

这是一个棘手的问题。如果您将ignoreInit和ignoreNULL都设置为FALSE，但它有效，但只是因为这样您最初不再依赖于go的变化，这是不可取的。

我认为在使用summaryServer运行testServer时无法更改rangeServer内部go。但是，您可以使用{shinytest}来实现此目的。请注意，此处调用并测试整个应用。因此，在使用模块时，必须按元素的完整 id 调用元素，包括命名空间。

(我把go改成了actionButton，其他一切都保持不变)

rangeUI <- function(id) {
actionButton(inputId = NS(id, "go"),label = "Go")
}

test_that("output updates when reactive input changes", {
# invoke app
app <- shinytest::ShinyDriver$new("app.R")
# initially, the button has`nt been clicked and the outputs are empty
testthat::expect_equal(app$getValue("summary-range-go"), 0)
testthat::expect_equal(app$getValue("summary-min"), "")
# click the button
app$click("summary-range-go")
testthat::expect_equal(app$getValue("summary-range-go"), 1)
# testthat::expect_equal(app$getValue("summary-min"), "1")
# for some reason, the button value increased, hence is clicked,
# but the outputs have not been triggered yet.
# another click fixes that
app$click("summary-range-go")
testthat::expect_equal(app$getValue("summary-min"), "1")
})