如何结合shinytest2与ggplot2处理含validate提示的测试场景

我开发的Shiny应用满足条件时返回ggplot图表，不满足条件时通过validate(need())生成提示信息说明无法生成图表的原因，但无法用shinytest2对该场景进行测试。以下是基于shinytest2官方示例修改的应用代码和测试代码，期望回归测试能捕获返回的提示信息。

应用代码 #

# 基于shinytest2官方Robust testing示例修改，移除了已弃用的aes_string()
library(shiny)
library(ggplot2)

ui <- fluidPage(
  numericInput("n", "Number of rows", 10, 1, nrow(cars)),
  plotOutput("plot")
)

server <- function(input, output) {
  dt <- reactive({
    head(cars, input$n)
  })
  
  plot_obj <- reactive({
    validate(need(input$n > 0, message = "n必须严格大于0"))
    ggplot(dt(), aes(speed, dist)) + geom_point()
  })

  output$plot <- renderPlot({
    plot_obj()
  })

  exportTestValues(
    dt = dt(),
    plot_obj = plot_obj()
  )
}

plot_app <- shinyApp(ui = ui, server = server)
plot_app

原测试代码 #

# 文件路径: tests/testthat/test-export.R
library(shinytest2)

test_that("`export`ed `plot_obj` is updated by `n`", {
  skip_if_not_installed("vdiffr")

  app <- AppDriver$new(variant = platform_variant())

  expect_n_and_plot <- function(n) {
    # 验证输入n的值
    n_val <- app$get_value(input = "n")
    expect_equal(n_val, n, expected.label = n)
    # 验证dt()数据是cars的前n行
    dt <- app$get_value(export = "dt")
    expect_equal(dt, head(cars, n), expected.label = paste0("head(cars, ", n, ")"))

    # 验证plot_obj()的数据与dt一致
    plot_obj <- app$get_value(export = "plot_obj")
    expect_equal(plot_obj$data, dt, info = paste0("n = ", n))
    # 验证图表一致性
    vdiffr::expect_doppelganger(paste0("cars-points-", n), plot_obj)
  }

  expect_n_and_plot(10)

  # 更新n为20
  app$set_inputs(n = 20)
  expect_n_and_plot(20)

  # 更新n为-1，期望捕获提示信息
  app$set_inputs(n = -1)
  expect_n_and_plot(-1)
})

解决方案 #

原测试代码的问题在于：当n <= 0时，plot_obj()会触发validate错误，导致exportTestValues无法正常导出plot_obj，此时调用app$get_value(export = "plot_obj")会直接抛出错误，无法执行后续验证。需要拆分测试逻辑，分别处理正常生成图表和触发验证提示两种场景：

修改后的测试代码 #

# 文件路径: tests/testthat/test-export.R
library(shinytest2)

test_that("应用逻辑符合预期", {
  skip_if_not_installed("vdiffr")

  app <- AppDriver$new(variant = platform_variant())

  # 验证正常场景：n>0时生成正确图表
  expect_valid_case <- function(n) {
    # 验证输入值
    app$set_inputs(n = n)
    app$wait_for_idle()
    
    n_val <- app$get_value(input = "n")
    expect_equal(n_val, n)
    
    # 验证导出的dt数据
    dt <- app$get_value(export = "dt")
    expect_equal(dt, head(cars, n))
    
    # 验证导出的plot_obj
    plot_obj <- app$get_value(export = "plot_obj")
    expect_equal(plot_obj$data, dt)
    vdiffr::expect_doppelganger(paste0("cars-points-", n), plot_obj)
  }

  # 验证错误场景：n<=0时显示正确提示信息
  expect_invalid_case <- function(n, expected_msg) {
    app$set_inputs(n = n)
    app$wait_for_idle()
    
    # 验证输入值
    n_val <- app$get_value(input = "n")
    expect_equal(n_val, n)
    
    # 验证dt数据（即使n<=0，head(cars, n)仍会返回空数据框）
    dt <- app$get_value(export = "dt")
    expect_equal(dt, head(cars, n))
    
    # 直接提取页面中错误提示元素的文本
    error_text <- app$get_text(".shiny-output-error")
    expect_equal(error_text, expected_msg)
  }

  # 测试正常场景
  expect_valid_case(10)
  expect_valid_case(20)

  # 测试错误场景
  expect_invalid_case(-1, "n必须严格大于0")
})

关键调整说明 #

• 拆分测试逻辑为expect_valid_case和expect_invalid_case，分别处理两种场景
• 错误场景中，不再尝试获取plot_obj（此时它会抛出错误），而是通过app$get_text(".shiny-output-error")直接提取页面中错误提示元素的文本，更可靠
• 添加app$wait_for_idle()确保应用状态更新完成后再验证

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