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"))) }) 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")) }) # 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" ) }) test_that("vec_recycle_common errors on scalars", { expect_snapshot(error = TRUE, { vec_recycle_common(1, lm(1 ~ 1)) }) # Index is correct with `NULL`s expect_snapshot(error = TRUE, { vec_recycle_common(1, NULL, lm(1 ~ 1)) }) }) test_that("vec_recycle_common doesn't mutate the input in place", { x <- list(a = 1, b = 2:3) expect_identical( vec_recycle_common(!!!x), list(a = c(1, 1), b = 2:3) ) expect_identical( x, list(a = 1, b = 2:3) ) }) test_that("vec_recycle_common retains names", { expect_named(vec_recycle_common(a = 1, b = 2), c("a", "b")) expect_named(vec_recycle_common(a = 1, b = 2:3), c("a", "b")) }) # 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" ) }) # Data frames ------------------------------------------------------------ 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" ) })