tests/testthat/test-assertthat.R

In pkgdepends: Package Dependency Resolution and Downloads

test_that("basic", {
  expect_true(assert_that())
  expect_true(assert_that(TRUE))
  expect_true(assert_that(TRUE, TRUE))
  expect_true(assert_that(TRUE, TRUE, TRUE))

  expect_error(assert_that(FALSE), class = "assertError")
  expect_error(assert_that(TRUE, FALSE), class = "assertError")
})

test_that("failure in predicate", {
  assert <- function() assert_that(isTRUE(FALSE))
  expect_snapshot(
    error = TRUE,
    assert_that(assert())
  )
})

test_that("assert_error", {
  fn <- function() {
    assert_error(
      quote(isTRUE(FALSE)),
      result = FALSE,
      msg = "FALSE is not TRUE",
      .data = list(extra = "info"),
      .class = "extraClass",
      call. = sys.call()
    )
  }
  expect_snapshot(fn())
})

test_that("assertion returns invalid value", {
  expect_snapshot(
    error = TRUE,
    assert_that(2 * 2)
  )
  expect_snapshot(
    error = TRUE,
    assert_that(c(TRUE, FALSE))
  )
  expect_snapshot(
    error = TRUE,
    assert_that(NA)
  )
})

test_that("default messages", {
  if (is_windows() && getRversion() < "4.0.0") skip("No magick")
  asciicast::expect_snapshot_r_process(
    transform = function(x) {
      transform_no_srcref(transform_no_links(transform_show_cursor(x)))
    },
    fn <- function(x) assert_that(x == 1),
    fn(2),

    fn <- function(x) assert_that(x < 1),
    fn(2),

    fn <- function(x) assert_that(x > 2),
    fn(1),

    fn <- function(x) assert_that(x >= 2),
    fn(1),

    fn <- function(x) assert_that(x <= 1),
    fn(2),

    fn <- function(x) assert_that(x != 1),
    fn(2)
  )

  asciicast::expect_snapshot_r_process(
    transform = transform_show_cursor,
    fn <- function(x) assert_that(is.atomic(x)),
    fn(mtcars),

    fn <- function(x) assert_that(is.character(x)),
    fn(1:2),

    fn <- function(x) assert_that(is.complex(x)),
    fn(1:5),

    fn <- function(x) assert_that(is.double(x)),
    fn(letters),

    fn <- function(x) assert_that(is.integer(x)),
    fn(letters),

    fn <- function(x) assert_that(is.numeric(x)),
    fn(letters),

    fn <- function(x) assert_that(is.raw(x)),
    fn(1:10),

    fn <- function(x) assert_that(is.vector(x)),
    fn(mtcars)
  )

  asciicast::expect_snapshot_r_process(
    transform = transform_show_cursor,
    fn <- function(x) assert_that(is.factor(x)),
    fn(letters),

    fn <- function(x) assert_that(is.ordered(x)),
    fn(factor(letters)),

    fn <- function(x) assert_that(is.array(x)),
    fn(factor(letters)),

    fn <- function(x) assert_that(is.ordered(x)),
    fn(factor(letters)),

    fn <- function(x) assert_that(is.array(x)),
    fn(letters),

    fn <- function(x) assert_that(is.data.frame(x)),
    fn(1:10),

    fn <- function(x) assert_that(is.list(x)),
    fn("foobar"),

    fn <- function(x) assert_that(is.matrix(x)),
    fn(letters),

    fn <- function(x) assert_that(is.null(x)),
    fn("not"),

    fn <- function(x) assert_that(is.environment(x)),
    fn(list()),

    fn <- function(x) assert_that(is.function(x)),
    fn("clearly noy"),

    fn <- function(x) assert_that(is.promitive(x)),
    fn(asesrt_that),

    fn <- function(x) assert_that(is.call(x)),
    fn("not"),

    fn <- function(x) assert_that(is.expression(x)),
    fn(mtcars),

    fn <- function(x) assert_that(is.name(x)),
    fn("not really"),

    fn <- function(x) assert_that(is.pairlist(x)),
    fn(1:10),

    fn <- function(x) assert_that(is.recursive(x)),
    fn(1),

    fn <- function(x) assert_that(is.symbol(x)),
    fn("almost"),

  )

  asciicast::expect_snapshot_r_process(
    transform = transform_show_cursor,
    fn <- function(x, y) assert_that(x && y),
    fn(is.integer(1L), is.integer("a")),

    fn <- function(x, y) assert_that(x || y),
    fn(is.integer("b"), is.integer("a")),

    fn <- function(x) assert_that(any(x)),
    fn(rep(FALSE, 10)),

    fn <- function(x) assert_that(all(x)),
    fn(c(FALSE, TRUE, TRUE)),

    fn <- function(x) assert_that(file.exists(x)),
    fn("/file7e0fe1739e0"),

    fn <- function(x, y) assert_that(identical(x, y)),
    fn(1, 1L)
  )
})

test_that("long call is truncated", {
  expect_snapshot(
    fail_default(call("==", strrep("-", 100), strrep("x", 100)))
  )
})

test_that("has_attr", {
  expect_true(
    has_attr(mtcars, "class"))
  expect_snapshot(
    error = TRUE,
    assert_that(has_attr(1L, "foobar"))
  )

  expect_true(mtcars %has_attr% "class")
  expect_snapshot(
    error = TRUE,
    assert_that(1L %has_attr% "foobar")
  )
})

test_that("custom message", {
  fn <- function(name) {
    assert_that(
      is_string(name),
      msg = c(
        "{.arg {(.arg)}} must be a name (character scalar).",
        i = "It is {.type {name}}."
      )
    )
  }
  expect_snapshot(
    error = TRUE,
    fn(1:10)
  )
})