tests/testthat/test-utils.R

In YTLogos/shiny: Web Application Framework for R

context("utils")

test_that("Private randomness works at startup", {

  if (exists(".Random.seed", envir = .GlobalEnv))
    rm(".Random.seed", envir = .GlobalEnv)
  .globals$ownSeed <- NULL
  # Just make sure this doesn't blow up
  createUniqueId(4)
})

test_that("Setting process-wide seed doesn't affect private randomness", {
  set.seed(0)
  id1 <- createUniqueId(4)
  set.seed(0)
  id2 <- createUniqueId(4)

  expect_false(identical(id1, id2))
})

test_that("Resetting private seed doesn't result in dupes", {
  .globals$ownSeed <- NULL
  id3 <- createUniqueId(4)
  # Make sure we let enough time pass that reinitializing the seed is
  # going to result in a different value. This is especially required
  # on Windows.
  Sys.sleep(1)
  set.seed(0)
  .globals$ownSeed <- NULL
  id4 <- createUniqueId(4)

  expect_false(identical(id3, id4))
})

test_that("Clearing process-wide seed doesn't affect private randomness", {
  set.seed(NULL)
  id5 <- createUniqueId(4)
  set.seed(NULL)
  id6 <- createUniqueId(4)

  expect_false(identical(id5, id6))
})

test_that("Setting the private seed explicitly results in identical values", {
  set.seed(0)
  .globals$ownSeed <- .Random.seed
  id7 <- createUniqueId(4)
  set.seed(0)
  .globals$ownSeed <- .Random.seed
  id8 <- createUniqueId(4)

  expect_identical(id7, id8)
})

test_that("need() works as expected", {

  # These are all falsy

  expect_false(need(FALSE, FALSE))
  expect_false(need(NULL, FALSE))
  expect_false(need("", FALSE))

  expect_false(need(character(0), FALSE))
  expect_false(need(logical(0), FALSE))
  expect_false(need(numeric(0), FALSE))
  expect_false(need(integer(0), FALSE))
  expect_false(need(complex(0), FALSE))
  expect_false(need(matrix(), FALSE))

  expect_false(need(NA, FALSE))
  expect_false(need(NA_integer_, FALSE))
  expect_false(need(NA_real_, FALSE))
  expect_false(need(NA_complex_, FALSE))
  expect_false(need(NA_character_, FALSE))

  expect_false(need(c(NA, NA, FALSE), FALSE))
  expect_false(need(c(FALSE), FALSE))

  expect_false(need(try(stop("boom"), silent = TRUE), FALSE))

  # These are all truthy

  expect_null(need(0, FALSE))
  expect_null(need(1:10, FALSE))
  expect_null(need(LETTERS, FALSE))
  expect_null(need("NA", FALSE))
  expect_null(need(TRUE, FALSE))
  expect_null(need(c(NA, NA, TRUE), FALSE))
  expect_null(need(c(FALSE, FALSE, TRUE), FALSE))
})

test_that("req works", {
  expect_error(req(TRUE, FALSE))
  expect_error(req(TRUE, stop("boom")))
  expect_equivalent(req(1, TRUE), 1)

  # req arguments short circuit when a falsy value is found
  value <- 0
  expect_error(req(NULL, value <- 1))
  expect_equal(value, 0)

  # first argument is evaluated exactly once
  value <- 0
  req(value <- value + 1)
  expect_equal(value, 1)

  # correct environment is used
  req2 <- function(...) {
    req(...)
  }
  value <- 0
  req2(value <- value + 1)
  expect_equal(value, 1)

  # Lots of args are supported
  expect_error(do.call(req, c(as.list(1:1000), list(NULL))))
  expect_equal(1, do.call(req, as.list(1:1000)))
})

test_that("anyUnnamed works as expected", {
  expect_false(anyUnnamed(list()))
  expect_true(anyUnnamed(list(1,2,3)))
  expect_true(anyUnnamed(list(A = 1,2,3)))
  expect_false(anyUnnamed(list(A = 1,B = 2,C = 3)))

  # List with named elements removed
  x <- list(A = 1, B = 2, 3, 4)
  x <- x[3:4]
  expect_true(anyUnnamed(x))
})

test_that("sortByName works as expected", {
  # Error if any unnamed elements
  expect_error(sortByName(c("a", "b")))
  expect_error(sortByName(list(a=1, 2)))

  expect_identical(sortByName(NULL), NULL)
  expect_identical(sortByName(numeric(0)), numeric(0))
  expect_identical(sortByName(character(0)), character(0))
  # Empty unnamed list
  expect_identical(sortByName(list()), list())
  # Empty named list
  expect_identical(sortByName(list(a=1)[0]), list(a=1)[0])

  expect_identical(sortByName(list(b=1, a=2)), list(a=2, b=1))
  expect_identical(sortByName(list(b=1)), list(b=1))

  # Ties are resolved by using original order
  expect_identical(sortByName(list(b=1, a=2, b=3)), list(a=2, b=1, b=3))
  expect_identical(sortByName(list(b=3, a=2, b=1)), list(a=2, b=3, b=1))

  # Make sure atomic vectors work
  expect_identical(sortByName(c(b=1, a=2)), c(a=2, b=1))
  expect_identical(sortByName(c(b=1, a=2, b=3)), c(a=2, b=1, b=3))
})

test_that("Callbacks fire in predictable order", {
  cb <- Callbacks$new()

  x <- numeric(0)
  cb$register(function() {
    x <<- c(x, 1)
  })
  cb$register(function() {
    x <<- c(x, 2)
  })
  cb$register(function() {
    x <<- c(x, 3)
  })
  cb$invoke()
  expect_equal(x, c(1, 2, 3))
})