tests/testthat/test-sliderText.R

In dreamRs/shinyWidgets: Custom Inputs Widgets for Shiny

context("sliderText")


test_that("default", {

  tagst <- sliderTextInput(
    inputId = "MY_ID",
    label = "Month range slider:",
    choices = month.name,
    selected = month.name[c(4, 7)]
  )

  deps <- htmltools::findDependencies(tagst)
  nmdeps <- vapply(deps, `[[`, "name", FUN.VALUE = character(1))
  expect_is(tagst, "shiny.tag")
  expect_true(length(deps) >= 3)
  expect_true(any(grepl("^ionrangeslider", nmdeps)))
  expect_true("shinyWidgets" %in% nmdeps)
  expect_true(htmltools::tagHasAttribute(tagst$children[[2]], "id"))
  expect_identical(htmltools::tagGetAttribute(tagst$children[[2]], "id"), "MY_ID")
})


test_that("animation", {

  tagst <- sliderTextInput(
    inputId = "MY_ID",
    label = "Month range slider:",
    choices = month.name,
    selected = month.name[c(4, 7)],
    animate = TRUE
  )

  expect_is(tagst, "shiny.tag")
  expect_true(htmltools::tagHasAttribute(tagst$children[[3]], "class"))
  expect_identical(htmltools::tagGetAttribute(tagst$children[[3]], "class"), "slider-animate-container")
})



test_that("updateSliderTextInput", {

  session <- as.environment(list(
    sendInputMessage = function(inputId, message) {
      session$lastInputMessage = list(id = inputId, message = message)
    },
    sendCustomMessage = function(type, message) {
      session$lastCustomMessage <- list(type = type, message = message)
    },
    sendInsertUI = function(selector, multiple,
                            where, content) {
      session$lastInsertUI <- list(selector = selector, multiple = multiple,
                                   where = where, content = content)
    },
    onFlushed = function(callback, once) {
      list(callback = callback, once = once)
    }
  ))

  updateSliderTextInput(
    session = session,
    inputId = "mySlider",
    choices = month.name,
    selected = month.name[9]
  )

  msgst <- session$lastInputMessage
  expect_length(msgst, 2)
  expect_identical(msgst$id, "mySlider")
  expect_identical(msgst$message$selected, "September")
  expect_length(msgst$message$choices, 12)
})