# =========================================================================== # 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) })