# =========================================================================== # Tests for a11y_numericInput # =========================================================================== # --- CSS class -------------------------------------------------------------- test_that("a11y_numericInput has a11y-numeric class", { ni <- a11y_numericInput("num1", "Age", value = 30) html <- as.character(ni) expect_true(grepl("a11y-numeric", html)) }) # --- Label validation ------------------------------------------------------- test_that("a11y_numericInput errors when label is missing", { expect_error( a11y_numericInput("num2", value = 10), "label.*required" ) }) test_that("a11y_numericInput errors when label is NULL", { expect_error( a11y_numericInput("num3", label = NULL, value = 10), "label.*required" ) }) test_that("a11y_numericInput errors when label is empty string", { expect_error( a11y_numericInput("num4", label = "", value = 10), "label.*required" ) }) test_that("a11y_numericInput errors when label is whitespace only", { expect_error( a11y_numericInput("num5", label = " ", value = 10), "label.*required" ) }) test_that("a11y_numericInput error message includes inputId", { expect_error( a11y_numericInput("myNumericId", label = "", value = 10), "myNumericId" ) }) # --- ARIA value attributes -------------------------------------------------- test_that("a11y_numericInput sets aria-valuemin when min is provided", { ni <- a11y_numericInput("num7", "Score", value = 50, min = 0) html <- as.character(ni) expect_true(grepl("aria-valuemin", html)) }) test_that("a11y_numericInput sets aria-valuemax when max is provided", { ni <- a11y_numericInput("num8", "Score", value = 50, max = 100) html <- as.character(ni) expect_true(grepl("aria-valuemax", html)) }) test_that("a11y_numericInput sets aria-valuenow", { ni <- a11y_numericInput("num9", "Score", value = 42) html <- as.character(ni) expect_true(grepl("aria-valuenow", html)) }) test_that("a11y_numericInput does not set aria-valuemin when min is NA", { ni <- a11y_numericInput("num10", "Score", value = 50, min = NA) html <- as.character(ni) expect_false(grepl("aria-valuemin", html)) }) test_that("a11y_numericInput does not set aria-valuemax when max is NA", { ni <- a11y_numericInput("num11", "Score", value = 50, max = NA) html <- as.character(ni) expect_false(grepl("aria-valuemax", html)) }) # --- describedby_text ------------------------------------------------------- test_that("a11y_numericInput creates sr-only div with describedby_text", { ni <- a11y_numericInput("num12", "Score", value = 0, describedby_text = "Enter a value") html <- as.character(ni) expect_true(grepl("a11y-sr-only", html)) expect_true(grepl("Enter a value", html)) expect_true(grepl("num12-desc", html)) }) test_that("a11y_numericInput uses custom describedby ID", { ni <- a11y_numericInput("num13", "Score", value = 0, describedby = "custom-id", describedby_text = "Help text") html <- as.character(ni) expect_true(grepl("custom-id", html)) }) test_that("a11y_numericInput uses describedby without describedby_text", { ni <- a11y_numericInput("num14", "Score", value = 0, describedby = "ext-help") html <- as.character(ni) expect_true(grepl('aria-describedby=["\']ext-help["\']', html)) }) # --- heading_level ---------------------------------------------------------- test_that("a11y_numericInput errors on invalid heading_level", { expect_error( a11y_numericInput("num15", "Label", value = 0, heading_level = 0), "heading_level" ) }) test_that("a11y_numericInput errors on non-numeric heading_level", { expect_error( a11y_numericInput("num16", "Label", value = 0, heading_level = "two"), "heading_level" ) }) test_that("a11y_numericInput valid heading_level does not error", { expect_no_error( a11y_numericInput("num17", "Label", value = 0, heading_level = 2) ) }) # --- aria_controls ---------------------------------------------------------- test_that("a11y_numericInput sets aria-controls when provided", { ni <- a11y_numericInput("num18", "Count", value = 1, aria_controls = "output-panel") html <- as.character(ni) expect_true(grepl('aria-controls=["\']output-panel["\']', html)) }) # --- Dependency attachment -------------------------------------------------- test_that("a11y_numericInput attaches a11yShiny dependency", { ni <- a11y_numericInput("num19", "Count", value = 1) deps <- htmltools::htmlDependencies(ni) dep_names <- vapply(deps, function(d) d$name, character(1)) expect_true("a11yShiny" %in% dep_names) })