From ac39353117620784572208ad72f9b4f0cebc17ec Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Sun, 16 Feb 2020 10:06:42 -0500 Subject: [PATCH 1/4] :rotating_light: add layout unit test --- tests/testthat/test-layout.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 tests/testthat/test-layout.R diff --git a/tests/testthat/test-layout.R b/tests/testthat/test-layout.R new file mode 100644 index 00000000..4bc783ff --- /dev/null +++ b/tests/testthat/test-layout.R @@ -0,0 +1,12 @@ +context("layout") + +test_that("layout IDs must be unique", { + + app <- Dash$new() + + expect_error( + app$layout(htmlA(id = "a"), htmlA(id = "a")), + "layout ids must be unique -- the following id was duplicated: 'a'" + ) + +}) From 596b1e6545de133607fab85db6c2cffd174377b7 Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Sun, 16 Feb 2020 10:12:56 -0500 Subject: [PATCH 2/4] :rotating_light: restore API unit tests --- tests/testthat/test-dash.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 tests/testthat/test-dash.R diff --git a/tests/testthat/test-dash.R b/tests/testthat/test-dash.R new file mode 100644 index 00000000..e7779dc2 --- /dev/null +++ b/tests/testthat/test-dash.R @@ -0,0 +1,28 @@ +context("dash-api") + +test_that("Can access fiery server within a dash app", { + + d <- Dash$new() + expect_is(d, c("Dash", "R6")) + expect_is(d$server, c("Fiery", "R6")) + +}) + +test_that("Can set/get layout", { + + d <- Dash$new() + div <- htmlDiv("A div", id = "An id") + + # rendered layout has a container div + d$layout(div) + l <- d$layout_get() + expect_true(dash:::is.layout(l)) + expect_identical(l$props$children[[1]], div) + + # dynamic layouts + d$layout(function() { div }) + l2 <- d$layout_get() + expect_identical(l, l2) + expect_is(d$layout_get(render = FALSE), "function") + +}) From b111ec78e66245aefec46d10e36fe08eec2cb486 Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Sun, 16 Feb 2020 19:44:45 -0500 Subject: [PATCH 3/4] :rotating_light: add wildcards unit tests --- tests/testthat/test-wildcards.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 tests/testthat/test-wildcards.R diff --git a/tests/testthat/test-wildcards.R b/tests/testthat/test-wildcards.R new file mode 100644 index 00000000..5f35ab22 --- /dev/null +++ b/tests/testthat/test-wildcards.R @@ -0,0 +1,28 @@ +context("wildcards") + +test_that("HTML `data-*` & `aria-* ` wildcards work", { + x <- htmlDiv(`data-foo` = 1) + expect_equal(x$props$`data-foo`, 1) + expect_true("data-foo" %in% x$propNames) + + x <- htmlDiv(`aria-bar` = "b") + expect_equal(x$props$`aria-bar`, "b") + expect_true("aria-bar" %in% x$propNames) + + x <- htmlDiv(`data-foo` = NA, `aria-bar` = 1:10) + expect_equal(x$props$`data-foo`, NA) + expect_equal(x$props$`aria-bar`, 1:10) + expect_true("data-foo" %in% x$propNames) + expect_true("aria-bar" %in% x$propNames) +}) + + +test_that("HTML `data-*` & `aria-* ` wildcards are passed along to layout appropriately ", { + app <- Dash$new() + app$layout(htmlDiv(id = "foo", `data-foo` = 1)) + x <- app$layout_get() + expect_equal(x$props$children[[1]]$props$`data-foo`, 1) +}) + +# TODO: test NULL values aren't rendered on the HTML div +# https://github.com/plotly/dash/pull/237/files#r179251041 From 830c58f6fcde7bf14ddf72c790e12761bc4b7cba Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Sun, 16 Feb 2020 19:54:07 -0500 Subject: [PATCH 4/4] :rotating_light: add components unit tests --- tests/testthat/test-components.R | 93 ++++++++++++++++++++++++++++++++ 1 file changed, 93 insertions(+) create mode 100644 tests/testthat/test-components.R diff --git a/tests/testthat/test-components.R b/tests/testthat/test-components.R new file mode 100644 index 00000000..d1ef450e --- /dev/null +++ b/tests/testthat/test-components.R @@ -0,0 +1,93 @@ +context("components") + +test_that("Components work recursively (components can be children of components)", { + + # div inside a div + x <- dashHtmlComponents::htmlDiv(id = "one", htmlDiv(id = "two")) + expect_true(dash:::is.component(x)) + expect_true(dash:::is.component(x[[1]]$children)) + + # slider inside a div + x <- htmlDiv( + dashCoreComponents::dccSlider( + id = "h", + min = 1, + max = 100, + value = 48 + ) + ) + + expect_true(dash:::is.component(x)) + expect_true(dash:::is.component(x[[1]]$children)) + slider <- x$props + expect_true(slider$children$props[["id"]] == "h") + expect_true(slider$children$props[["min"]] == 1) + expect_true(slider$children$props[["max"]] == 100) + expect_true(slider$children$props[["value"]] == 48) +}) + +test_that("Component constructors behave as intended", { + + # components have three main keys + # (1) props: or the main properties, which are recursive (component) + # (2) type: or the 'name' of the component + # (3) namespace: is this a core/html component? + + expect_component_names <- function(component) { + diff <- dash:::setdiffsym(names(component), c("props", "type", "namespace", "propNames", "package")) + expect_length(diff, 0) + } + + expect_component_names(dashHtmlComponents::htmlA()) + expect_component_names(dashCoreComponents::dccDropdown()) + + expect_equal( + htmlH2("A header")$props$children[[1]], "A header" + ) + + # test akin to this one https://github.com/plotly/dash-renderer/blob/851d717b/tests/test_render.py#L25-L38 + vals <- list("Basic string", 3.14, NULL, htmlDiv("Just a test")) + prop_vals <- htmlH2(vals)$props + expect_identical(prop_vals$children[[1]], vals[[1]]) + + # TODO: test the rendered DOM! + +}) + + +test_that("Giving nonsense arguments to components yields error", { + expect_error( + htmlA(nonsense = "string", gibberish = "string"), + "The following props are not valid in this component: 'nonsense, gibberish'", + fixed = TRUE + ) +}) + +# test_that("Can identify whether a component contains a component of a given type", { +# g <- dashCoreComponents::dccGraph() +# s <- dashCoreComponents::dccSlider() +# expect_true(dash:::component_contains_type(g, "dashCoreComponents", "Graph")) +# expect_false(dash:::component_contains_type(g, "dash", "Graph")) +# expect_false(dash:::component_contains_type(s, "dashCoreComponents", "Graph")) +# expect_true(dash:::component_contains_type(htmlDiv(children=list(s, htmlDiv(g))), "dashCoreComponents", "Graph")) +# }) + +test_that("wildcard attributes work with children", { + s1 <- htmlSpan("hmm", className = "value-output", `data-icon` = "fa-pencil") + s2 <- htmlSpan(children = list("hmm"), className = "value-output", `data-icon` = "fa-pencil") + + expect_equal(s1$props$children, "hmm") + expect_equal(s1$props$`data-icon`, "fa-pencil") + expect_equal(s2$props$children, list("hmm")) + expect_equal(s2$props$`data-icon`, "fa-pencil") +}) + +# test_that("Can translate arbitrary HTML string", { +# skip_if_not_installed("dashDangerouslySetInnerHtml") +# +# html <- "
1
" +# expect_is( +# dashDangerouslySetInnerHtml::DangerouslySetInnerHTML(HTML(html)), +# "dash_component" +# ) +# })