tests/testthat/test-a11y_textInputsGroup.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_textInputsGroup
# ===========================================================================

# --- Legend validation ------------------------------------------------------

test_that("a11y_textInputsGroup errors when legend is missing", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp1",
      inputs = list(list(inputId = "f1", label = "Field"))
    ),
    "legend.*required"
  )
})

test_that("a11y_textInputsGroup errors when legend is NULL", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp2",
      legend = NULL,
      inputs = list(list(inputId = "f1", label = "Field"))
    ),
    "legend.*required"
  )
})

test_that("a11y_textInputsGroup errors when legend is empty string", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp3",
      legend = "",
      inputs = list(list(inputId = "f1", label = "Field"))
    ),
    "legend.*required"
  )
})

test_that("a11y_textInputsGroup errors when legend is whitespace only", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp4",
      legend = "   ",
      inputs = list(list(inputId = "f1", label = "Field"))
    ),
    "legend.*required"
  )
})

test_that("a11y_textInputsGroup error includes groupId", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "myGroup",
      legend = "",
      inputs = list(list(inputId = "f1", label = "Field"))
    ),
    "myGroup"
  )
})

# --- Inputs validation ------------------------------------------------------

test_that("a11y_textInputsGroup errors when inputs is empty list", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp5",
      legend = "Address",
      inputs = list()
    ),
    "non-empty list"
  )
})

test_that("a11y_textInputsGroup errors when inputs is missing", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp6",
      legend = "Address"
    ),
    "non-empty list"
  )
})

test_that("a11y_textInputsGroup errors when input spec is not a list", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp7",
      legend = "Address",
      inputs = list("not a list")
    ),
    "must be a list"
  )
})

test_that("a11y_textInputsGroup errors when inputId is missing from spec", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp8",
      legend = "Address",
      inputs = list(list(label = "Street"))
    ),
    "non-empty.*inputId"
  )
})

# --- Per-input label requirements -------------------------------------------

test_that("a11y_textInputsGroup errors when input has no label, aria_label, or title", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp9",
      legend = "Address",
      inputs = list(list(inputId = "field1"))
    ),
    "label.*aria_label.*title"
  )
})

test_that("a11y_textInputsGroup accepts input with visible label", {
  expect_no_error(
    a11y_textInputsGroup(
      groupId = "grp10",
      legend = "Address",
      inputs = list(list(inputId = "street", label = "Street"))
    )
  )
})

test_that("a11y_textInputsGroup accepts input with aria_label", {
  expect_no_error(
    a11y_textInputsGroup(
      groupId = "grp11",
      legend = "Address",
      inputs = list(list(inputId = "street", aria_label = "Street address"))
    )
  )
})

test_that("a11y_textInputsGroup accepts input with title", {
  expect_no_error(
    a11y_textInputsGroup(
      groupId = "grp12",
      legend = "Address",
      inputs = list(list(inputId = "street", title = "Enter street name"))
    )
  )
})

# --- Fieldset / legend structure --------------------------------------------

test_that("a11y_textInputsGroup creates a fieldset tag", {
  grp <- a11y_textInputsGroup(
    groupId = "grp13",
    legend = "Address",
    inputs = list(list(inputId = "street", label = "Street"))
  )
  # Find the fieldset - could be direct or inside a tagList
  html <- as.character(grp)
  expect_true(grepl("<fieldset", html))
  expect_true(grepl("<legend", html))
  expect_true(grepl("Address", html))
})

test_that("a11y_textInputsGroup sets role group on fieldset", {
  grp <- a11y_textInputsGroup(
    groupId = "grp14",
    legend = "Address",
    inputs = list(list(inputId = "street", label = "Street"))
  )
  html <- as.character(grp)
  expect_true(grepl('role=["\']group["\']', html))
})

test_that("a11y_textInputsGroup sets aria-labelledby to legend id", {
  grp <- a11y_textInputsGroup(
    groupId = "grp15",
    legend = "Address",
    inputs = list(list(inputId = "street", label = "Street"))
  )
  html <- as.character(grp)
  expect_true(grepl("aria-labelledby", html))
  expect_true(grepl("grp15-legend", html))
})

# --- Multiple inputs --------------------------------------------------------

test_that("a11y_textInputsGroup renders multiple inputs", {
  grp <- a11y_textInputsGroup(
    groupId = "grp16",
    legend = "Address",
    inputs = list(
      list(inputId = "street16", label = "Street"),
      list(inputId = "city16", label = "City"),
      list(inputId = "zip16", label = "ZIP")
    )
  )
  html <- as.character(grp)
  expect_true(grepl("street16", html))
  expect_true(grepl("city16", html))
  expect_true(grepl("zip16", html))
})

# --- describedby_text on group ----------------------------------------------

test_that("a11y_textInputsGroup creates sr-only div for group describedby_text", {
  grp <- a11y_textInputsGroup(
    groupId = "grp18",
    legend = "Address",
    inputs = list(list(inputId = "street18", label = "Street")),
    describedby_text = "Enter your full address"
  )
  html <- as.character(grp)
  expect_true(grepl("a11y-sr-only", html))
  expect_true(grepl("Enter your full address", html))
  expect_true(grepl("grp18-desc", html))
})

test_that("a11y_textInputsGroup uses custom describedby on group", {
  grp <- a11y_textInputsGroup(
    groupId = "grp19",
    legend = "Address",
    inputs = list(list(inputId = "street19", label = "Street")),
    describedby = "ext-desc",
    describedby_text = "Help text"
  )
  html <- as.character(grp)
  expect_true(grepl("ext-desc", html))
})

# --- legend_heading_level ---------------------------------------------------

test_that("a11y_textInputsGroup errors on invalid legend_heading_level", {
  expect_error(
    a11y_textInputsGroup(
      groupId = "grp20",
      legend = "Address",
      inputs = list(list(inputId = "street20", label = "Street")),
      legend_heading_level = 7
    ),
    "legend_heading_level"
  )
})

test_that("a11y_textInputsGroup valid legend_heading_level does not error", {
  expect_no_error(
    a11y_textInputsGroup(
      groupId = "grp21",
      legend = "Address",
      inputs = list(list(inputId = "street21", label = "Street")),
      legend_heading_level = 3
    )
  )
})

test_that("a11y_textInputsGroup marks legend as heading when heading_level set", {
  grp <- a11y_textInputsGroup(
    groupId = "grp22",
    legend = "Address",
    inputs = list(list(inputId = "street22", label = "Street")),
    legend_heading_level = 3
  )
  html <- as.character(grp)
  expect_true(grepl('role=["\']heading["\']', html))
  expect_true(grepl("aria-level", html))
})

# --- CSS class on inner inputs ----------------------------------------------

test_that("a11y_textInputsGroup inner inputs have a11y-text-group-item class", {
  grp <- a11y_textInputsGroup(
    groupId = "grp23",
    legend = "Address",
    inputs = list(list(inputId = "street23", label = "Street"))
  )
  html <- as.character(grp)
  expect_true(grepl("a11y-text-group-item", html))
})

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

test_that("a11y_textInputsGroup attaches a11yShiny dependency", {
  grp <- a11y_textInputsGroup(
    groupId = "grp24",
    legend = "Address",
    inputs = list(list(inputId = "street24", label = "Street"))
  )
  deps <- htmltools::htmlDependencies(grp)
  dep_names <- vapply(deps, function(d) d$name, character(1))
  expect_true("a11yShiny" %in% dep_names)
})