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(exprs(foo, bar), c("", "")) local_lifecycle_silence() expect_named(dots_splice("foo", list("bar")), c("", "")) }) test_that("dots can be spliced", { local_lifecycle_silence() spliced_dots <- dots_values(!!!list(letters)) expect_identical(spliced_dots, list(splice(list(letters)))) expect_identical(list2(!!!list(letters)), list(letters)) wrapper <- function(...) list2(...) expect_identical(wrapper(!!!list(letters)), list(letters)) local_lifecycle_silence() expect_identical(flatten(dots_values(!!! 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(a = letters), pairlist(a = 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_snapshot({ (expect_error(list2(1, , 3), "empty")) (expect_error(dots_list(1, , 3), "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 = ), "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", { local_lifecycle_silence() 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", { local_lifecycle_silence() s <- structure(list(v1 = 1, v2 = 2), class = "foo") expect_identical(dots_splice(s, s), named_list(s, s)) }) test_that("dots_split() splits named and unnamed dots", { dots <- dots_split(1, 2) expect_identical(dots$named, list()) expect_identical(dots$unnamed, list(1, 2)) dots <- dots_split(a = 1, 2) expect_identical(dots$named, list(a = 1)) expect_identical(dots$unnamed, list(2)) dots <- dots_split(a = 1, b = 2) expect_identical(dots$named, list(a = 1, b = 2)) expect_identical(dots$unnamed, list()) }) test_that("dots_split() handles empty dots", { dots <- dots_split() expect_identical(dots$named, list()) expect_identical(dots$unnamed, list()) }) test_that("dots_split() fails if .n_unnamed doesn't match", { expect_error(dots_split(1, 2, .n_unnamed = 1), "Expected 1 unnamed") expect_error(dots_split(1, 2, .n_unnamed = 0:1), "Expected 0 or 1 unnamed") dots <- dots_split(a = 1, 2, .n_unnamed = 1) expect_identical(dots$named, list(a = 1)) expect_identical(dots$unnamed, list(2)) }) test_that("can splice NULL and atomic vectors", { expect_identical(list2(!!!letters), as.list(letters)) expect_identical(list2(!!!NULL), list()) }) test_that("can unquote quosures in LHS", { quo <- quo(foo) expect_identical(list2(!!quo := NULL), list(foo = NULL)) expect_identical(exprs(!!quo := bar), exprs(foo = bar)) }) test_that("can preserve empty arguments", { list3 <- function(...) unname(dots_list(..., .preserve_empty = TRUE)) expect_identical(list3(, ), list(missing_arg())) expect_identical(list3(, , .ignore_empty = "none"), list(missing_arg(), missing_arg())) expect_identical(list3(, , .ignore_empty = "all"), list()) }) test_that("forced symbolic objects are not evaluated", { x <- list(quote(`_foo`)) expect_identical_(lapply(x, list2), list(x)) expect_identical_(list2(!!!x), x) x <- unname(exprs(stop("tilt"))) expect_identical_(lapply(x, list2), list(x)) }) test_that("dots collectors do not warn by default with bare `<-` arguments", { expect_no_warning(list2(a <- 1)) expect_no_warning(dots_list(a <- 1)) expect_no_warning(exprs(a <- 1)) expect_no_warning(quos(a <- 1)) myexprs <- function(...) enexprs(...) myquos <- function(...) enexprs(...) expect_no_warning(myexprs(a <- 1)) expect_no_warning(myquos(a <- 1)) }) test_that("dots collectors can elect to warn with bare `<-` arguments", { expect_warning(dots_list(a <- 1, .check_assign = TRUE), "`<-` as argument") myexprs <- function(...) enexprs(..., .check_assign = TRUE) myquos <- function(...) enexprs(..., .check_assign = TRUE) expect_warning(myexprs(TRUE, a <- 1), "`<-` as argument") expect_warning(myquos(TRUE, a <- 1), "`<-` as argument") }) test_that("dots collectors never warn for <- when option is set", { local_options(rlang_dots_disable_assign_warning = TRUE) expect_no_warning(list2(a <- 1)) myexprs <- function(...) enexprs(..., .check_assign = TRUE) myquos <- function(...) enquos(..., .check_assign = TRUE) expect_no_warning(myexprs(a <- 1)) expect_no_warning(myquos(a <- 1)) }) test_that("`.homonyms` is matched exactly", { expect_error(dots_list(.homonyms = "k"), "must be one of") }) test_that("`.homonyms = 'first'` matches first homonym", { list_first <- function(...) { dots_list(..., .homonyms = "first") } out <- list_first(1, 2) expect_identical(out, named_list(1, 2)) out <- list_first(a = 1, b = 2, 3, 4) expect_identical(out, list(a = 1, b = 2, 3, 4)) out <- list_first(a = 1, b = 2, a = 3, a = 4, 5, 6) expect_identical(out, list(a = 1, b = 2, 5, 6)) }) test_that("`.homonyms = 'last'` matches last homonym", { list_last <- function(...) { dots_list(..., .homonyms = "last") } out <- list_last(1, 2) expect_identical(out, named_list(1, 2)) out <- list_last(a = 1, b = 2, 3, 4) expect_identical(out, list(a = 1, b = 2, 3, 4)) out <- list_last(a = 1, b = 2, a = 3, a = 4, 5, 6) expect_identical(out, list(b = 2, a = 4, 5, 6)) }) test_that("`.homonyms` = 'error' fails with homonyms", { list_error <- function(...) { dots_list(..., .homonyms = "error") } expect_identical(list_error(1, 2), named_list(1, 2)) expect_identical(list_error(a = 1, b = 2), list(a = 1, b = 2)) expect_snapshot({ (expect_error(list_error(1, a = 2, a = 3))) (expect_error(list_error(1, a = 2, b = 3, 4, b = 5, b = 6, 7, a = 8))) (expect_error(list_error(1, a = 2, b = 3, 4, b = 5, b = 6, 7, a = 8))) }) }) test_that("`.homonyms` works with spliced arguments", { args <- list(a = 1, b = 2, a = 3, a = 4, 5, 6) expect_identical(dots_list(!!!args, .homonyms = "first"), list(a = 1, b = 2, 5, 6)) myexprs <- function(...) enexprs(..., .homonyms = "last") expect_identical(myexprs(!!!args), list(b = 2, a = 4, 5, 6)) myquos <- function(...) enquos(..., .homonyms = "first") expect_identical(myquos(!!!args), quos_list(a = quo(1), b = quo(2), quo(5), quo(6))) }) test_that("can mix `!!!` and splice boxes", { expect_identical(list2(1L, !!!(2:3), splice(list(4L))), as.list(1:4)) }) test_that("list2() and dots_values() support splice boxes", { expect_identical(list2(1, splice(c("foo", "bar")), 3), list(1, "foo", "bar", 3)) local_lifecycle_silence() expect_identical(dots_values(1, splice(c("foo", "bar")), 3), list(1, splice(list("foo", "bar")), 3)) }) test_that("dots_values() doesn't splice", { local_lifecycle_silence() expect_identical_(dots_values(!!!c(1:3)), list(splice(as.list(1:3)))) expect_identical_(dots_values(!!!list("foo", "bar")), list(splice(list("foo", "bar")))) }) test_that("!!! does not evaluate multiple times (#981)", { foo <- function() x <<- x + 1 x <- 0 list2(!!!list(foo())) expect_identical(x, 1) x <- 0 exprs(!!!list(foo())) expect_identical(x, 1) x <- 0 quos(!!!list(foo())) expect_identical(x, 1) }) test_that("dots_list() optionally auto-names arguments (#957)", { expect_identical( dots_list(.named = TRUE), named(list()) ) expect_identical( dots_list(1, letters, .named = TRUE), list(`1` = 1, letters = letters) ) expect_identical( dots_list(1, foo = letters, .named = TRUE), list(`1` = 1, foo = letters) ) expect_identical( dots_list(!!!list(a = 1:3, 1:3), .named = TRUE), list(a = 1:3, `` = 1:3) ) expect_identical( dots_list(!!!list(1:3, 1:3), .named = TRUE), list(`` = 1:3, `` = 1:3) ) }) test_that("`.ignore_empty` is matched", { # Tests the `r_arg_match()` library function expect_snapshot({ (expect_error(dots_list(.ignore_empty = "t"))) foo <- function() dots_list(.ignore_empty = "t") (expect_error(foo())) }) }) # Suboptimal but not worth fixing the UI test_that("`.named` can be `NULL` (default names) or `FALSE` (minimal names)", { expect_equal( dots_list(.named = FALSE), set_names(list(), "") ) expect_equal( exprs(.named = FALSE), set_names(list(), "") ) expect_equal( dots_list(.named = NULL), list() ) expect_equal( exprs(.named = NULL), list() ) }) test_that("`.homonyms` error is thrown", { f <- function() dots_list(a = 1, a = 2, .homonyms = "error") expect_snapshot((expect_error(f()))) }) test_that("`list2(!!!x)` returns `x` without duplication", { expect_snapshot({ x <- as.list(1:100) with_memory_prof(out <- list2(!!!x)) expect_equal(out, as.list(x)) x <- 1:100 + 0L with_memory_prof(out <- list2(!!!x)) expect_equal(out, as.list(x)) }) }) test_that("list2(...) doesn't copy forced promises (#1491)", { fn <- function(...) { list(...) with_memory_prof(list2(...)) } x <- seq_len(1e4) + 0 expect_snapshot({ fn(x, x, x, x, x, x) }) }) test_that("names are not mutated after splice box early exit", { xs <- list(1) dots_list(!!!xs, .named = FALSE) expect_equal(names(xs), NULL) dots_list(!!!xs, .named = TRUE) expect_equal(names(xs), NULL) dots_list(!!!xs, .named = NULL) expect_equal(names(xs), NULL) })