tests/testthat/test-a11y_fluidPage.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_fluidPage
# ===========================================================================

# --- Required parameters ----------------------------------------------------

test_that("a11y_fluidPage errors when title is missing", {
  expect_error(
    a11y_fluidPage(lang = "en"),
    "title.*required"
  )
})

test_that("a11y_fluidPage errors when title is NULL", {
  expect_error(
    a11y_fluidPage(title = NULL, lang = "en"),
    "title.*required"
  )
})

test_that("a11y_fluidPage errors when title is empty string", {
  expect_error(
    a11y_fluidPage(title = "", lang = "en"),
    "title.*required"
  )
})

test_that("a11y_fluidPage errors when lang is missing", {
  expect_error(
    a11y_fluidPage(title = "App"),
    "lang.*required"
  )
})

test_that("a11y_fluidPage errors when lang is NULL", {
  expect_error(
    a11y_fluidPage(title = "App", lang = NULL),
    "lang.*required"
  )
})

test_that("a11y_fluidPage errors when lang is empty string", {
  expect_error(
    a11y_fluidPage(title = "App", lang = ""),
    "lang.*required"
  )
})

# --- Main landmark ----------------------------------------------------------

test_that("a11y_fluidPage creates a main landmark", {
  page <- a11y_fluidPage(title = "Test", lang = "en", htmltools::p("Hello"))
  html <- as.character(page)
  expect_true(grepl("<main", html))
  expect_true(grepl("a11y-main", html))
})

test_that("a11y_fluidPage uses default main_id", {
  page <- a11y_fluidPage(title = "Test", lang = "en", htmltools::p("Hello"))
  html <- as.character(page)
  expect_true(grepl("main-content", html))
})

test_that("a11y_fluidPage accepts custom main_id", {
  page <- a11y_fluidPage(title = "Test", lang = "en",
                         main_id = "custom-main",
                         htmltools::p("Hello"))
  html <- as.character(page)
  expect_true(grepl("custom-main", html))
})

# --- Layout class -----------------------------------------------------------

test_that("a11y_fluidPage has a11y-flow class", {
  page <- a11y_fluidPage(title = "Test", lang = "en", htmltools::p("Content"))
  html <- as.character(page)
  expect_true(grepl("a11y-flow", html))
})

# --- Landmarks (header/nav/aside/footer) ------------------------------------

test_that("a11y_fluidPage wraps header content into <header> tag", {
  page <- a11y_fluidPage(
    title = "Test", lang = "en",
    header = htmltools::h1("Title"),
    htmltools::p("Main content")
  )
  html <- as.character(page)
  expect_true(grepl("<header", html))
  expect_true(grepl("a11y-header", html))
})

test_that("a11y_fluidPage keeps existing <header> tag", {
  page <- a11y_fluidPage(
    title = "Test", lang = "en",
    header = htmltools::tags$header(htmltools::h1("Title")),
    htmltools::p("Main content")
  )
  html <- as.character(page)
  expect_true(grepl("<header", html))
  expect_true(grepl("a11y-header", html))
})

test_that("a11y_fluidPage wraps nav content into <nav> tag", {
  page <- a11y_fluidPage(
    title = "Test", lang = "en",
    nav = htmltools::tags$a(href = "#", "Link"),
    htmltools::p("Main content")
  )
  html <- as.character(page)
  expect_true(grepl("<nav", html))
  expect_true(grepl("a11y-nav", html))
})

test_that("a11y_fluidPage wraps aside content into <aside> tag", {
  page <- a11y_fluidPage(
    title = "Test", lang = "en",
    aside = htmltools::p("Sidebar"),
    htmltools::p("Main content")
  )
  html <- as.character(page)
  expect_true(grepl("<aside", html))
  expect_true(grepl("a11y-aside", html))
})

test_that("a11y_fluidPage wraps footer content into <footer> tag", {
  page <- a11y_fluidPage(
    title = "Test", lang = "en",
    footer = htmltools::p("Footer text"),
    htmltools::p("Main content")
  )
  html <- as.character(page)
  expect_true(grepl("<footer", html))
  expect_true(grepl("a11y-footer", html))
})

# --- Custom main tag --------------------------------------------------------

test_that("a11y_fluidPage normalizes a provided main tag", {
  custom_main <- htmltools::tags$main(id = "my-main", htmltools::p("Content"))
  page <- a11y_fluidPage(title = "Test", lang = "en", main = custom_main)
  html <- as.character(page)
  expect_true(grepl("a11y-main", html))
  expect_true(grepl("my-main", html))
})

test_that("a11y_fluidPage wraps non-main content as main tag", {
  page <- a11y_fluidPage(title = "Test", lang = "en",
                         main = htmltools::p("Just a paragraph"))
  html <- as.character(page)
  expect_true(grepl("<main", html))
  expect_true(grepl("a11y-main", html))
})

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

test_that("a11y_fluidPage attaches a11yShiny dependency", {
  page <- a11y_fluidPage(title = "Test", lang = "en", htmltools::p("Content"))
  deps <- htmltools::htmlDependencies(page)
  dep_names <- vapply(deps, function(d) d$name, character(1))
  expect_true("a11yShiny" %in% dep_names)
})