1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
test_that("Legacy widget html methods work", {
# Finds htmlwidgets:::widgetA_html()
res <- widget_html("widgetA", "htmlwidgets", id = "id", style = NULL, class = NULL)
expect_identical(res$name, "canvas")
})
test_that("Legacy widget html methods are warned on unexpected output type", {
expect_warning(
res <- widget_html("widgetB", "htmlwidgets", id = "id", style = NULL, class = NULL),
"widgetB_html returned an object of class `logical` instead of a `shiny.tag`.",
fixed = TRUE
)
expect_identical(res, TRUE)
})
test_that("New-style widget html method works, and is preferred", {
# widgetC has both widgetC_html and widget_html.widgetC, and they return
# differing results. Make sure that widget_html.widgetC is the one that's
# actually called.
res <- widget_html("widgetC", "htmlwidgets", id = "id", style = NULL, class = NULL)
expect_identical(
res,
widget_html.widgetC("widgetC", "htmlwidgets", id = "id", style = NULL, class = NULL))
})
test_that("New-style widget html methods do not trigger warning on non-tag output", {
expect_warning(
res <- widget_html("widgetD", "htmlwidgets", id = "id", style = NULL, class = NULL),
NA
)
expect_identical(res, TRUE)
})
test_that("Fallback logic still works", {
res <- widget_html("does_not_exist", "htmlwidgets", id = "id", style = NULL, class = NULL)
expect_identical(res, tags$div(id = "id"))
})
test_that("Legacy methods work with tagList() and HTML()", {
expect_warning({
widget_html("widgetE", "htmlwidgets", id = "id", style = NULL, class = NULL)
widget_html("widgetF", "htmlwidgets", id = "id", style = NULL, class = NULL)
}, NA)
})
|
