tests/testthat/test-a11y_numericInput.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_numericInput
# ===========================================================================

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

test_that("a11y_numericInput has a11y-numeric class", {
  ni <- a11y_numericInput("num1", "Age", value = 30)
  html <- as.character(ni)
  expect_true(grepl("a11y-numeric", html))
})

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

test_that("a11y_numericInput errors when label is missing", {
  expect_error(
    a11y_numericInput("num2", value = 10),
    "label.*required"
  )
})

test_that("a11y_numericInput errors when label is NULL", {
  expect_error(
    a11y_numericInput("num3", label = NULL, value = 10),
    "label.*required"
  )
})

test_that("a11y_numericInput errors when label is empty string", {
  expect_error(
    a11y_numericInput("num4", label = "", value = 10),
    "label.*required"
  )
})

test_that("a11y_numericInput errors when label is whitespace only", {
  expect_error(
    a11y_numericInput("num5", label = "   ", value = 10),
    "label.*required"
  )
})

test_that("a11y_numericInput error message includes inputId", {
  expect_error(
    a11y_numericInput("myNumericId", label = "", value = 10),
    "myNumericId"
  )
})

# --- ARIA value attributes --------------------------------------------------

test_that("a11y_numericInput sets aria-valuemin when min is provided", {
  ni <- a11y_numericInput("num7", "Score", value = 50, min = 0)
  html <- as.character(ni)
  expect_true(grepl("aria-valuemin", html))
})

test_that("a11y_numericInput sets aria-valuemax when max is provided", {
  ni <- a11y_numericInput("num8", "Score", value = 50, max = 100)
  html <- as.character(ni)
  expect_true(grepl("aria-valuemax", html))
})

test_that("a11y_numericInput sets aria-valuenow", {
  ni <- a11y_numericInput("num9", "Score", value = 42)
  html <- as.character(ni)
  expect_true(grepl("aria-valuenow", html))
})

test_that("a11y_numericInput does not set aria-valuemin when min is NA", {
  ni <- a11y_numericInput("num10", "Score", value = 50, min = NA)
  html <- as.character(ni)
  expect_false(grepl("aria-valuemin", html))
})

test_that("a11y_numericInput does not set aria-valuemax when max is NA", {
  ni <- a11y_numericInput("num11", "Score", value = 50, max = NA)
  html <- as.character(ni)
  expect_false(grepl("aria-valuemax", html))
})

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

test_that("a11y_numericInput creates sr-only div with describedby_text", {
  ni <- a11y_numericInput("num12", "Score", value = 0,
                          describedby_text = "Enter a value")
  html <- as.character(ni)
  expect_true(grepl("a11y-sr-only", html))
  expect_true(grepl("Enter a value", html))
  expect_true(grepl("num12-desc", html))
})

test_that("a11y_numericInput uses custom describedby ID", {
  ni <- a11y_numericInput("num13", "Score", value = 0,
                          describedby = "custom-id",
                          describedby_text = "Help text")
  html <- as.character(ni)
  expect_true(grepl("custom-id", html))
})

test_that("a11y_numericInput uses describedby without describedby_text", {
  ni <- a11y_numericInput("num14", "Score", value = 0,
                          describedby = "ext-help")
  html <- as.character(ni)
  expect_true(grepl('aria-describedby=["\']ext-help["\']', html))
})

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

test_that("a11y_numericInput errors on invalid heading_level", {
  expect_error(
    a11y_numericInput("num15", "Label", value = 0, heading_level = 0),
    "heading_level"
  )
})

test_that("a11y_numericInput errors on non-numeric heading_level", {
  expect_error(
    a11y_numericInput("num16", "Label", value = 0, heading_level = "two"),
    "heading_level"
  )
})

test_that("a11y_numericInput valid heading_level does not error", {
  expect_no_error(
    a11y_numericInput("num17", "Label", value = 0, heading_level = 2)
  )
})

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

test_that("a11y_numericInput sets aria-controls when provided", {
  ni <- a11y_numericInput("num18", "Count", value = 1,
                          aria_controls = "output-panel")
  html <- as.character(ni)
  expect_true(grepl('aria-controls=["\']output-panel["\']', html))
})

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

test_that("a11y_numericInput attaches a11yShiny dependency", {
  ni <- a11y_numericInput("num19", "Count", value = 1)
  deps <- htmltools::htmlDependencies(ni)
  dep_names <- vapply(deps, function(d) d$name, character(1))
  expect_true("a11yShiny" %in% dep_names)
})