tests/testthat/test-utils.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for internal utility functions: add_aria, add_aria_inside,
# find_html_tags, find_direct_children_class, find_direct_children_without_class
# ===========================================================================

# --- add_aria ---------------------------------------------------------------

test_that("add_aria adds aria-label to a tag", {
  tag <- htmltools::tags$div("hello")
  result <- a11yShiny:::add_aria(tag, label = "my label")
  html <- as.character(result)
  expect_true(grepl('aria-label=["\']my label["\']', html))
})

test_that("add_aria adds multiple ARIA attributes", {
  tag <- htmltools::tags$button("btn")
  result <- a11yShiny:::add_aria(
    tag,
    label = "Close",
    role = "button",
    controls = "panel1",
    pressed = "false"
  )
  html <- as.character(result)
  expect_true(grepl('aria-label=["\']Close["\']', html))
  expect_true(grepl('role=["\']button["\']', html))
  expect_true(grepl('aria-controls=["\']panel1["\']', html))
  expect_true(grepl('aria-pressed=["\']false["\']', html))
})

test_that("add_aria adds labelledby, describedby, tabindex, live, atomic, hidden", {
  tag <- htmltools::tags$div("content")
  result <- a11yShiny:::add_aria(
    tag,
    labelledby = "lbl1",
    describedby = "desc1",
    tabindex = "0",
    live = "polite",
    atomic = "true",
    hidden = "true"
  )
  html <- as.character(result)
  expect_true(grepl('aria-labelledby=["\']lbl1["\']', html))
  expect_true(grepl('aria-describedby=["\']desc1["\']', html))
  expect_true(grepl('tabindex=["\']0["\']', html))
  expect_true(grepl('aria-live=["\']polite["\']', html))
  expect_true(grepl('aria-atomic=["\']true["\']', html))
  expect_true(grepl('aria-hidden=["\']true["\']', html))
})

test_that("add_aria passes extra attributes via ...", {
  tag <- htmltools::tags$div("content")
  result <- a11yShiny:::add_aria(tag, `data-custom` = "value")
  html <- as.character(result)
  expect_true(grepl('data-custom=["\']value["\']', html))
})

test_that("add_aria errors on non-tag input", {
  expect_error(
    a11yShiny:::add_aria("not a tag", label = "x"),
    "not an htmltools/shiny tag object"
  )
})

test_that("add_aria returns unchanged tag when no attributes provided", {
  tag <- htmltools::tags$div("hello")
  result <- a11yShiny:::add_aria(tag)
  expect_equal(as.character(result), as.character(tag))
})

test_that("add_aria works with shiny.tag.list", {
  tl <- htmltools::tagList(htmltools::tags$div("a"), htmltools::tags$div("b"))
  # Should not error - shiny.tag.list inherits from list

  result <- a11yShiny:::add_aria(tl, label = "list label")
  expect_true(!is.null(result))
})

test_that("add_aria_inside returns tag unchanged when no attributes passed", {
  tag <- htmltools::tags$div(htmltools::tags$input(id = "inp"))
  result <- a11yShiny:::add_aria_inside(tag, "#inp")
  expect_equal(as.character(result), as.character(tag))
})

test_that("add_aria_inside warns when missing_ok is FALSE and selector not found", {
  tag <- htmltools::tags$div(htmltools::tags$span("no input"))
  # The selector won't match - the behavior depends on tagQuery internals.

  # At minimum it should not error
  result <- a11yShiny:::add_aria_inside(tag, "#nonexistent", role = "textbox", missing_ok = TRUE)
  expect_true(inherits(result, "shiny.tag"))
})

# --- find_html_tags ---------------------------------------------------------

test_that("find_html_tags finds tags by name", {
  tag <- htmltools::tags$div(
    htmltools::tags$span("a"),
    htmltools::tags$div(
      htmltools::tags$span("b")
    )
  )
  results <- a11yShiny:::find_html_tags(tag, name = "span")
  expect_length(results, 2)
})

test_that("find_html_tags filters by class", {
  tag <- htmltools::tags$div(
    htmltools::tags$div(class = "a11y-col", "col1"),
    htmltools::tags$div(class = "other", "other"),
    htmltools::tags$div(class = "a11y-col wide", "col2")
  )
  results <- a11yShiny:::find_html_tags(tag, name = "div", class = "a11y-col")
  expect_length(results, 2)
})

test_that("find_html_tags returns empty list when no matches", {
  tag <- htmltools::tags$div(htmltools::tags$span("a"))
  results <- a11yShiny:::find_html_tags(tag, name = "table")
  expect_length(results, 0)
})

test_that("find_html_tags handles NULL input", {
  results <- a11yShiny:::find_html_tags(NULL, name = "div")
  expect_length(results, 0)
})

test_that("find_html_tags searches through tagList", {
  tl <- htmltools::tagList(
    htmltools::tags$section(class = "a11y-row", "r1"),
    htmltools::tags$section(class = "a11y-row", "r2")
  )
  results <- a11yShiny:::find_html_tags(tl, name = "section", class = "a11y-row")
  expect_length(results, 2)
})

# --- find_direct_children_class --------------------------------------------

test_that("find_direct_children_class finds divs with matching class", {
  elements <- list(
    htmltools::tags$div(class = "a11y-col col-6", "col1"),
    htmltools::tags$div(class = "a11y-col col-6", "col2"),
    htmltools::tags$div(class = "other", "not a col")
  )
  results <- a11yShiny:::find_direct_children_class(elements, "a11y-col")
  expect_length(results, 2)
})

test_that("find_direct_children_class returns empty list when no matches", {
  elements <- list(
    htmltools::tags$div(class = "other", "a"),
    htmltools::tags$span(class = "a11y-col", "b") # span, not div
  )
  results <- a11yShiny:::find_direct_children_class(elements, "a11y-col")
  expect_length(results, 0)
})

# --- find_direct_children_without_class ------------------------------------

test_that("find_direct_children_without_class finds divs without matching class", {
  elements <- list(
    htmltools::tags$div(class = "a11y-col col-6", "col1"),
    htmltools::tags$div(class = "other", "not a col")
  )
  results <- a11yShiny:::find_direct_children_without_class(elements, "a11y-col")
  expect_length(results, 1)
  expect_true(grepl("other", results[[1]]$attribs$class))
})

test_that("find_direct_children_without_class returns empty when all match", {
  elements <- list(
    htmltools::tags$div(class = "a11y-col", "col1"),
    htmltools::tags$div(class = "a11y-col wide", "col2")
  )
  results <- a11yShiny:::find_direct_children_without_class(elements, "a11y-col")
  expect_length(results, 0)
})