tests/testthat/test-a11y_radioButtons.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_radioButtons
# ===========================================================================

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

test_that("a11y_radioButtons has a11y-radio class", {
  rb <- a11y_radioButtons("rad1", "Format", choices = c("CSV", "JSON"))
  html <- as.character(rb)
  expect_true(grepl("a11y-radio", html))
})

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

test_that("a11y_radioButtons errors when label is missing", {
  expect_error(
    a11y_radioButtons("rad2", choices = c("A", "B")),
    "label.*required"
  )
})

test_that("a11y_radioButtons errors when label is NULL", {
  expect_error(
    a11y_radioButtons("rad3", label = NULL, choices = c("A", "B")),
    "label.*required"
  )
})

test_that("a11y_radioButtons errors when label is empty string", {
  expect_error(
    a11y_radioButtons("rad4", label = "", choices = c("A", "B")),
    "label.*required"
  )
})

test_that("a11y_radioButtons errors when label is whitespace only", {
  expect_error(
    a11y_radioButtons("rad5", label = "   ", choices = c("A", "B")),
    "label.*required"
  )
})

test_that("a11y_radioButtons error message includes inputId", {
  expect_error(
    a11y_radioButtons("myRadioId", label = "", choices = c("A")),
    "myRadioId"
  )
})

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

test_that("a11y_radioButtons creates sr-only div with describedby_text", {
  rb <- a11y_radioButtons("rad7", "Pick",
                          choices = c("A", "B"),
                          describedby_text = "Select one option")
  html <- as.character(rb)
  expect_true(grepl("a11y-sr-only", html))
  expect_true(grepl("Select one option", html))
  expect_true(grepl("rad7-desc", html))
})

test_that("a11y_radioButtons uses custom describedby ID", {
  rb <- a11y_radioButtons("rad8", "Pick",
                          choices = c("A", "B"),
                          describedby = "custom-desc",
                          describedby_text = "Help")
  html <- as.character(rb)
  expect_true(grepl("custom-desc", html))
})

test_that("a11y_radioButtons uses describedby without describedby_text", {
  rb <- a11y_radioButtons("rad9", "Pick",
                          choices = c("A", "B"),
                          describedby = "ext-help")
  html <- as.character(rb)
  expect_true(grepl('aria-describedby=["\']ext-help["\']', html))
})

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

test_that("a11y_radioButtons errors on invalid heading_level", {
  expect_error(
    a11y_radioButtons("rad10", "Pick", choices = c("A"), heading_level = 0),
    "heading_level"
  )
})

test_that("a11y_radioButtons errors on non-numeric heading_level", {
  expect_error(
    a11y_radioButtons("rad11", "Pick", choices = c("A"), heading_level = "one"),
    "heading_level"
  )
})

test_that("a11y_radioButtons valid heading_level does not error", {
  expect_no_error(
    a11y_radioButtons("rad12", "Pick", choices = c("A"), heading_level = 4)
  )
})

# --- Inline vs stacked layout -----------------------------------------------

test_that("a11y_radioButtons works with inline = TRUE", {
  rb <- a11y_radioButtons("rad13", "Pick", choices = c("A", "B"), inline = TRUE)
  html <- as.character(rb)
  expect_true(grepl("a11y-radio", html))
  # Inline radio buttons have inline class from Shiny
  expect_true(grepl("shiny-options-group", html))
})

test_that("a11y_radioButtons works with inline = FALSE (default)", {
  rb <- a11y_radioButtons("rad14", "Pick", choices = c("A", "B"))
  html <- as.character(rb)
  expect_true(grepl("a11y-radio", html))
})

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

test_that("a11y_radioButtons sets aria-controls when provided", {
  rb <- a11y_radioButtons("rad15", "Format",
                          choices = c("CSV", "JSON"),
                          aria_controls = "output-section")
  html <- as.character(rb)
  expect_true(grepl('aria-controls=["\']output-section["\']', html))
})

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

test_that("a11y_radioButtons attaches a11yShiny dependency", {
  rb <- a11y_radioButtons("rad16", "Format", choices = c("CSV"))
  deps <- htmltools::htmlDependencies(rb)
  dep_names <- vapply(deps, function(d) d$name, character(1))
  expect_true("a11yShiny" %in% dep_names)
})