tests/testthat/test-ptm-list-class.R

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

test_that("new_list_of_ptms works", {
  expect_equal(vctrs::vec_size(new_list_of_ptms()), 0)
  expect_s3_class(new_list_of_ptms(), c("peptr_ptm_list", "vctrs_list_of", "vctrs_vctr"))
  expect_equal(vctrs::vec_size(new_list_of_ptms(x)), 1)
  expect_equal(vctrs::vec_size(new_list_of_ptms(list(x, peptr_ptm(c(4L, 5L, 6L), "ptm_test2")))), 2)
})


test_that("peptr_ptm_list works", {
  expect_equal(vctrs::vec_size(peptr_ptm_list()), 0)
  expect_s3_class(peptr_ptm_list(), c("peptr_ptm_list", "vctrs_list_of", "vctrs_vctr"))
  expect_s3_class(y, c("peptr_ptm_list", "vctrs_list_of", "vctrs_vctr"))
  expect_true(peptr_is_ptm_list(y))
  expect_false(peptr_is_ptm_list(list(x)))
  expect_equal(names(y), "ptm_test")
})



# Coercion ----

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


test_that("list coerces to peptr_ptm_list", {
  expect_equal(vctrs::vec_ptype_common(peptr_ptm_list(), list()), peptr_ptm_list())
  expect_equal(vctrs::vec_ptype_common(list(), peptr_ptm_list()), list())
})


# Casting ----

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


test_that("casting integer and peptr_ptm_list", {
  expect_is(vctrs::vec_cast(list(), peptr_ptm_list()), "peptr_ptm_list")
})

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


test_that("peptr_ptm_list and list conversions", {
  expect_is(as.list(y), "list")
  expect_equal(new_list_of_ptms(as.list(y)), y)
})

test_that("incompatible types do not work", {
  expect_error(vctrs::vec_c(y, 5))
  expect_error(vctrs::vec_c(y, "hello"))
  expect_error(vctrs::vec_c(y, TRUE))
  expect_error(vctrs::vec_c(y, factor("hello")))
})
jeanmanguy/peptr documentation built on Feb. 3, 2020, 12:04 a.m.