tests/testthat/test-a11y_renderDataTable.R

In a11yShiny: Accessibility Enhancements to Popular R Shiny Functions

# ===========================================================================
# Tests for a11y_renderDataTable and get_german_translation
# ===========================================================================

# --- get_german_translation -------------------------------------------------

test_that("get_german_translation returns a list", {
  trans <- a11yShiny:::get_german_translation()
  expect_type(trans, "list")
})

test_that("get_german_translation contains required keys", {
  trans <- a11yShiny:::get_german_translation()
  expected_keys <- c(
    "sEmptyTable", "sInfo", "sInfoEmpty", "sInfoFiltered",
    "sInfoPostFix", "sInfoThousands", "sLengthMenu",
    "sLoadingRecords", "sProcessing", "sSearch", "sZeroRecords",
    "oPaginate", "oAria", "select", "buttons"
  )
  for (key in expected_keys) {
    expect_true(key %in% names(trans), info = paste("Missing key:", key))
  }
})

test_that("get_german_translation oPaginate has all sub-keys", {
  trans <- a11yShiny:::get_german_translation()
  expect_true(all(c("sFirst", "sPrevious", "sNext", "sLast") %in% names(trans$oPaginate)))
})

test_that("get_german_translation oAria has sort keys", {
  trans <- a11yShiny:::get_german_translation()
  expect_true(all(c("sSortAscending", "sSortDescending") %in% names(trans$oAria)))
})

test_that("get_german_translation buttons has copy/print/colvis", {
  trans <- a11yShiny:::get_german_translation()
  expect_true(all(c("print", "colvis", "copy", "copyTitle", "copyKeys", "copySuccess") %in% names(trans$buttons)))
})

# --- Warning on inaccessible buttons ----------------------------------------

test_that("a11y_renderDataTable warns on copy button", {
  expect_warning(
    a11y_renderDataTable(
      expr = mtcars[1:3, 1:3],
      lang = "en",
      extensions = "Buttons",
      options = list(buttons = c("copy", "csv"))
    ),
    "Copy.*not accessible"
  )
})

test_that("a11y_renderDataTable warns on pdf button", {
  expect_warning(
    a11y_renderDataTable(
      expr = mtcars[1:3, 1:3],
      lang = "en",
      extensions = "Buttons",
      options = list(buttons = c("pdf"))
    ),
    "not accessible"
  )
})

test_that("a11y_renderDataTable warns on print button", {
  expect_warning(
    a11y_renderDataTable(
      expr = mtcars[1:3, 1:3],
      lang = "en",
      extensions = "Buttons",
      options = list(buttons = c("print"))
    ),
    "not accessible"
  )
})

# --- Warning on column filters ----------------------------------------------

test_that("a11y_renderDataTable warns on filter = top", {
  expect_warning(
    a11y_renderDataTable(
      expr = mtcars[1:3, 1:3],
      lang = "en",
      filter = "top"
    ),
    "column filters.*not accessible"
  )
})

test_that("a11y_renderDataTable warns on filter = bottom", {
  expect_warning(
    a11y_renderDataTable(
      expr = mtcars[1:3, 1:3],
      lang = "en",
      filter = "bottom"
    ),
    "column filters.*not accessible"
  )
})

# --- Language handling errors -----------------------------------------------
# Note: a11y_renderDataTable returns a Shiny render function. The error
# for missing lang/dt_language only occurs during render execution inside
# a Shiny session, which cannot be easily tested outside of one.
# We verify that the function at least creates a render function without
# immediate error when no lang is provided.

test_that("a11y_renderDataTable returns a function when no lang is set", {
  fn <- a11y_renderDataTable(expr = mtcars[1:3, 1:3])
  expect_true(is.function(fn))
})

# --- No warning on safe buttons ---------------------------------------------

test_that("a11y_renderDataTable does not warn on csv/excel buttons only", {
  expect_no_warning(
    a11y_renderDataTable(
      expr = mtcars[1:3, 1:3],
      lang = "en",
      extensions = "Buttons",
      options = list(buttons = c("csv", "excel"))
    )
  )
})