tests/testthat/test-crosstalk.R

In crosstalk: Inter-Widget Interactivity for HTML Widgets

set.seed(64327883)

run_main_test <- function() {
  expect_identical(
    SharedData$new(mtcars)$key(),
    row.names(mtcars)
  )
  expect_identical(
    SharedData$new(mtcars, NULL)$key(),
    row.names(mtcars)
  )

  expect_identical(SharedData$new(mtcars)$data(), mtcars)
  expect_identical(SharedData$new(mtcars)$origData(), mtcars)

  expect_identical(
    SharedData$new(mtcars)$data(TRUE, FALSE, TRUE),
    cbind(mtcars, selected_ = NA, key_ = row.names(mtcars),
      stringsAsFactors = FALSE)
  )

  mtcarsWithNames <- mtcars
  row.names(mtcarsWithNames) <- NULL
  mtcarsWithNames <- cbind(id = row.names(mtcars), mtcarsWithNames,
    stringsAsFactors = FALSE)

  expect_identical(
    SharedData$new(mtcarsWithNames, mtcarsWithNames[["id"]])$key(),
    row.names(mtcars)
  )

  expect_identical(
    SharedData$new(iris, group = "Iris")$groupName(),
    "Iris"
  )
}

test_that("SharedData basic scenarios", {
  skip_if_not_installed("shiny")
  run_main_test()

  expect_error(SharedData$new(iris)$selection(), "reactive")
  shiny::isolate(expect_identical(SharedData$new(iris)$selection(), NULL))
})

test_that("SharedData basic scenarios with shiny 'uninstalled'", {
  skip_if_not_installed("shiny")

  # Force shinyIsInstalled() to return false
  op <- options(crosstalk.shiny.suppressed = TRUE)
  on.exit(options(op), add = TRUE)

  # After this test is over, unload shiny to undo our breakage (below)
  on.exit(unloadNamespace("shiny"), add = TRUE)

  # Break Shiny, so if Shiny functions are called they won't succeed, as
  # if Shiny is not installed.
  pkgEnv <- asNamespace("shiny")
  for (nm in ls(pkgEnv)) {
    unlockBinding(nm, pkgEnv)
    pkgEnv[[nm]] <- NULL
  }

  run_main_test()
  expect_error(SharedData$new(iris)$selection(), "requires.*shiny")

  # While we're at it, run examples
  library(crosstalk)
  helpPath <- file.path(system.file("help", package = "crosstalk"), "crosstalk")
  if (file.exists(paste0(helpPath, ".rdx"))) {
    topics <- names(tools:::fetchRdDB(helpPath))
    for (topic in topics) {
      suppressWarnings({
        eval(bquote(example(.(topic), package = "crosstalk")))
      })
    }
  }
})

test_that("Shiny modules support SharedData", {
  sess <- shiny::MockShinySession$new()
  sd1 <- shiny::withReactiveDomain(sess, {
    SharedData$new(cars, group = "foo")
  })
  sd2 <- shiny::withReactiveDomain(sess$makeScope("module1"), {
    SharedData$new(cars, group = "foo")
  })

  sess$setInputs(".clientValue-foo-selection" = c("1", "2"))

  res <- c(TRUE, TRUE, rep_len(FALSE, nrow(cars) - 2))
  expect_identical(shiny::isolate(sd1$selection()), res)
  expect_identical(shiny::isolate(sd2$selection()), res)

  res2 <- rev(res)
  sess$setInputs(".clientValue-foo-selection" = as.character(which(res2)))

  expect_identical(shiny::isolate(sd1$selection()), res2)
  expect_identical(shiny::isolate(sd2$selection()), res2)

})