test_that("vec_recycle_common() reports error context", {
my_function <- function(...) vec_recycle_common(...)
expect_snapshot({
(expect_error(my_function(this_arg = 1:2, that_arg = int())))
(expect_error(my_function(this_arg = 1:2, that_arg = int(), .size = 2)))
(expect_error(my_function(this_arg = 1:2, that_arg = int(), .arg = "my_arg")))
(expect_error(my_function(this_arg = 1:2, that_arg = int(), .size = 2, .arg = "my_arg")))
})
})
# vec_recycle() -------------------------------------------------------------
test_that("vec_recycle recycles size 1 to any other size", {
x <- 1
x0 <- numeric()
x2 <- c(x, x)
expect_equal(vec_recycle(x, 1), x)
expect_equal(vec_recycle(x, 0), x0)
expect_equal(vec_recycle(x, 2), x2)
})
test_that("vec_recycle(): incompatible lengths get error messages", {
x2 <- c(1, 2)
expect_snapshot({
(expect_error(vec_recycle(x2, 1), class = "vctrs_error_recycle_incompatible_size"))
})
expect_error(vec_recycle(x2, 0), class = "vctrs_error_recycle_incompatible_size")
expect_error(vec_recycle(x2, 3), class = "vctrs_error_recycle_incompatible_size")
})
test_that("can recycle arrays", {
x <- matrix(1:2, 1)
x2 <- matrix(1:2, 2, 2, byrow = TRUE)
x0 <- matrix(integer(), 0, 2)
expect_equal(vec_recycle(x, 1), x)
expect_equal(vec_recycle(x, 0), x0)
expect_equal(vec_recycle(x, 2), x2)
# List arrays
data <- c(list(1), list(2))
x <- matrix(data, 1)
x2 <- matrix(data, 2, 2, byrow = TRUE)
x0 <- matrix(list(), 0, 2)
expect_equal(vec_recycle(x, 1), x)
expect_equal(vec_recycle(x, 0), x0)
expect_equal(vec_recycle(x, 2), x2)
})
test_that("vec_recycle() evaluates x_arg lazily", {
expect_silent(vec_recycle(1L, 1L, x_arg = print("oof")))
})
# Empty -------------------------------------------------------------------
test_that("empty input returns empty list", {
expect_equal(vec_recycle_common(), list())
})
# Vectors -----------------------------------------------------------------
test_that("NULL is idempotent", {
expect_equal(vec_recycle_common(NULL, NULL), list(NULL, NULL))
expect_equal(vec_recycle_common(1:5, NULL), list(1:5, NULL))
expect_equal(vec_recycle_common(NULL, 1:5), list(NULL, 1:5))
})
test_that("equal lengths returned as is", {
x <- 1:3
expect_equal(vec_recycle_common(x, x), list(x, x))
expect_equal(vec_recycle_common(x[1], x[1]), list(x[1], x[1]))
expect_equal(vec_recycle_common(x[0], x[0]), list(x[0], x[0]))
})
test_that("vec_recycle_common recycles size 1 to any other size", {
x1 <- 1
x3 <- rep(1, 3)
x0 <- numeric()
expect_equal(vec_recycle_common(x1, x3), list(x3, x3))
expect_equal(vec_recycle_common(x3, x1), list(x3, x3))
expect_equal(vec_recycle_common(x1, x0), list(x0, x0))
})
test_that("vec_recycle_common(): incompatible lengths get error messages", {
expect_snapshot({
(expect_error(vec_recycle_common(1:2, 1:3), class = "vctrs_error_incompatible_size"))
})
expect_error(vec_recycle_common(1:3, 1:2), class = "vctrs_error_incompatible_size")
expect_error(vec_recycle_common(numeric(), 1:2), class = "vctrs_error_incompatible_size")
})
# Matrices ----------------------------------------------------------------
test_that("can vec_recycle_common matrices", {
x <- matrix(nrow = 4, ncol = 4)
x1 <- x[1, , drop = FALSE]
expect_equal(vec_recycle_common(x, x), list(x, x))
expect_equal(vec_recycle_common(x1, x), list(x, x))
})
test_that("recycling matrices respects incompatible sizes", {
x <- matrix(nrow = 4, ncol = 4)
x2 <- x[1:2, , drop = FALSE]
x0 <- x[0, , drop = FALSE]
expect_snapshot({
(expect_error(vec_recycle_common(x2, x), class = "vctrs_error_incompatible_size"))
})
expect_error(vec_recycle_common(x0, x), class = "vctrs_error_incompatible_size")
})
test_that("can vec_recycle_common data frames", {
x <- data.frame(a = rep(1, 3), b = rep(2, 3))
x1 <- vec_slice(x, 1L)
expect_equal(vec_recycle_common(x, x), list(x, x))
expect_equal(vec_recycle_common(x1, x), list(x, x))
})
test_that("recycling data frames respects incompatible sizes", {
x <- data.frame(a = rep(1, 3), b = rep(2, 3))
x2 <- vec_slice(x, 1:2)
x0 <- vec_slice(x, integer())
expect_snapshot({
(expect_error(vec_recycle_common(x2, x), class = "vctrs_error_incompatible_size"))
})
expect_error(vec_recycle_common(x0, x), class = "vctrs_error_incompatible_size")
})
test_that("can vec_recycle_common matrix and data frame", {
mt <- matrix(nrow = 2, ncol = 2)
df <- data.frame(x = c(1, 1), y = c(2, 2))
expect_equal(
vec_recycle_common(vec_slice(mt, 1L), df),
list(mt, df)
)
expect_equal(
vec_recycle_common(mt, vec_slice(df, 1L)),
list(mt, df)
)
})
test_that("recycling data frames with matrices respects incompatible sizes", {
mt <- matrix(nrow = 2, ncol = 2)
df <- data.frame(x = c(1, 1), y = c(2, 2))
expect_error(
vec_recycle_common(vec_slice(mt, integer()), df),
class = "vctrs_error_incompatible_size"
)
expect_error(
vec_recycle_common(mt, vec_slice(df, 0L)),
class = "vctrs_error_incompatible_size"
)
})
test_that("recycling to size 1 has informative error", {
expect_snapshot({
(expect_error(vec_recycle(1:2, 1), class = "vctrs_error_recycle_incompatible_size"))
})
})
test_that("incompatible recycling size has informative error", {
expect_snapshot(error = TRUE, vec_recycle(1:2, 4))
expect_snapshot(error = TRUE, vec_recycle(1:2, 4, x_arg = "foo"))
})
Generated by dwww version 1.15 on Wed May 22 22:30:16 CEST 2024.