tests/testthat/test-tib_spec.R

In tibblify: Rectangle Nested Lists

# spec_* ------------------------------------------------------------------

test_that("errors on invalid names", {
  expect_snapshot({
    # duplicated name
    (expect_error(tspec_df(x = tib_int("x"), x = tib_int("y"))))
  })
})

test_that("errors if element is not a tib collector", {
  expect_snapshot({
    (expect_error(tspec_df(1)))
    (expect_error(tspec_df(x = tib_int("x"), y = "a")))
  })
})

test_that("can infer name from key", {
  expect_equal(tspec_df(tib_int("x")), tspec_df(x = tib_int("x")))

  expect_equal(
    tspec_df(tib_row("x", tib_int("a"))),
    tspec_df(x = tib_row("x", a = tib_int("a")))
  )

  expect_snapshot({
    (expect_error(tspec_df(tib_int(c("a", "b")))))

    # auto name creates duplicated name
    (expect_error(tspec_df(y = tib_int("x"), tib_int("y"))))
  })
})

test_that("drops NULL", {
  expect_equal(
    tspec_row(tib_int("a"), NULL, if (FALSE) tib_chr("b")),
    tspec_row(tib_int("a"))
  )
})

test_that("can nest specifications", {
  spec1 <- tspec_row(
    a = tib_int("a"),
    b = tib_int("b")
  )
  spec2 <- tspec_row(
    c = tib_chr("c"),
    d = tib_row("d", x = tib_int("x"))
  )

  expect_equal(
    tspec_df(spec1),
    tspec_df(!!!spec1$fields)
  )

  expect_equal(
    tspec_df(spec1, spec2),
    tspec_df(!!!spec1$fields, !!!spec2$fields)
  )

  expect_snapshot((expect_error(tspec_df(spec1, spec1))))
})

test_that("errors on invalid `.names_to`", {
  expect_snapshot({
    (expect_error(tspec_df(.names_to = NA_character_)))
    (expect_error(tspec_df(.names_to = 1)))
  })
})

test_that("errors if `.names_to` column name is not unique", {
  expect_snapshot((expect_error(tspec_df(x = tib_int("x"), .names_to = "x"))))
})

test_that("errors if `.names_to` is used with colmajor", {
  expect_snapshot({
    (expect_error(tspec_df(.names_to = "x", .input_form = "colmajor")))
  })
})

test_that("errors if `vector_allows_empty_list` is invalid", {
  expect_snapshot({
    (expect_error(tspec_df(vector_allows_empty_list = NA)))
    (expect_error(tspec_df(vector_allows_empty_list = "a")))
  })
})


# tib_* -------------------------------------------------------------------

test_that("errors on invalid `key`", {
  expect_snapshot({
    (expect_error(tib_int(character())))

    (expect_error(tib_int(NA_character_)))
    (expect_error(tib_int("")))
    (expect_error(tib_int(1L)))

    (expect_error(tib_int(c("x", NA))))
    (expect_error(tib_int(c("x", ""))))
  })
})

test_that("errors on invalid `required`", {
  expect_snapshot({
    (expect_error(tib_int("x", required = logical())))

    (expect_error(tib_int("x", required = NA)))
    (expect_error(tib_int("x", required = 1L)))
    (expect_error(tib_int("x", required = c(TRUE, FALSE))))
  })
})

test_that("errors if dots are not empty", {
  expect_snapshot({
    (expect_error(tib_int("x", TRUE)))
  })
})

test_that("empty dots create empty list", {
  expect_equal(tspec_df()$fields, list())
  expect_equal(tspec_row()$fields, list())
  expect_equal(tspec_object()$fields, list())

  expect_equal(tib_df("x")$fields, list())
  expect_equal(tib_row("x")$fields, list())
})

test_that("tib_scalar checks arguments", {
  model <- lm(Sepal.Length ~ Sepal.Width, data = iris)
  # ptype
  expect_snapshot({
    (expect_error(tib_scalar("x", model)))
  })

  # ptype_inner
  expect_snapshot({
    (expect_error(tib_chr("x", ptype_inner = model)))
  })

  # fill
  expect_snapshot({
    (expect_error(tib_int("x", fill = integer())))
    (expect_error(tib_int("x", fill = 1:2)))
    (expect_error(tib_int("x", fill = "a")))
  })

  # ptype_inner + fill
  expect_snapshot({
    (expect_error(tib_chr("x", fill = 0L, ptype_inner = character())))
  })

  # transform
  expect_snapshot({
    (expect_error(tib_int("x", transform = integer())))
  })
})

test_that("tib_vector checks arguments", {
  # input_form
  expect_snapshot({
    (expect_error(tib_int_vec("x", input_form = "v")))
  })

  model <- lm(Sepal.Length ~ Sepal.Width, data = iris)
  # ptype
  expect_snapshot({
    (expect_error(tib_vector("x", ptype = model)))
  })

  # ptype_inner
  expect_snapshot({
    (expect_error(tib_chr_vec("x", ptype_inner = model)))
  })

  # values_to
  expect_snapshot({
    (expect_error(tib_int_vec("x", values_to = NA)))
    (expect_error(tib_int_vec("x", values_to = 1)))
    (expect_error(tib_int_vec("x", values_to = c("a", "b"))))
  })

  # names_to
  expect_snapshot({
    # input_form != "object"
    (expect_error(tib_int_vec("x", input_form = "scalar_list", values_to = "val", names_to = "name")))
    # values_to = NULL
    (expect_error(tib_int_vec("x", input_form = "object", names_to = "name")))
    # values_to = names_to
    (expect_error(tib_int_vec("x", input_form = "object", values_to = "val", names_to = "val")))

    (expect_error(tib_int_vec("x", input_form = "object", values_to = "val", names_to = 1)))
    (expect_error(tib_int_vec("x", input_form = "object", values_to = "val", names_to = c("a", "b"))))
  })
})

test_that("tib_chr_date works", {
  expect_equal(
    tib_chr_date("a"),
    tib_scalar_impl(
      "a",
      ptype = vctrs::new_date(),
      ptype_inner = character(),
      format = "%Y-%m-%d",
      transform = ~ as.Date(.x, format = format),
      class = "tib_scalar_chr_date"
    ),
    ignore_function_env = TRUE
  )

  expect_equal(
    tib_chr_date_vec("a"),
    tib_vector_impl(
      "a",
      ptype = vctrs::new_date(),
      ptype_inner = character(),
      format = "%Y-%m-%d",
      transform = ~ as.Date(.x, format = format),
      class = "tib_vector_chr_date"
    ),
    ignore_function_env = TRUE
  )
})

test_that("tib_df() checks arguments", {
  expect_snapshot({
    (expect_error(tib_df("x", .names_to = 1)))
  })
})

test_that("tib_df() drops NULL", {
  expect_equal(
    tib_df("df", tib_int("a"), NULL, if (FALSE) tib_chr("b")),
    tib_df("df", tib_int("a"))
  )
})

test_that("special ptypes are not incorrectly recognized", {
  check_native <- function(ptype, class) {
    expect_s3_class(
      tib_scalar("a", ptype = ptype),
      c(paste0("tib_scalar_", class), "tib_scalar", "tib_collector"),
      exact = TRUE
    )

    class(ptype) <- c("a", class(ptype))
    expect_s3_class(
      tib_scalar("a", ptype = ptype),
      c("tib_scalar", "tib_collector"),
      exact = TRUE
    )
  }

  check_native(logical(), "logical")
  check_native(character(), "character")
  check_native(integer(), "integer")
  check_native(numeric(), "numeric")
  check_native(vctrs::new_date(), "date")
})