test_that("wa_slider requires input_id", { expect_error( shiny.webawesome:::wa_slider(), 'argument "input_id" is missing', fixed = TRUE ) }) test_that("wa_slider defaults render the minimal semantic wrapper", { expect_exact_html( render_html(shiny.webawesome:::wa_slider("slider")), c('') ) }) test_that("wa_slider override render includes attrs and slots", { expect_exact_html( render_html( shiny.webawesome:::wa_slider( "slider", value = 2, disabled = TRUE, label = "Range", hint = "Slide", autofocus = TRUE, indicator_offset = 1, max = 10, max_value = 8, min = 0, min_value = 2, orientation = "vertical", range = TRUE, readonly = TRUE, size = "large", step = 1, tooltip_distance = 12, tooltip_placement = "left", with_hint = TRUE, with_label = TRUE, with_markers = TRUE, with_tooltip = TRUE, hint_slot = "Hint slot", label_slot = "Label slot", reference = "Reference" ) ), c( paste0( '" ), ' Hint slot', ' Label slot', ' Reference', "" ) ) }) test_that("wa_slider boolean args validate and render correctly", { boolean_args <- c( disabled = "disabled", autofocus = "autofocus", range = "range", readonly = "readonly", with_hint = "with-hint", with_label = "with-label", with_markers = "with-markers", with_tooltip = "with-tooltip" ) default_html <- render_html(shiny.webawesome:::wa_slider("slider")) for (arg_name in names(boolean_args)) { attr_name <- boolean_args[[arg_name]] true_tag <- do.call( shiny.webawesome:::wa_slider, c( list(input_id = "slider"), stats::setNames(list(TRUE), arg_name) ) ) expect_exact_html( render_html(true_tag), c(sprintf('', attr_name)) ) false_tag <- do.call( shiny.webawesome:::wa_slider, c( list(input_id = "slider"), stats::setNames(list(FALSE), arg_name) ) ) expect_equal(render_html(false_tag), default_html) null_tag <- do.call( shiny.webawesome:::wa_slider, c( list(input_id = "slider"), stats::setNames(list(NULL), arg_name) ) ) expect_equal(render_html(null_tag), default_html) expect_error( do.call( shiny.webawesome:::wa_slider, c( list(input_id = "slider"), stats::setNames(list("yes"), arg_name) ) ), sprintf("`%s` must be TRUE, FALSE, or NULL.", arg_name), fixed = TRUE ) } }) test_that("wa_slider enum args validate exactly", { enum_cases <- list( list( arg = "orientation", attr = "orientation", valid = "horizontal", invalid = "diagonal" ), list(arg = "size", attr = "size", valid = "small", invalid = "tiny"), list( arg = "tooltip_placement", attr = "tooltip-placement", valid = "top", invalid = "center" ) ) for (case in enum_cases) { valid_tag <- do.call( shiny.webawesome:::wa_slider, c( list(input_id = "slider"), stats::setNames(list(case$valid), case$arg) ) ) expect_exact_html( render_html(valid_tag), c( sprintf( '', case$attr, case$valid ) ) ) expect_error( do.call( shiny.webawesome:::wa_slider, c( list(input_id = "slider"), stats::setNames(list(case$invalid), case$arg) ) ), sprintf("`%s` must be one of ", case$arg), fixed = TRUE ) } }) test_that("update_wa_slider sends only non-null values", { recorder <- new_message_recorder() expect_invisible( shiny.webawesome:::update_wa_slider( session = recorder$session, input_id = "slider", value = 7, label = "Range", hint = "Slide", disabled = NULL ) ) expect_equal( recorder$seen$calls, list( list( input_id = "slider", message = list(value = 7, label = "Range", hint = "Slide") ) ) ) })