tests/testthat/test-position-class.R

In jeanmanguy/peptr: What the Package Does (One Line, Title Case)

x <- c(1L, 2L, 3L)
y <- peptr_position(x)

# Instancing ----

test_that("new_position works", {
  expect_equal(vctrs::vec_size(new_position()), 0)
  expect_s3_class(new_position(), class = c("peptr_position", "vctrs_vctr"))
  expect_equal(vctrs::vec_size(new_position(x)), 3)
})

test_that("peptr_position works", {
  expect_equal(vctrs::vec_size(peptr_position()), 0)
  expect_equal(class(peptr_position()), c("peptr_position", "vctrs_vctr"))
  expect_equal(
    class(y),
    c("peptr_position", "vctrs_vctr")
  )
  expect_equal(
    class(peptr_position(as.numeric(x))),
    c("peptr_position", "vctrs_vctr")
  )
  expect_true(peptr_is_position(y))
  expect_false(peptr_is_position(x))
  expect_true(is.na(peptr_position(NA)))
  expect_equal(is.na(peptr_position(c(1, 3, NA))), c(FALSE, FALSE, TRUE))
  expect_is(as.integer(y), "integer")
  expect_is(as.numeric(y), "numeric")
})


# Coercion ----

test_that("peptr_position coerces to itself", {
  expect_equal(
    vctrs::vec_ptype_common(peptr_position(), peptr_position()),
    peptr_position()
  )
})

test_that("double coerces to peptr_position", {
  expect_equal(vctrs::vec_ptype_common(peptr_position(), double()), peptr_position())
  expect_equal(vctrs::vec_ptype_common(double(), peptr_position()), double())
})

test_that("integer coerces to peptr_position", {
  expect_equal(vctrs::vec_ptype_common(peptr_position(), integer()), peptr_position())
  expect_equal(vctrs::vec_ptype_common(integer(), peptr_position()), integer())
})


# Casting ----

test_that("casting peptr_position and peptr_position", {
  expect_is(vctrs::vec_cast(peptr_position(), peptr_position()), "peptr_position")
})


test_that("casting integer and peptr_position", {
  expect_is(vctrs::vec_cast(1L, peptr_position()), "peptr_position")
})

test_that("casting peptr_position and integer", {
  expect_is(vctrs::vec_cast(peptr_position(5L), integer()), "integer")
})


test_that("casting double and peptr_position", {
  expect_is(vctrs::vec_cast(1.0, peptr_position()), "peptr_position")
})

test_that("casting peptr_position and double", {
  expect_is(vctrs::vec_cast(peptr_position(5.0), double()), "numeric")
})

test_that("incompatible types do not work", {
  expect_error(vctrs::vec_c(y, "hello"))
  expect_error(vctrs::vec_c(y, TRUE))
  expect_error(vctrs::vec_c(y, factor("hello")))
})


# Print ----

test_that("peptr_position prints", {
  expect_output(print(y))
  expect_output(print(peptr_position(NA)))
  expect_equal(vctrs::vec_ptype_abbr(y), "pos")
})