tests/testthat/test-proxy.R

In vctrs: Vector Helpers

test_that("vec_data() preserves names (#245)", {
  x <- set_names(letters, LETTERS)
  expect_identical(vec_names(x), vec_names(vec_data(x)))

  x <- diag(2)
  rownames(x) <- letters[1:2]
  colnames(x) <- LETTERS[1:2]
  expect_identical(vec_names(x), vec_names(vec_data(x)))
})

test_that("vec_data() preserves size (#245)", {
  x <- set_names(letters, LETTERS)
  expect_identical(vec_size(x), vec_size(vec_data(x)))

  x <- diag(2)
  expect_identical(vec_size(x), vec_size(vec_data(x)))
})

test_that("vec_data() preserves dim and dimnames (#245)", {
  x <- set_names(letters, LETTERS)
  expect_identical(vec_dim(x), vec_dim(vec_data(x)))

  x <- diag(2)
  expect_identical(vec_dim(x), vec_dim(vec_data(x)))

  x <- diag(2)
  rownames(x) <- letters[1:2]
  colnames(x) <- LETTERS[1:2]
  expect_identical(dimnames(x), dimnames(vec_data(x)))
})

test_that("strips vector attributes apart from names, dim and dimnames", {
  x <- new_vctr(1:10, a = 1, b = 2)
  expect_null(attributes(vec_data(x)))

  x <- new_vctr(c(x = 1, y = 2), a = 1, b = 2)
  expect_equal(names(attributes(vec_data(x))), "names")

  x <- new_vctr(1, a = 1, dim = c(1L, 1L))
  expect_equal(names(attributes(vec_data(x))), "dim")

  x <- new_vctr(1, a = 1, dim = c(1L, 1L), dimnames = list("foo", "bar"))
  expect_equal(names(attributes(vec_data(x))), c("dim", "dimnames"))
})

test_that("vec_proxy() is a no-op with data vectors", {
  for (x in vectors) {
    expect_identical(vec_proxy(!!x), !!x)
  }

  x <- structure(1:3, foo = "bar")
  expect_identical(vec_proxy(!!x), !!x)
})

test_that("vec_proxy() transforms records to data frames", {
  for (x in records) {
    expect_identical(vec_proxy(x), new_data_frame(unclass(x)))
  }
})

test_that("vec_proxy() is a no-op with non vectors", {
  x <- foobar(list())
  expect_identical(vec_proxy(x), x)
})

test_that("can take the proxy of non-vector objects", {
  local_env_proxy()
  expect_identical(vec_proxy(new_proxy(1:3)), 1:3)
})

test_that("vec_data() asserts vectorness", {
  expect_error(vec_data(new_sclr()), class = "vctrs_error_scalar_type")
  expect_error(vec_data(~foo), class = "vctrs_error_scalar_type")
})

test_that("vec_data() is proxied", {
  local_env_proxy()
  x <- new_proxy(mtcars)
  expect_identical(vec_data(x), vec_data(mtcars))
})

test_that("vec_proxy_equal() is recursive over data frames (#641)", {
  x <- new_data_frame(list(x = foobar(1:3), y = 41:43))
  default <- vec_proxy_equal(x)
  expect_s3_class(default$x, "vctrs_foobar")

  local_methods(vec_proxy_equal.vctrs_foobar = function(...) c(0, 0, 0))
  overridden <- vec_proxy_equal(x)
  expect_identical(overridden$x, c(0, 0, 0))
})

test_that("vec_proxy_equal() returns a POSIXct for POSIXlt objects (#901)", {
  x <- as.POSIXlt(new_date(0), tz = "UTC")
  expect_s3_class(vec_proxy_equal(x), "POSIXct")
})

test_that("vec_proxy_equal() defaults to vec_proxy() and vec_proxy_compare() defaults to vec_proxy_equal() (#1140)", {
  foobar_proxy <- function(x, ...) data_frame(x = unclass(x), y = seq_along(x))

  local_methods(vec_proxy.vctrs_foobar = foobar_proxy)

  x <- foobar(3:1)
  expect_identical(vec_proxy(x), foobar_proxy(x))
  expect_identical(vec_proxy_equal(x), foobar_proxy(x))
  expect_identical(vec_proxy_compare(x), foobar_proxy(x))

  local_methods(vec_proxy_equal.vctrs_foobar = function(x, ...) foobar_proxy(letters[x]))

  expect_identical(vec_proxy_equal(x), data_frame(x = letters[3:1], y = 1:3))
  expect_identical(vec_proxy_compare(x), data_frame(x = letters[3:1], y = 1:3))
})

test_that("equal/compare/order proxy methods that return data frames are automatically flattened", {
  x <- new_vctr(1:2, class = "custom")

  equal <- data_frame(a = 1:2, b = 3:4)
  order <- data_frame(a = 3:4, b = 4:5)

  local_methods(
    vec_proxy_equal.custom = function(x, ...) data_frame(col = equal),
    vec_proxy_order.custom = function(x, ...) data_frame(col = order)
  )

  expect_identical(vec_proxy_equal(x), equal)
  expect_identical(vec_proxy_compare(x), equal)
  expect_identical(vec_proxy_order(x), order)
})

test_that("equal/compare/order proxy methods that return 1 column data frames are automatically unwrapped", {
  x <- new_vctr(1:2, class = "custom")

  equal <- 1:2
  order <- 3:4

  local_methods(
    vec_proxy_equal.custom = function(x, ...) data_frame(a = equal),
    vec_proxy_order.custom = function(x, ...) data_frame(col = data_frame(a = order))
  )

  expect_identical(vec_proxy_equal(x), equal)
  expect_identical(vec_proxy_compare(x), equal)
  expect_identical(vec_proxy_order(x), order)
})

test_that("vec_data() preserves data frames", {
  expect_identical(
    vec_data(tibble(x = 1)),
    data_frame(x = 1)
  )

  # Rownames are preserved
  expect_identical(
    vec_data(mtcars),
    mtcars
  )
})