tests/testthat/test-s3.R

In hadley/rlang: Functions for Base Types and Core R and 'Tidyverse' Features

test_that("inherits from all classes", {
  x <- structure(list(), class = c("foo", "bar", "baz"))

  expect_true(inherits_all(x, c("foo")))
  expect_true(inherits_all(x, c("foo", "baz")))
  expect_true(inherits_all(x, c("foo", "bar", "baz")))

  expect_false(inherits_all(x, c("fooz")))
  expect_false(inherits_all(x, c("foo", "barz", "baz")))
  expect_false(inherits_all(x, c("fooz", "bar", "baz")))

  expect_error(inherits_all(x, chr()), "empty")
})

test_that("inherits from any class", {
  x <- structure(list(), class = "bar")

  expect_true(inherits_any(x, c("bar", "foo")))
  expect_true(inherits_any(x, c("foo", "bar")))
  expect_true(inherits_any(x, c("foo", "bar", "baz")))

  expect_false(inherits_any(x, c("foo", "baz")))

  expect_error(inherits_any(x, chr()), "empty")
})

test_that("inherits only from class", {
  x <- structure(list(), class = c("foo", "bar", "baz"))
  expect_false(inherits_only(x, c("foo", "baz")))
  expect_true(inherits_only(x, c("foo", "bar", "baz")))
})

test_that("can box and unbox a value", {
  box <- new_box(letters, "foo")
  expect_true(is_box(box))
  expect_true(is_box(box), "foo")
  expect_false(is_box(box, "bar"))
  expect_identical(unbox(box), letters)

  box <- new_box(NULL, c("foo", "bar", "baz"))
  expect_true(is_box(box, c("foo", "baz")))
  expect_false(is_box(box, c("baz", "foo")))
})

test_that("as_box() ensures boxed value", {
  box <- as_box(NULL)
  expect_true(inherits_only(box, "rlang_box"))

  boxbox <- as_box(box)
  expect_true(inherits_only(box, "rlang_box"))
  expect_null(unbox(box))

  some_box <- as_box(NULL, "some_box")
  some_boxbox <- as_box(some_box, "other_box")
  expect_true(inherits_only(some_boxbox, c("other_box", "rlang_box")))
  expect_true(inherits_only(unbox(some_boxbox), c("some_box", "rlang_box")))
  expect_null(unbox(unbox(some_boxbox)))
})

test_that("as_box_if() ensures boxed value if predicate returns TRUE", {
  box <- as_box_if(NULL, is_null, "null_box")
  expect_true(inherits_only(box, c("null_box", "rlang_box")))

  boxbox <- as_box_if(box, is_null, "null_box")
  expect_true(inherits_only(box, c("null_box", "rlang_box")))
  expect_null(unbox(boxbox))

  expect_null(as_box_if(NULL, is_vector, "null_box"))

  expect_snapshot({
    (expect_error(as_box_if(NULL, ~ 10)))
    (expect_error(as_box_if(NULL, ~ c(TRUE, FALSE))))
  })
})

test_that("unboxing a non-boxed value is an error", {
  expect_error(unbox(NULL), "must be a box")
})

test_that("zap() creates a zap", {
  expect_s3_class(zap(), "rlang_zap")
  expect_true(is_zap(zap()))
})

test_that("can pass additional attributes to boxes", {
  box <- new_box(NA, "foo", bar = "baz")
  expect_identical(box %@% bar, "baz")
})

test_that("done() boxes values", {
  expect_true(is_done_box(done(3)))
  expect_identical(unbox(done(3)), 3)
  expect_identical(done(3) %@% empty, FALSE)
})

test_that("done() can be empty", {
  empty <- done()

  expect_identical(unbox(empty), missing_arg())

  expect_true(is_done_box(empty))
  expect_s3_class(empty, "rlang_box_done")
  expect_identical(empty %@% empty, TRUE)

  expect_true(is_done_box(empty, empty = TRUE))
  expect_false(is_done_box(empty, empty = FALSE))

  nonempty <- done(missing_arg())
  expect_false(is_done_box(nonempty, empty = TRUE))
  expect_true(is_done_box(nonempty, empty = FALSE))
})

test_that("splice box is constructed", {
  box <- splice(list(NA))
  expect_true(is.object(box))
  expect_identical(box, structure(list(list(NA)), class = c("rlang_box_splice", "rlang_box")))
})