test_that("input must be a vector", { expect_error(vec_ptype_abbr(sum), "Not a vector") expect_error(vec_ptype_full(sum), "Not a vector") }) test_that("NULL has method", { expect_equal(vec_ptype_abbr(NULL), "NULL") expect_equal(vec_ptype_full(NULL), "NULL") }) test_that("non objects default to type + shape", { expect_equal(vec_ptype_abbr(ones(10)), "dbl[1d]") expect_equal(vec_ptype_abbr(ones(0, 10)), "dbl[,10]") expect_equal(vec_ptype_abbr(ones(10, 0)), "dbl[,0]") expect_equal(vec_ptype_full(ones(10)), "double[1d]") expect_equal(vec_ptype_full(ones(0, 10)), "double[,10]") expect_equal(vec_ptype_full(ones(10, 0)), "double[,0]") }) test_that("non objects can omit shape", { expect_equal(vec_ptype_abbr(ones(10), suffix_shape = FALSE), "dbl") expect_equal(vec_ptype_abbr(ones(0, 10), suffix_shape = FALSE), "dbl") expect_equal(vec_ptype_abbr(ones(10, 0), suffix_shape = FALSE), "dbl") }) test_that("objects default to first class", { x <- structure(1, class = c("foofy", "goofy")) expect_equal(vec_ptype_full(x), "foofy") expect_equal(vec_ptype_abbr(x), "foofy") }) test_that("atomic vectors and arrays as expected", { expect_equal(vec_ptype_full(1:5), "integer") dbl_mat <- array(double(), c(0, 3)) expect_equal(vec_ptype_full(dbl_mat), "double[,3]") }) test_that("complex and factor as expected (#323)", { expect_equal(vec_ptype_abbr(0i), "cpl") expect_equal(vec_ptype_abbr(factor()), "fct") }) test_that("named lists are always tagged (#322)", { expect_identical(vec_ptype_abbr(list(x = 1, y = 2)), "named list") expect_identical(vec_ptype_abbr(list(x = 1, y = 2), prefix_named = TRUE), "named list") }) test_that("named atomics are tagged optionally (#781)", { expect_identical(vec_ptype_abbr(c(x = 1, y = 2), prefix_named = TRUE), "named dbl") expect_identical(vec_ptype_abbr(c(x = 1L, y = 2L), prefix_named = TRUE), "named int") }) test_that("vec_ptype_abbr() adds named tag in case of row names", { expect_equal( vec_ptype_abbr(mtcars, prefix_named = TRUE), "named df[,11]" ) mat <- matrix(1:4, 2) rownames(mat) <- c("foo", "bar") expect_equal( vec_ptype_abbr(mat, prefix_named = TRUE), "named int[,2]" ) }) test_that("vec_ptype_abbr() and vec_ptype_full() are not inherited (#1549)", { foobar <- foobar(class = c("vctrs_bar", "vctrs_foo")) local_methods( vec_ptype_abbr.vctrs_foo = function(...) "foo_abbr", vec_ptype_full.vctrs_foo = function(...) "foo_full" ) expect_equal( vec_ptype_abbr(foobar), vec_ptype_abbr.default(foobar) ) expect_equal( vec_ptype_full(foobar), "vctrs_bar" ) local_methods( vec_ptype_abbr.vctrs_bar = function(...) "bar_abbr", vec_ptype_full.vctrs_bar = function(...) "bar_full" ) expect_equal( vec_ptype_abbr(foobar), "bar_abbr" ) expect_equal( vec_ptype_full(foobar), "bar_full" ) }) test_that("data.frames have good default abbr and full methods", { expect_snapshot({ df <- foobar(data.frame(x = 1, y = "", z = TRUE)) vec_ptype_abbr(df) vec_ptype_full(df) }) })
Generated by dwww version 1.15 on Fri Jun 21 07:59:33 CEST 2024.