tests/testthat/test-a11y_textInput.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_textInput
# ===========================================================================

# --- CSS class --------------------------------------------------------------

test_that("a11y_textInput has a11y-text class", {
  ti <- a11y_textInput("txt1", "Name")
  html <- as.character(ti)
  expect_true(grepl("a11y-text", html))
})

# --- Label validation -------------------------------------------------------

test_that("a11y_textInput errors when label is missing", {
  expect_error(
    a11y_textInput("txt2"),
    "label.*required"
  )
})

test_that("a11y_textInput errors when label is NULL", {
  expect_error(
    a11y_textInput("txt3", label = NULL),
    "label.*required"
  )
})

test_that("a11y_textInput errors when label is empty string", {
  expect_error(
    a11y_textInput("txt4", label = ""),
    "label.*required"
  )
})

test_that("a11y_textInput errors when label is whitespace only", {
  expect_error(
    a11y_textInput("txt5", label = "   "),
    "label.*required"
  )
})

test_that("a11y_textInput error message includes inputId", {
  expect_error(
    a11y_textInput("myTextId", label = ""),
    "myTextId"
  )
})

# --- Placeholder passthrough ------------------------------------------------

test_that("a11y_textInput passes placeholder through", {
  ti <- a11y_textInput("txt7", "Email", placeholder = "user@example.com")
  html <- as.character(ti)
  expect_true(grepl("user@example.com", html))
})

# --- describedby_text -------------------------------------------------------

test_that("a11y_textInput creates sr-only div with describedby_text", {
  ti <- a11y_textInput("txt8", "Email",
                       describedby_text = "We will not share your email")
  html <- as.character(ti)
  expect_true(grepl("a11y-sr-only", html))
  expect_true(grepl("We will not share your email", html))
  expect_true(grepl("txt8-desc", html))
})

test_that("a11y_textInput uses custom describedby ID", {
  ti <- a11y_textInput("txt9", "Email",
                       describedby = "email-help",
                       describedby_text = "Help text")
  html <- as.character(ti)
  expect_true(grepl("email-help", html))
})

test_that("a11y_textInput uses describedby without describedby_text", {
  ti <- a11y_textInput("txt10", "Name", describedby = "ext-desc")
  html <- as.character(ti)
  expect_true(grepl('aria-describedby=["\']ext-desc["\']', html))
})

# --- heading_level ----------------------------------------------------------

test_that("a11y_textInput errors on invalid heading_level", {
  expect_error(
    a11y_textInput("txt11", "Label", heading_level = 8),
    "heading_level"
  )
})

test_that("a11y_textInput errors on non-numeric heading_level", {
  expect_error(
    a11y_textInput("txt12", "Label", heading_level = "four"),
    "heading_level"
  )
})

test_that("a11y_textInput valid heading_level does not error", {
  expect_no_error(
    a11y_textInput("txt13", "Label", heading_level = 3)
  )
})

# --- aria_controls ----------------------------------------------------------

test_that("a11y_textInput sets aria-controls when provided", {
  ti <- a11y_textInput("txt14", "Query", aria_controls = "results")
  html <- as.character(ti)
  expect_true(grepl('aria-controls=["\']results["\']', html))
})

# --- Dependency attachment --------------------------------------------------

test_that("a11y_textInput attaches a11yShiny dependency", {
  ti <- a11y_textInput("txt15", "Name")
  deps <- htmltools::htmlDependencies(ti)
  dep_names <- vapply(deps, function(d) d$name, character(1))
  expect_true("a11yShiny" %in% dep_names)
})