tests/testthat/test-ptm-class.R

x <- c(1L, 2L, 3L)
y <- peptr_ptm(x, "ptm_test")

test_that("new_ptm works", {
  expect_equal(vctrs::vec_size(new_ptm()), 0)
  expect_s3_class(new_ptm(), c("peptr_ptm", "vctrs_rcrd", "vctrs_vctr"))
  expect_equal(vctrs::vec_size(new_ptm(x)), 3)
})


test_that("peptr_ptm works", {
  expect_equal(vctrs::vec_size(peptr_ptm()), 0)
  expect_equal(class(peptr_ptm()), c("peptr_ptm", "vctrs_rcrd", "vctrs_vctr"))
  expect_equal(
    class(y),
    c("peptr_ptm", "vctrs_rcrd", "vctrs_vctr")
  )
  expect_equal(
    class(peptr_ptm(as.numeric(x))),
    c("peptr_ptm", "vctrs_rcrd", "vctrs_vctr")
  )
  expect_true(peptr_is_ptm(y))
  expect_false(peptr_is_ptm(x))
  expect_true(is.na(peptr_ptm(NA)))
  expect_equal(is.na(peptr_ptm(c(1, 3, NA))), c(FALSE, FALSE, TRUE))
  expect_is(as.integer(y), "integer")
  expect_is(as.numeric(y), "numeric")
  expect_equal(as.integer(y), x)
  expect_equal(vctrs::field(y, "position"), x)
  expect_equal(peptr_get_ptm_name(y), "ptm_test")
  expect_equal(peptr_get_ptm_name(peptr_ptm(x)), NA_character_)
})


# Casting ----

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

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

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


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

test_that("casting peptr_ptm and double", {
  expect_is(vctrs::vec_cast(peptr_ptm(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_ptm prints", {
  expect_output(print(y))
  expect_output(print(peptr_position(NA)))
  expect_equal(vctrs::vec_ptype_abbr(y), "ptm")
  expect_equal(vctrs::vec_ptype_full(y), "ptm<ptm_test>")
})
jeanmanguy/peptr documentation built on Feb. 3, 2020, 12:04 a.m.