tests/testthat/test-mk_lookup_utils.R

In toniprice/jute: Sundry Utility Functions

# ---------------------------------------------------------------------------- #
# a lookup for testing mk_lookup_utils()

get_new_lkup <- function() {
  mk_lookup_utils(
    list(
      numbers = c(
        french  = "un",
        spanish = "dos",
        italian = "tre"
      ),
      creatures = c(
        llama = "andes"
      ),
      epochs = c(
        kreide    = "Cretaceous",
        discovery = "Age of Discovery"
      )
    )
  )
}

# ---------------------------------------------------------------------------- #
test_that("get_all returns a list", {
  expect_type(get_new_lkup()$get_all(), "list")
})

# ---------------------------------------------------------------------------- #
test_that("get_all returns a list of character vectors", {
  all_lookups <- get_new_lkup()$get_all()

  lapply(seq_along(all_lookups), function(i) {
    expect_type(all_lookups[[i]], "character")
  })
})

# ---------------------------------------------------------------------------- #
test_that("get_all returns a list of character vectors which are all named", {
  all_lookups <- get_new_lkup()$get_all()

  lapply(seq_along(all_lookups), function(i) {
    expect_false(is.null(names(all_lookups[[i]])))
  })
})

# ---------------------------------------------------------------------------- #
test_that("get fails for missing type", {
  expect_jute_error(get_new_lkup()$get())
})

# ---------------------------------------------------------------------------- #
test_that("get fails with message for missing type", {
  expect_snapshot(get_new_lkup()$get(), error = TRUE)
})

# ---------------------------------------------------------------------------- #
test_that("get fails for nonexistent type", {
  expect_jute_error(get_new_lkup()$get("nonexistent"))
})

# ---------------------------------------------------------------------------- #
test_that("get fails with message for nonexistent type", {
  expect_snapshot(get_new_lkup()$get("nonexistent"), error = TRUE)
})

# ---------------------------------------------------------------------------- #
test_that("get works for valid type", {
  expect_equal(
    get_new_lkup()$get("epochs"),
    c(kreide = "Cretaceous", discovery = "Age of Discovery")
  )
})

# ---------------------------------------------------------------------------- #
test_that("descrip works for valid type", {
  actval <- get_new_lkup()$descrip("italian", "numbers")
  expval <- "tre"
  expect_equal(actval, expval)
})

# ---------------------------------------------------------------------------- #
test_that("descrip works for specified lookup", {
  lkup <- get_new_lkup()

  nums_lkup <- lkup$get("numbers")
  actval <- lkup$descrip("french", lookup = nums_lkup)
  expval <- "un"
  expect_equal(actval, expval)
})

# ---------------------------------------------------------------------------- #
test_that("descrip fails for missing key", {
  lkup <- get_new_lkup()$get("numbers")
  expect_jute_error(get_new_lkup()$descrip(lookup = lkup))
})

# ---------------------------------------------------------------------------- #
test_that("descrip fails with message for missing key", {
  lkup <- get_new_lkup()$get("numbers")
  expect_snapshot(get_new_lkup()$descrip(lookup = lkup), error = TRUE)
})

# ---------------------------------------------------------------------------- #
test_that("descrip fails for invalid key", {
  expect_jute_error(get_new_lkup()$descrip("danish", "numbers"))
})

# ---------------------------------------------------------------------------- #
test_that("descrip fails with message for invalid key", {
  expect_snapshot(get_new_lkup()$descrip("danish", "numbers"), error = TRUE)
})

# ---------------------------------------------------------------------------- #
test_that("descrip fails if both type and lookup are NULL", {
  expect_jute_error(get_new_lkup()$descrip("spanish"))
})

# ---------------------------------------------------------------------------- #
test_that("descrip fails with message if both type and lookup are NULL", {
  expect_snapshot(get_new_lkup()$descrip("spanish"), error = TRUE)
})

# ---------------------------------------------------------------------------- #
test_that("descrip retains name if requested", {
  actval <- get_new_lkup()$descrip("llama", "creatures", strip_name = FALSE)
  expval <- c("llama" = "andes")
  expect_equal(actval, expval)
})

# ---------------------------------------------------------------------------- #
test_that("descrip titleizes first letter if requested", {
  actval <- get_new_lkup()$descrip("spanish", "numbers", tf = TRUE)
  expval <- "Dos"
  expect_equal(actval, expval)
})

# ---------------------------------------------------------------------------- #
test_that("descrip leaves first letter as-is if requested", {
  actval <- get_new_lkup()$descrip("spanish", "numbers", tf = FALSE)
  expval <- "dos"
  expect_equal(actval, expval)
})

# ---------------------------------------------------------------------------- #
test_that("get_types retrieves all type names", {
  expect_equal(get_new_lkup()$get_types(), c("numbers", "creatures", "epochs"))
})

# ---------------------------------------------------------------------------- #
test_that("get_choices retrieves all choice names", {
  expect_equal(get_new_lkup()$get_choices("epochs"), c("kreide", "discovery"))
})

# ---------------------------------------------------------------------------- #
test_that("lookup make works as expected", {
  func <- get_new_lkup()$make("creatures")
  expect_equal(func("llama"), "andes")
})

# ---------------------------------------------------------------------------- #
test_that("lookup make_all works as expected", {
  lkup <- get_new_lkup()

  f1 <- lkup$make("numbers")
  f2 <- lkup$make("creatures")
  f3 <- lkup$make("epochs")

  expval <- list(lookup_numbers = f1, lookup_creatures = f2, lookup_epochs = f3)

  expect_equal(lkup$make_all(), expval)
})

# ---------------------------------------------------------------------------- #
test_that("add_to_env works for all lookup functions", {
  lkup <- get_new_lkup()

  f1 <- lkup$make("numbers")
  f2 <- lkup$make("creatures")
  f3 <- lkup$make("epochs")

  an_env <- new.env(parent = emptyenv())
  lkup$add_to_env(an_env)

  info <- "info: lookup_numbers exists"
  expect_true(exists("lookup_numbers", an_env), info)

  info <- "info: lookup_creatures exists"
  expect_true(exists("lookup_creatures", an_env), info)

  info <- "info: lookup_epochs exists"
  expect_true(exists("lookup_epochs", an_env), info)
})

# ---------------------------------------------------------------------------- #
test_that("add_to_env works for a subset of lookup functions", {
  lkup <- get_new_lkup()

  f1 <- lkup$make("numbers")
  f3 <- lkup$make("epochs")

  lst <- list(lookup_numbers = f1, lookup_epochs = f3)

  an_env <- new.env(parent = emptyenv())
  lkup$add_to_env(an_env, lst)

  expect_true(exists("lookup_numbers", an_env), "info: lookup_numbers exists")
  expect_true(exists("lookup_epochs", an_env), "info: lookup_epochs exists")

  info <- "info: lookup_creatures does not exist"
  expect_false(exists("lookup_creatures", an_env), info)
})

# ---------------------------------------------------------------------------- #