tests/testthat/test-optionalInput.R

In teal.widgets: 'shiny' Widgets for 'teal' Applications

testthat::test_that("optionalSliderInput single value", {
  testthat::expect_no_error(optionalSliderInput("a", "b", 0, 1, 0.2))
})

testthat::test_that("optionalSliderInput single value - out of range", {
  testthat::expect_error(
    optionalSliderInput("a", "b", 0, 1, -1),
    "arguments inconsistent: min <= value <= max expected"
  )
})

testthat::test_that("optionalSliderInput double value", {
  testthat::expect_no_error(optionalSliderInput("a", "b", 0, 1, c(0.2, 0.8)))
})

testthat::test_that("optionalSliderInput double value - out of range", {
  testthat::expect_error(
    optionalSliderInput("a", "b", 0, 1, c(-1, 2)),
    "arguments inconsistent: min <= value <= max expected"
  )
})

testthat::test_that("optionalSliderInput min/max NA", {
  testthat::expect_no_error(optionalSliderInput("a", "b", NA, 1, 0.2))
  testthat::expect_no_error(optionalSliderInput("a", "b", NA, NA, 0.2))
  testthat::expect_no_error(optionalSliderInput("a", "b", 0, 1, 0.2))
})

testthat::test_that("if inputId is not a string returns an error", {
  testthat::expect_error(optionalSelectInput(TRUE, "my label", c("choice_1", "choice_2")))
})

testthat::test_that("if inputId is not a string returns an error", {
  testthat::expect_error(optionalSelectInput(TRUE, "my label", c("choice_1", "choice_2")))
})

testthat::test_that("if label is not a string returns an error", {
  testthat::expect_error(optionalSelectInput("my_input_id", TRUE, c("choice_1", "choice_2")))
})

testthat::test_that("if with is not a valid css unit returns an error", {
  testthat::expect_error(
    optionalSelectInput("my_input_id", "my label", c("choice_1", "choice_2"), width = "wrong css unit")
  )
})

testthat::test_that("if options is not a list returns an error", {
  testthat::expect_error(optionalSelectInput("my_input_id", "my label", c("choice_1", "choice_2"), options = TRUE))
})


testthat::test_that("optionalSelectInput is a Shiny ui component", {
  testthat::expect_s3_class(
    optionalSelectInput(
      "my_input_id",
      "my label",
      c("choice_1", "choice_2"),
      label_help = shiny::helpText("This is a sample help text")
    ),
    "shiny.tag"
  )
})

testthat::test_that("if inputId is not a string optionalSliderInputValMinMax returns error", {
  testthat::expect_error(optionalSliderInputValMinMax(
    list,
    "label",
    c(5, 1, 10),
    label_help = shiny::helpText("Help")
  ))
})

testthat::test_that("value_min_max with invalid length throws error", {
  testthat::expect_error(optionalSliderInputValMinMax("id", "label", c(1, 2)))
})

testthat::test_that("value out of range in value_min_max throws error", {
  testthat::expect_error(
    optionalSliderInputValMinMax("id", "label", c(10, 1, 5)),
    "value_min_max"
  )
})

testthat::test_that("optionalSliderInputValMinMax is a Shiny ui component", {
  testthat::expect_s3_class(
    optionalSliderInputValMinMax(
      "id",
      "label",
      c(5, 1, 10),
      label_help = shiny::helpText("Help")
    ),
    "shiny.tag"
  )
})

# Tests for updateOptionalSelectInput
testthat::test_that("updateOptionalSelectInput updates choices and selected values", {
  # Create a simple server module that uses optionalSelectInput
  test_module <- function(id) {
    moduleServer(id, function(input, output, session) {
      # Expose a way to trigger updates
      observeEvent(input$trigger_update, {
        updateOptionalSelectInput(
          session = session,
          inputId = "test_select",
          choices = c("new1", "new2", "new3"),
          selected = "new2"
        )
      })

      # Return the current input value so we can test it
      reactive({
        list(
          value = input$test_select,
          triggered = input$trigger_update
        )
      })
    })
  }

  shiny::testServer(test_module, {
    # Set initial value with original choices
    session$setInputs(test_select = "old1")

    # Verify initial state
    result <- session$returned()
    testthat::expect_equal(result$value, "old1")
    testthat::expect_null(result$triggered)

    # Trigger the update
    session$setInputs(trigger_update = 1)

    # After update, the selected value should change to "new2"
    # Note: In testServer, we need to manually set the input to the new value
    # since updateOptionalSelectInput sends the update to the client
    session$setInputs(test_select = "new2")

    result_after <- session$returned()
    testthat::expect_equal(result_after$value, "new2")
    testthat::expect_equal(result_after$triggered, 1)
  })
})