select test

DESCRIPTION

@@ -4,11 +4,12 @@ Title: Mobile Ready 'shiny' Apps with Standalone Capabilities
 Version: 1.0.1
 Authors@R: c(
   person("David", "Granjon", email = "[email protected]", role = c("aut", "cre")),
+  person("Veerle", "van Leemput", email = "[email protected]", role = "aut"),
+  person("AthlyticZ", role = "fnd"),
   person("Victor", "Perrier", email = "[email protected]", role = "aut"),
   person("John", "Coene", email = "[email protected]", role = "ctb"),
   person("Isabelle", "Rudolf", email = "", role = "aut"),
   person("Dieter", "Menne", email = "[email protected]", role = "ctb"),
-  person("Veerle", "van Leemput", email = "[email protected]", role = "ctb"),
   person(family = "Marvelapp", role = c("ctb", "cph"), comment = "device.css wrappers"),
   person("Vladimir", "Kharlampidi", email = "[email protected]", role = c("ctb", "cph"), comment = "Framework7 HTML template"))
 Maintainer: David Granjon <[email protected]>

R/f7-inputs.R

@@ -745,7 +745,6 @@ choicesWithNames <- function(choices) {
   choices
 }
 
-
 #' Framework7 select input
 #'
 #' \code{f7Select} creates a select input.
@@ -759,36 +758,7 @@ choicesWithNames <- function(choices) {
 #' @export
 #' @rdname select
 #'
-#' @examples
-#' # Select input
-#' if (interactive()) {
-#'   library(shiny)
-#'   library(shinyMobile)
-#'
-#'   shiny::shinyApp(
-#'     ui = f7Page(
-#'       title = "My app",
-#'       f7SingleLayout(
-#'         navbar = f7Navbar(title = "f7Select"),
-#'         f7Select(
-#'           inputId = "variable",
-#'           label = "Choose a variable:",
-#'           choices = colnames(mtcars)[-1],
-#'           selected = "hp"
-#'         ),
-#'         tableOutput("data")
-#'       )
-#'     ),
-#'     server = function(input, output) {
-#'       output$data <- renderTable(
-#'         {
-#'           mtcars[, c("mpg", input$variable), drop = FALSE]
-#'         },
-#'         rownames = TRUE
-#'       )
-#'     }
-#'   )
-#' }
+#' @example inst/examples/select/app.R
 f7Select <- function(inputId, label, choices, selected = NULL, width = NULL) {
   options <- createSelectOptions(choices, selected)
 
@@ -816,56 +786,14 @@ f7Select <- function(inputId, label, choices, selected = NULL, width = NULL) {
   )
 }
 
-
-
-
 #' Update Framework7 select
 #'
 #' \code{updateF7Select} changes the value of a select input on the client
 #'
-#' @param inputId The id of the input object.
-#' @param selected New value.
 #' @param session The Shiny session object, usually the default value will suffice.
 #'
 #' @export
 #' @rdname select
-#'
-#' @examples
-#' # Update select input
-#' if (interactive()) {
-#'   library(shiny)
-#'   library(shinyMobile)
-#'
-#'   shinyApp(
-#'     ui = f7Page(
-#'       title = "My app",
-#'       f7SingleLayout(
-#'         navbar = f7Navbar(title = "updateF7Select"),
-#'         f7Card(
-#'           f7Button(inputId = "update", label = "Update select"),
-#'           br(),
-#'           f7Select(
-#'             inputId = "variable",
-#'             label = "Choose a variable:",
-#'             choices = colnames(mtcars)[-1],
-#'             selected = "hp"
-#'           ),
-#'           verbatimTextOutput("test")
-#'         )
-#'       )
-#'     ),
-#'     server = function(input, output, session) {
-#'       output$test <- renderPrint(input$variable)
-#'
-#'       observeEvent(input$update, {
-#'         updateF7Select(
-#'           inputId = "variable",
-#'           selected = "gear"
-#'         )
-#'       })
-#'     }
-#'   )
-#' }
 updateF7Select <- function(inputId, selected = NULL,
                            session = shiny::getDefaultReactiveDomain()) {
   message <- dropNulls(list(

inst/examples/select/app.R

@@ -0,0 +1,34 @@
+library(shiny)
+library(shinyMobile)
+
+app <- shinyApp(
+  ui = f7Page(
+    title = "f7Select",
+    f7SingleLayout(
+      navbar = f7Navbar(title = "updateF7Select"),
+      f7Card(
+        f7Button(inputId = "update", label = "Update select"),
+        br(),
+        f7Select(
+          inputId = "select",
+          label = "Choose a variable:",
+          choices = colnames(mtcars)[-1],
+          selected = "hp"
+        ),
+        verbatimTextOutput("test")
+      )
+    )
+  ),
+  server = function(input, output, session) {
+    output$test <- renderPrint(input$select)
+
+    observeEvent(input$update, {
+      updateF7Select(
+        inputId = "select",
+        selected = "gear"
+      )
+    })
+  }
+)
+
+if (interactive() || identical(Sys.getenv("TESTTHAT"), "true")) app

tests/testthat/_snaps/mac-4.3/f7Select/select-app-001.json

@@ -0,0 +1,8 @@
+{
+  "input": {
+    "select": "hp"
+  },
+  "output": {
+    "test": "[1] \"hp\""
+  }
+}

tests/testthat/_snaps/mac-4.3/f7Select/select-app-002.json

@@ -0,0 +1,8 @@
+{
+  "input": {
+    "select": "gear"
+  },
+  "output": {
+    "test": "[1] \"gear\""
+  }
+}

tests/testthat/test-f7Select.R

@@ -0,0 +1,29 @@
+library(shinytest2)
+test_that("select works", {
+  skip_on_cran()
+  shiny_app_path <-
+    system.file("examples/select/app.R", package = "shinyMobile")
+  app <- AppDriver$new(
+    shiny_app_path,
+    name = "select-app",
+    variant = platform_variant()
+  )
+
+  # Open
+  app$expect_values(input = "select", output = "test")
+  app$click(select = "#update")
+  app$wait_for_idle(1000)
+  app$expect_values(input = "select", output = "test")
+})
+
+test_that("select R tag work", {
+  select_tag <- f7Select("select", "Select", colnames(mtcars))
+  expect_s3_class(select_tag, "shiny.tag")
+  input <- htmltools::tagQuery(select_tag)$
+    find("select")$
+    selectedTags()
+  expect_identical(input[[1]]$attribs$class, "input-select")
+  expect_identical(input[[1]]$attribs$id, "select")
+  opts <- input[[1]]$children
+  expect_length(opts, length(colnames(mtcars)))
+})