test_that("wa_popup defaults render the minimal wrapper", { expect_exact_html( render_html(shiny.webawesome:::wa_popup("Popup body")), c("Popup body") ) }) test_that("wa_popup override render includes attrs and slots", { expect_exact_html( render_html( shiny.webawesome:::wa_popup( "Popup body", id = "popup", active = TRUE, anchor = "trigger", arrow = TRUE, arrow_padding = 10, arrow_placement = "center", auto_size = "both", auto_size_padding = 4, auto_size_boundary = "viewportBoundary", boundary = "scroll", dir = "rtl", distance = 12, flip = TRUE, flip_fallback_placements = "top bottom", flip_fallback_strategy = "initial", flip_padding = 6, flip_boundary = "clipBoundary", hover_bridge = TRUE, lang = "en", placement = "bottom-start", shift = TRUE, shift_padding = 3, shift_boundary = "shiftBoundary", skidding = 5, sync = "width", anchor_slot = "Anchor slot" ) ), c( paste0( '' ), " Popup body", ' Anchor slot', "" ) ) }) test_that("wa_popup boolean args validate and render correctly", { default_html <- render_html(shiny.webawesome:::wa_popup("Popup body")) boolean_args <- c( active = "active", arrow = "arrow", flip = "flip", hover_bridge = "hover-bridge", shift = "shift" ) for (arg_name in names(boolean_args)) { attr_name <- boolean_args[[arg_name]] tag <- do.call( shiny.webawesome:::wa_popup, c(list("Popup body"), stats::setNames(list(TRUE), arg_name)) ) expect_exact_html( render_html(tag), c(sprintf("Popup body", attr_name)) ) false_tag <- do.call( shiny.webawesome:::wa_popup, c(list("Popup body"), stats::setNames(list(FALSE), arg_name)) ) expect_equal(render_html(false_tag), default_html) null_tag <- do.call( shiny.webawesome:::wa_popup, c(list("Popup body"), stats::setNames(list(NULL), arg_name)) ) expect_equal(render_html(null_tag), default_html) expect_error( do.call( shiny.webawesome:::wa_popup, c(list("Popup body"), stats::setNames(list("yes"), arg_name)) ), sprintf("`%s` must be TRUE, FALSE, or NULL.", arg_name), fixed = TRUE ) } }) test_that("wa_popup enum arguments validate exactly", { enum_cases <- list( list( arg = "arrow_placement", attr = "arrow-placement", valid = "anchor", invalid = "middle" ), list( arg = "auto_size", attr = "auto-size", valid = "vertical", invalid = "auto" ), list( arg = "boundary", attr = "boundary", valid = "viewport", invalid = "page" ), list( arg = "flip_fallback_strategy", attr = "flip-fallback-strategy", valid = "best-fit", invalid = "nearest" ), list( arg = "placement", attr = "placement", valid = "top-end", invalid = "center" ), list(arg = "sync", attr = "sync", valid = "both", invalid = "auto") ) for (case in enum_cases) { tag <- do.call( shiny.webawesome:::wa_popup, c(list("Popup body"), stats::setNames(list(case$valid), case$arg)) ) expect_exact_html( render_html(tag), c( sprintf( 'Popup body', case$attr, case$valid ) ) ) expect_error( do.call( shiny.webawesome:::wa_popup, c(list("Popup body"), stats::setNames(list(case$invalid), case$arg)) ), sprintf("`%s` must be one of ", case$arg), fixed = TRUE ) } })