/usr/share/doc/r-cran-rlang/tests/testthat/test-dots.R is in r-cran-rlang 0.2.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | context("dots")
test_that("exprs() without arguments creates an empty named list", {
expect_identical(exprs(), named_list())
})
test_that("exprs() captures arguments forwarded with `...`", {
wrapper <- function(...) exprs(...)
expect_identical(wrapper(a = 1, foo = bar), list(a = 1, foo = quote(bar)))
})
test_that("exprs() captures empty arguments", {
expect_identical(exprs(, , .ignore_empty = "none"), set_names(list(missing_arg(), missing_arg()), c("", "")))
})
test_that("dots are always named", {
expect_named(dots_list("foo"), "")
expect_named(dots_splice("foo", list("bar")), c("", ""))
expect_named(exprs(foo, bar), c("", ""))
})
test_that("dots can be spliced", {
spliced_dots <- dots_values(!!! list(letters))
expect_identical(spliced_dots, list(splice(list(letters))))
expect_identical(flatten(dots_values(!!! list(letters))), list(letters))
expect_identical(list2(!!! list(letters)), list(letters))
wrapper <- function(...) list2(...)
expect_identical(wrapper(!!! list(letters)), list(letters))
})
test_that("interpolation by value does not guard formulas", {
expect_identical(dots_values(~1), list(~1))
})
test_that("dots names can be unquoted", {
expect_identical(dots_values(!! paste0("foo", "bar") := 10), list(foobar = 10))
})
test_that("can take forced dots with `allowForced = FALSE`", {
fn <- function(...) {
force(..1)
captureDots()
}
expect_identical(fn(letters), list(list(expr = letters, env = empty_env())))
})
test_that("captured dots are only named if names were supplied", {
fn <- function(...) captureDots()
expect_null(names(fn(1, 2)))
expect_identical(names(fn(a = 1, 2)), c("a", ""))
})
test_that("dots_values() handles forced dots", {
fn <- function(...) {
force(..1)
dots_values(...)
}
expect_identical(fn("foo"), list("foo"))
expect_identical(lapply(1:2, function(...) dots_values(...)), list(list(1L), list(2L)))
expect_identical(lapply(1:2, dots_values), list(list(1L), list(2L)))
})
test_that("empty arguments trigger meaningful error", {
expect_error(list2(1, , 3), "Argument 2 is empty")
expect_error(dots_list(1, , 3), "Argument 2 is empty")
})
test_that("cleans empty arguments", {
expect_identical(dots_list(1, ), named_list(1))
expect_identical(list2(1, ), list(1))
expect_identical(exprs(1, ), named_list(1))
expect_identical(dots_list(, 1, , .ignore_empty = "all"), named_list(1))
})
test_that("doesn't clean named empty argument arguments", {
expect_error(dots_list(1, a = ), "Argument 2 is empty")
expect_identical(exprs(1, a = ), alist(1, a = ))
expect_identical(exprs(1, a = , b = , , .ignore_empty = "all"), alist(1, a = , b = ))
})
test_that("capturing dots by value only unquote-splices at top-level", {
expect_identical_(dots_list(!!! list(quote(!!! a))), named_list(quote(!!! a)))
expect_identical_(dots_list(!!! exprs(!!! 1:3)), named_list(1L, 2L, 3L))
})
test_that("can't unquote when capturing dots by value", {
expect_identical(dots_list(!!! list(!!! TRUE)), named_list(FALSE))
})
test_that("can splice NULL value", {
expect_identical(dots_list(!!! NULL), named_list())
expect_identical(dots_list(1, !!! NULL, 3), named_list(1, 3))
})
test_that("dots_splice() flattens lists", {
expect_identical(dots_splice(list("a", list("b"), "c"), "d", list("e")), named_list("a", list("b"), "c", "d", "e"))
expect_identical(dots_splice(list("a"), !!! list("b"), list("c"), "d"), named_list("a", "b", "c", "d"))
expect_identical(dots_splice(list("a"), splice(list("b")), list("c"), "d"), named_list("a", "b", "c", "d"))
})
test_that("dots_splice() doesn't squash S3 objects", {
s <- structure(list(v1 = 1, v2 = 2), class = "foo")
expect_identical(dots_splice(s, s), named_list(s, s))
})
test_that("dots_node() doesn't trim attributes from arguments", {
x <- ~foo
dots <- eval(expr(dots_node(!! x)))
expect_identical(node_car(dots), x)
})
|