Add assortment of unit tests to Dash for R

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 <- "<div> 1 </div>"
+#   expect_is(
+#     dashDangerouslySetInnerHtml::DangerouslySetInnerHTML(HTML(html)),
+#     "dash_component"
+#   )
+# })

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")
+
+})

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'"
+  )
+
+})

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