tests/testthat/test-a11y_dateInput.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_dateInput
# ===========================================================================

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

test_that("a11y_dateInput has a11y-date class", {
  di <- a11y_dateInput("date1", "Start date")
  html <- as.character(di)
  expect_true(grepl("a11y-date", html))
})

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

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

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

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

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

test_that("a11y_dateInput error message includes inputId", {
  expect_error(
    a11y_dateInput("myDateId", label = ""),
    "myDateId"
  )
})

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

test_that("a11y_dateInput creates sr-only div with describedby_text", {
  di <- a11y_dateInput("date7", "Birthday",
                       describedby_text = "Enter your date of birth")
  html <- as.character(di)
  expect_true(grepl("a11y-sr-only", html))
  expect_true(grepl("Enter your date of birth", html))
  expect_true(grepl("date7-desc", html))
})

test_that("a11y_dateInput uses custom describedby ID", {
  di <- a11y_dateInput("date8", "Birthday",
                       describedby = "dob-help",
                       describedby_text = "Help text")
  html <- as.character(di)
  expect_true(grepl("dob-help", html))
})

test_that("a11y_dateInput uses describedby without describedby_text", {
  di <- a11y_dateInput("date9", "Date", describedby = "ext-desc")
  html <- as.character(di)
  expect_true(grepl('aria-describedby=["\']ext-desc["\']', html))
})

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

test_that("a11y_dateInput errors on invalid heading_level", {
  expect_error(
    a11y_dateInput("date10", "Date", heading_level = 7),
    "heading_level"
  )
})

test_that("a11y_dateInput errors on non-numeric heading_level", {
  expect_error(
    a11y_dateInput("date11", "Date", heading_level = "five"),
    "heading_level"
  )
})

test_that("a11y_dateInput valid heading_level does not error", {
  expect_no_error(
    a11y_dateInput("date12", "Date", heading_level = 2)
  )
})

# --- Language and format passthrough ----------------------------------------

test_that("a11y_dateInput accepts German language", {
  di <- a11y_dateInput("date13", "Datum", language = "de")
  html <- as.character(di)
  expect_true(grepl("a11y-date", html))
})

test_that("a11y_dateInput accepts custom format", {
  di <- a11y_dateInput("date14", "Date", format = "dd.mm.yyyy")
  html <- as.character(di)
  expect_true(grepl("dd.mm.yyyy", html))
})

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

test_that("a11y_dateInput sets aria-controls when provided", {
  di <- a11y_dateInput("date15", "Date", aria_controls = "results-panel")
  html <- as.character(di)
  expect_true(grepl('aria-controls=["\']results-panel["\']', html))
})

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

test_that("a11y_dateInput attaches a11yShiny dependency", {
  di <- a11y_dateInput("date16", "Date")
  deps <- htmltools::htmlDependencies(di)
  dep_names <- vapply(deps, function(d) d$name, character(1))
  expect_true("a11yShiny" %in% dep_names)
})