test_that("trivial case works", {
expect_equal(
hop(1:2, 1:2, 1:2, ~.x),
list(1L, 2L)
)
})
test_that(".starts and .stops don't have to be ascending", {
expect_equal(hop(1:5, c(2, 1), c(3, 2), identity), list(2:3, 1:2))
})
test_that(".starts must be before .stops", {
expect_snapshot({
(expect_error(hop(1:5, c(2, 3, 1), c(1, 1, 2), identity)))
(expect_error(hop(1:5, c(2, 3, 1), c(1, 1, 2), identity)))
})
})
test_that("empty input returns a list", {
expect_equal(hop(integer(), integer(), integer(), ~.x), list())
})
test_that("empty `.x`, but size `n > 0` `.starts` and `.stops` returns size `n` empty ptype", {
expect_equal(hop(integer(), 1:2, 2:3, ~.x), list(integer(), integer()))
})
test_that("empty `.x`, but size `n > 0` `.starts` and `.stops`: sizes and types are checked first", {
expect_snapshot({
(expect_error(hop(integer(), 1:3, 1:2, ~.x), class = "vctrs_error_incompatible_size"))
(expect_error(hop(integer(), 1, "x", ~.x), class = "vctrs_error_subscript_type"))
})
})
test_that(".starts must not contain NA values", {
expect_snapshot({
(expect_error(hop(1:2, c(1, NA), 1:2, identity), class = "slider_error_endpoints_cannot_be_na"))
(expect_error(hop(1:2, c(NA, 1), 1:2, identity), class = "slider_error_endpoints_cannot_be_na"))
})
})
test_that(".stops must not contain NA values", {
expect_snapshot({
(expect_error(hop(1:2, 1:2, c(1, NA), identity), class = "slider_error_endpoints_cannot_be_na"))
(expect_error(hop(1:2, 1:2, c(NA, 1), identity), class = "slider_error_endpoints_cannot_be_na"))
})
})
test_that("recycling is used for .starts/.stops", {
expect_equal(
hop(1:2, 1, 1:2, ~.x),
list(
1L,
1:2
)
)
expect_equal(
hop(1:2, 1:2, 2, ~.x),
list(
1:2,
2L
)
)
expect_snapshot({
expect_error(hop(1:2, 1:2, 1:3, ~.x), class = "vctrs_error_incompatible_size")
})
})
test_that("0 length .starts/.stops are allowed", {
expect_equal(hop(1, integer(), integer(), ~.x), list())
})
test_that("output size is the common size of .starts/.stops", {
expect_equal(
hop(1:5, 1, 2, ~.x),
list(1:2)
)
expect_equal(
hop(1:2, c(1, 1, 2), c(1, 2, 2), ~.x),
list(1L, 1:2, 2L)
)
})
test_that("out of bounds .starts/.stops result in size-0 slices", {
expect_equal(
hop(1:2, 3, 4, ~.x),
list(integer())
)
expect_equal(
hop(1:2, c(3, 4), c(4, 6), ~.x),
list(integer(), integer())
)
})
test_that("negative / 0 out of bounds .starts/.stops result in size-0 slices", {
expect_equal(
hop(1:2, c(-1, 4), c(0, 6), ~.x),
list(integer(), integer())
)
expect_equal(
hop(1:2, c(-1, 1, 4), c(0, 2, 6), ~.x),
list(integer(), 1:2, integer())
)
})
test_that("duplicated .starts/.stops pairs are allowed", {
expect_equal(
hop(1:4, c(1, 2, 2), c(2, 2, 2), ~.x),
list(
1:2,
2L,
2L
)
)
})
test_that("`.starts` and `.stops` must be integerish", {
expect_snapshot({
(expect_error(hop(1, "x", 1, identity), class = "vctrs_error_subscript_type"))
(expect_error(hop(1, 1, "x", identity), class = "vctrs_error_subscript_type"))
})
})
test_that("`error_call` and `.error_call` args aren't swallowed", {
fn <- function(x, error_call) {
abort("hi", call = error_call)
}
fn_dot <- function(x, .error_call) {
abort("hi", call = .error_call)
}
expect_snapshot(error = TRUE, {
hop(1, 1, 1, fn, error_call = call("foo"))
})
expect_snapshot(error = TRUE, {
hop(1, 1, 1, fn_dot, .error_call = call("foo"))
})
})
# ------------------------------------------------------------------------------
# input names
test_that("names exist on inner sliced elements", {
names <- letters[1:5]
x <- set_names(1:5, names)
exp <- as.list(names)
expect_equal(hop(x, 1:5, 1:5, ~names(.x)), exp)
})
test_that("names are never placed on the output", {
x <- set_names(1:5, letters[1:5])
expect_null(names(hop(x, 1:5, 1:5, ~.x)))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.