tests/testthat/test-a11y_textButtonGroup.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_textButtonGroup
# ===========================================================================

# --- Basic structure --------------------------------------------------------

test_that("a11y_textButtonGroup returns a tag with correct container class", {
  grp <- a11y_textButtonGroup(
    textId = "txt_grp1",
    buttonId = "btn_grp1",
    label = "Search",
    button_label = "Go"
  )
  html <- as.character(grp)
  expect_true(grepl("a11y-text-btn-group", html))
})

# --- Layout -----------------------------------------------------------------

test_that("a11y_textButtonGroup inline layout has a11y-text-btn-inline class", {
  grp <- a11y_textButtonGroup(
    textId = "txt_grp2",
    buttonId = "btn_grp2",
    label = "Search",
    button_label = "Go",
    layout = "inline"
  )
  html <- as.character(grp)
  expect_true(grepl("a11y-text-btn-inline", html))
})

test_that("a11y_textButtonGroup stack layout has a11y-text-btn-stack class", {
  grp <- a11y_textButtonGroup(
    textId = "txt_grp3",
    buttonId = "btn_grp3",
    label = "Comment",
    button_label = "Send",
    layout = "stack"
  )
  html <- as.character(grp)
  expect_true(grepl("a11y-text-btn-stack", html))
})

# --- aria-controls default behavior -----------------------------------------

test_that("a11y_textButtonGroup button defaults aria-controls to textId", {
  grp <- a11y_textButtonGroup(
    textId = "search_input",
    buttonId = "search_btn",
    label = "Search",
    button_label = "Go"
  )
  html <- as.character(grp)
  expect_true(grepl('aria-controls=["\']search_input["\']', html))
})

test_that("a11y_textButtonGroup button uses custom controls ID", {
  grp <- a11y_textButtonGroup(
    textId = "txt_grp4",
    buttonId = "btn_grp4",
    label = "Search",
    button_label = "Go",
    controls = "custom-target"
  )
  html <- as.character(grp)
  expect_true(grepl('aria-controls=["\']custom-target["\']', html))
})

# --- Text input label required ----------------------------------------------

test_that("a11y_textButtonGroup errors when text label is missing", {
  expect_error(
    a11y_textButtonGroup(
      textId = "txt_grp5",
      buttonId = "btn_grp5",
      label = "",
      button_label = "Go"
    ),
    "label.*required"
  )
})

# --- Button label or aria_label required ------------------------------------

test_that("a11y_textButtonGroup errors when button has no label or aria_label", {
  expect_error(
    a11y_textButtonGroup(
      textId = "txt_grp6",
      buttonId = "btn_grp6",
      label = "Search"
    ),
    "aria_label"
  )
})

test_that("a11y_textButtonGroup accepts icon-only button with aria_label", {
  expect_no_error(
    a11y_textButtonGroup(
      textId = "txt_grp7",
      buttonId = "btn_grp7",
      label = "Search",
      button_icon = shiny::icon("search"),
      button_aria_label = "Run search"
    )
  )
})

# --- Forwarded text input parameters ----------------------------------------

test_that("a11y_textButtonGroup forwards text_describedby_text", {
  grp <- a11y_textButtonGroup(
    textId = "txt_grp8",
    buttonId = "btn_grp8",
    label = "Query",
    button_label = "Search",
    text_describedby_text = "Enter a keyword"
  )
  html <- as.character(grp)
  expect_true(grepl("Enter a keyword", html))
  expect_true(grepl("a11y-sr-only", html))
})

test_that("a11y_textButtonGroup forwards text_heading_level", {
  expect_no_error(
    a11y_textButtonGroup(
      textId = "txt_grp9",
      buttonId = "btn_grp9",
      label = "Query",
      button_label = "Search",
      text_heading_level = 3
    )
  )
})

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

test_that("a11y_textButtonGroup attaches a11yShiny dependency", {
  grp <- a11y_textButtonGroup(
    textId = "txt_grp10",
    buttonId = "btn_grp10",
    label = "Search",
    button_label = "Go"
  )
  deps <- htmltools::htmlDependencies(grp)
  dep_names <- vapply(deps, function(d) d$name, character(1))
  expect_true("a11yShiny" %in% dep_names)
})