Test virtualSelectInput with shinytest2

DESCRIPTION

@@ -37,4 +37,7 @@ Suggests:
     DT,
     scales,
     shinydashboard,
-    shinydashboardPlus
+    shinydashboardPlus,
+    shinytest2 (>= 0.4.1)
+Remotes:
+    shiny=rstudio/shiny@v1.10.0

tests/testthat/_snaps/virtual-select/virtualSelectInput-change-multiple.json

@@ -0,0 +1,11 @@
+{
+  "input": {
+    "multiple": [
+      "Jan",
+      "Feb"
+    ]
+  },
+  "output": {
+    "res_multiple": "[1] \"Jan\" \"Feb\""
+  }
+}

tests/testthat/_snaps/virtual-select/virtualSelectInput-change-single.json

@@ -0,0 +1,8 @@
+{
+  "input": {
+    "single": "March"
+  },
+  "output": {
+    "res_single": "[1] \"March\""
+  }
+}

tests/testthat/_snaps/virtual-select/virtualSelectInput-init.json

@@ -0,0 +1,7 @@
+{
+  "input": {
+    "multiple": null,
+    "onclose": null,
+    "single": "January"
+  }
+}

tests/testthat/apps/virtualSelectInput/app.R

@@ -0,0 +1,73 @@
+library(shiny)
+
+# Use built package for R-CMD-check-like checks, local for other testing.
+if (
+  isTRUE(as.logical(Sys.getenv("TESTTHAT_IS_CHECKING", "false"))) ||
+  isTRUE(as.logical(Sys.getenv("R_COVR", "false")))
+) {
+  library("shinyWidgets")
+} else {
+  pkgload::load_all(here::here())
+}
+
+ui <- fluidPage(
+  tags$h2("Virtual Select"),
+
+  fluidRow(
+    column(
+      width = 4,
+      virtualSelectInput(
+        inputId = "single",
+        label = "Single select :",
+        choices = month.name
+      ),
+      virtualSelectInput(
+        inputId = "multiple",
+        label = "Multiple select:",
+        choices = setNames(month.abb, month.name),
+        multiple = TRUE
+      ),
+      virtualSelectInput(
+        inputId = "onclose",
+        label = "Update value on close:",
+        choices = setNames(month.abb, month.name),
+        multiple = TRUE,
+        updateOn = "close"
+      )
+    ),
+    column(
+      width = 4,
+      tags$b("Single select :"),
+      verbatimTextOutput("res_single"),
+      tags$b("Is virtual select open?"),
+      verbatimTextOutput(outputId = "res_single_open"),
+
+      tags$br(),
+
+      tags$b("Multiple select :"),
+      verbatimTextOutput("res_multiple"),
+      tags$b("Is virtual select open ?"),
+      verbatimTextOutput(outputId = "res_multiple_open"),
+
+      tags$br(),
+
+      tags$b("Update on close :"),
+      verbatimTextOutput("res_onclose"),
+      tags$b("Is virtual select open ?"),
+      verbatimTextOutput(outputId = "res_onclose_open")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+  output$res_single <- renderPrint(input$single)
+  output$res_single_open <- renderPrint(input$single_open)
+
+  output$res_multiple <- renderPrint(input$multiple)
+  output$res_multiple_open <- renderPrint(input$multiple_open)
+
+  output$res_onclose <- renderPrint(input$onclose)
+  output$res_onclose_open <- renderPrint(input$onclose_open)
+}
+
+shinyApp(ui, server)

tests/testthat/helper-shinytest2.R

@@ -0,0 +1,7 @@
+# I do this in a helper (rather than in testthat.R) so that it loads when
+# testing locally.
+
+if (rlang::is_installed("shinytest2", version = "0.4.1")) {
+  library(shinytest2)
+  options(chromote.headless = "new")
+}

tests/testthat/test-virtual-select.R

@@ -0,0 +1,38 @@
+test_that("virtualSelectInput initializes", {
+  skip_on_cran()
+  skip_if_not_installed("shinytest2")
+  app <- AppDriver$new(
+    test_path("apps", "virtualSelectInput"),
+    name = "virtualSelectInput",
+    width = 800,
+    height = 600
+  )
+  app$wait_for_value(input = "single", timeout = 2000)
+  app$expect_values(input = TRUE, name = "init")
+  app$stop()
+})
+
+test_that("virtualSelectInput updates reactives on change", {
+  skip_on_cran()
+  skip_if_not_installed("shinytest2")
+  app <- AppDriver$new(
+    test_path("apps", "virtualSelectInput"),
+    name = "virtualSelectInput-change",
+    width = 800,
+    height = 600
+  )
+  app$wait_for_value(input = "single", timeout = 2000)
+  app$set_inputs(single = "March")
+  app$expect_values(
+    input = "single",
+    output = "res_single",
+    name = "single"
+  )
+  app$set_inputs(multiple = c("Jan", "Feb"))
+  app$expect_values(
+    input = "multiple",
+    output = "res_multiple",
+    name = "multiple"
+  )
+  app$stop()
+})