使用shinytest单元测试R Shiny App rhandsontable

Question

我正在尝试在带有shinytest包的R shiny应用程序中测试rhandsontable。但无法访问table3，并得到以下错误：

session_makeRequest(self，private，endpoint，data，params，headers)中出错:未定义不是对象(计算“”HTMLWidgets.getInstance(Table3).hot“”)

##app.R

library(shiny)
library(rhandsontable)

create_df <-function() {
  df <-  data.frame(matrix(0.0, ncol = 2, nrow = 1))
  return(df)
}

ui <- basicPage(
  navbarPage("App", id="nav",fluid = TRUE,
             tabPanel("Table 1", id="t1",
                      titlePanel("Table 1"),
                      hr(),
                      fluidRow(column(12,
                                      tagList(
                                        tags$h3("Table 1"),
                                        rHandsontableOutput("table1")
                                      )
                      )),
                      fluidRow(column(12,
                                      tagList(
                                        tags$h3("Table 2"),
                                        rHandsontableOutput("table2")
                                      )))
                      ),

             tabPanel("Table 3",id="t3",
                      titlePanel("Table 3"),
                      hr(),
                      fluidRow(column(12,
                                      tagList(
                                        tags$h3("Table 3"),
                                        rHandsontableOutput("table3")
                                      )
                      )))



    )

)

server <- function(input, output, session) {

  v = reactiveValues()


  observe({ input$table1
    if (!is.null(input$table1)) {
      v$table1<- hot_to_r(input$table1)

    } else {
      v$table1<-create_df()
    }
  })

  output$table1 <- renderRHandsontable({
    rhandsontable(v$table1)
  })

  observe({ input$table2
    if (!is.null(input$table2)) {
      v$table2<- hot_to_r(input$table2)

    } else {
      v$table2<-create_df()
    }
  })

  # observeEvent(input$df,{  
  #   v$df2 <- v$df * 2
  # })

  output$table2 <- renderRHandsontable({
    rhandsontable(v$table2)
  })

  observe({ input$table3
    if (!is.null(input$table3)) {
      v$table3<- hot_to_r(input$table3)

    } else {
      v$table3<-create_df()
    }
  })



  output$table3 <- renderRHandsontable({
    rhandsontable(v$table3)
  })



}

shinyApp(ui = ui, server = server)


#shinytest script

library(shinytest)

app <- ShinyDriver$new("path to app")

app$snapshotInit("mytest")


app$snapshot(screenshot = FALSE)


script <- paste0(
  "var $table = HTMLWidgets.getInstance(table3).hot;",
  "$table.setDataAtCell([[0,0,'1'],[0,1,'1']]);"
)


app$executeScript(script)

app$snapshot(screenshot = FALSE)

我对此脚本的期望是，第一行中的前两个单元格将获得赋值为1的值，但这并没有发生。请告诉我如何解决它。谢谢。

Answer 1

这是因为您不在包含table3的选项卡中时执行脚本。尝试：

app <- ShinyDriver$new("../")
app$snapshotInit("mytest")

app$setInputs(nav = "Table 3") # <-- go the tab containing 'table3'

script <- paste0(
  "var $table = HTMLWidgets.getInstance(table3).hot;",
  "$table.setDataAtCell([[0,0,'1'],[0,1,'1']]);"
)
app$executeScript(script)

app$snapshot()