test_that("quos() creates quosures", { fs <- quos(x = 1 + 2, y = 2 + 3) expect_identical(fs$x, as_quosure(~ 1 + 2)) expect_identical(fs$y, as_quosure(~ 2 + 3)) }) test_that("quos() captures correct environment", { fn <- function(x = a + b, ...) { list(dots = quos(x = x, y = a + b, ...), env = environment()) } out <- fn(z = a + b) expect_identical(get_env(out$dots$x), out$env) expect_identical(get_env(out$dots$y), out$env) expect_identical(get_env(out$dots$z), current_env()) }) test_that("dots are interpolated", { fn <- function(...) { baz <- "baz" fn_var <- quo(baz) g(..., toupper(!! fn_var)) } g <- function(...) { foo <- "foo" g_var <- quo(foo) h(toupper(!! g_var), ...) } h <- function(...) { quos(...) } bar <- "bar" var <- quo(bar) dots <- fn(toupper(!!var)) expect_identical(map(dots, deparse), named_list("~toupper(~foo)", "~toupper(~bar)", "~toupper(~baz)")) expect_identical(map(dots, eval_tidy), named_list("FOO", "BAR", "BAZ")) }) test_that("dots capture is stack-consistent", { fn <- function(...) { g(quos(...)) } g <- function(dots) { h(dots, foo(bar)) } h <- function(dots, ...) { dots } expect_identical(fn(foo(baz)), quos_list(quo(foo(baz)))) }) test_that("dots can be spliced in", { fn <- function(...) { var <- "var" list( out = g(!!! quos(...), bar(baz), !!! list(a = var, b = ~foo)), env = current_env() ) } g <- function(...) { quos(...) } out <- fn(foo(bar)) expected <- quos_list( quo(foo(bar)), set_env(quo(bar(baz)), out$env), a = quo("var"), b = set_env(quo(!! with_env(out$env, ~foo)), out$env) ) expect_identical(out$out, expected) }) test_that("spliced dots are wrapped in formulas", { args <- alist(x = var, y = foo(bar)) expect_identical(quos(!!! args), quos_list(x = quo(var), y = quo(foo(bar)))) }) test_that("dot names are interpolated", { var <- "baz" expect_identical(quos(!!var := foo, !!toupper(var) := bar), quos_list(baz = quo(foo), BAZ = quo(bar))) expect_identical(quos(!!var := foo, bar), quos_list(baz = quo(foo), quo(bar))) var <- quote(baz) expect_identical(quos(!!var := foo), quos_list(baz = quo(foo))) }) test_that("corner cases are handled when interpolating dot names", { var <- na_chr expect_identical(names(quos(!!var := NULL)), "NA") var <- NULL expect_snapshot({ (expect_error(quos(!!var := NULL))) (expect_error(list2(!!c("a", "b") := NULL))) }) }) test_that("dots are forwarded to named arguments", { outer <- function(...) inner(...) inner <- function(...) fn(...) fn <- function(x) enquo(x) env <- child_env(current_env()) expect_identical(with_env(env, outer(foo(bar))), new_quosure(quote(foo(bar)), env)) }) test_that("pronouns are scoped throughout nested captures", { outer <- function(data, ...) eval_tidy(quos(...)[[1]], data = data) inner <- function(...) map(quos(...), eval_tidy) data <- list(foo = "bar", baz = "baz") baz <- "bazz" expect_identical(outer(data, inner(foo, baz)), set_names(list("bar", "baz"), c("", ""))) }) test_that("Can supply := with LHS even if .named = TRUE", { expect_warning(regexp = NA, expect_identical( quos(!!"nm" := 2, .named = TRUE), quos_list(nm = as_quosure(quote(2), empty_env())) )) }) test_that("Can't supply both `=` and `:=`", { expect_error(regexp = "both `=` and `:=`", quos(foobar = !!"nm" := 2)) expect_error(regexp = "both `=` and `:=`", quos(foobar = !!"nm" := 2, .named = TRUE)) }) test_that("RHS of tidy defs are unquoted", { expect_identical(quos(foo := !!"bar"), quos_list(foo = as_quosure(quote("bar"), empty_env()))) }) test_that("can capture empty list of dots", { fn <- function(...) quos(...) expect_identical(fn(), quos_list()) }) test_that("quosures are spliced before serialisation", { quosures <- quos(!! quo(foo(!! quo(bar))), .named = TRUE) expect_identical(names(quosures), "foo(bar)") }) test_that("missing arguments are captured", { q <- quo() expect_true(is_missing(quo_get_expr(q))) expect_identical(quo_get_env(q), empty_env()) }) test_that("empty quosures are forwarded", { inner <- function(x) enquo(x) outer <- function(x) inner(!! enquo(x)) expect_identical(outer(), quo()) }) test_that("quos() captures missing arguments", { expect_identical(quos(, , .ignore_empty = "none"), quos_list(quo(), quo()), c("", "")) }) test_that("quos() ignores missing arguments", { expect_identical(quos(, , "foo", ), quos_list(quo(), quo(), new_quosure("foo", empty_env()))) expect_identical(quos(, , "foo", , .ignore_empty = "all"), quos_list(new_quosure("foo", empty_env()))) }) test_that("quosured literals are forwarded as is", { expect_identical(quo(!! quo(NULL)), new_quosure(NULL, empty_env())) expect_identical(quos(!! quo(10L)), set_names(quos_list(new_quosure(10L, empty_env())), "")) }) test_that("expr() returns missing argument", { expect_true(is_missing(expr())) }) test_that("expr() supports forwarded arguments", { fn <- function(...) g(...) g <- function(...) expr(...) expect_identical(fn(foo), quote(foo)) }) test_that("can take forced arguments", { fn <- function(allow, x) { force(x) captureArgInfo(x) } expect_identical(fn(TRUE, letters), list(expr = letters, env = empty_env())) if (getRversion() < "3.2.0") { skip("lapply() does not force arguments in R 3.1") } expect_error(lapply(1:2, captureArgInfo), "must be an argument name") args <- list(list(expr = 1L, env = empty_env()), list(expr = 2L, env = empty_env())) expect_identical(lapply(1:2, function(x) captureArgInfo(x)), args) }) test_that("capturing an argument that doesn't exist fails", { fn <- function(x) captureArgInfo(`_foobar`) expect_error(fn(), "object '_foobar' not found") fn <- function() enquo(`_foobar`) expect_error(fn(), "not found") fn <- function() enexpr(`_foobar`) expect_error(fn(), "not found") expect_error((function() rlang::enexpr(`_foobar`))(), "not found") }) test_that("can capture arguments across ancestry", { y <- "foo" fn <- function() captureArgInfo(y) expect_identical(fn(), list(expr = "foo", env = empty_env())) }) test_that("can capture arguments that do exist", { fn <- function() { x <- 10L captureArgInfo(x) } expect_identical(fn(), list(expr = 10L, env = empty_env())) }) test_that("can capture missing argument", { expect_identical(captureArgInfo(), list(expr = missing_arg(), env = empty_env())) }) test_that("serialised unicode in `:=` LHS is unserialised", { skip_if_no_utf8_marker() nms <- with_latin1_locale({ exprs <- exprs("\u5e78" := 10) names(exprs) }) expect_identical(charToRaw(nms), charToRaw("\u5e78")) }) test_that("exprs() supports auto-naming", { expect_identical(exprs(foo(bar), b = baz(), .named = TRUE), list(`foo(bar)` = quote(foo(bar)), b = quote(baz()))) }) test_that("dots_interp() supports unquoting", { expect_identical(exprs(!!(1 + 2)), named_list(3)) expect_identical(exprs(!!(1 + 1) + 2), named_list(quote(2 + 2))) expect_identical(exprs(!!(1 + 1) + 2 + 3), named_list(quote(2 + 2 + 3))) expect_identical(exprs(!!"foo" := bar), named_list(foo = quote(bar))) }) test_that("dots_interp() has no side effect", { f <- function(x) exprs(!! x + 2) expect_identical(f(1), named_list(quote(1 + 2))) expect_identical(f(2), named_list(quote(2 + 2))) }) test_that("exprs() handles forced arguments", { if (getRversion() < "3.2.0") { skip("lapply() does not force arguments in R 3.1") } exprs <- list(named_list(1L), named_list(2L)) expect_identical(lapply(1:2, function(...) exprs(...)), exprs) expect_identical(lapply(1:2, exprs), exprs) }) test_that("quos() handles forced arguments", { if (getRversion() < "3.2.0") { skip("lapply() does not force arguments in R 3.1") } quos <- list(quos_list(quo(1L)), quos_list(quo(2L))) expect_identical(lapply(1:2, function(...) quos(...)), quos) expect_identical(lapply(1:2, quos), quos) }) test_that("enexpr() and enquo() handle forced arguments", { foo <- "foo" expect_identical(enexpr(foo), "foo") expect_identical(enquo(foo), quo("foo")) if (getRversion() < "3.2.0") { skip("lapply() does not force arguments in R 3.1") } expect_identical(lapply(1:2, function(x) enexpr(x)), list(1L, 2L)) expect_identical(lapply(1:2, function(x) enquo(x)), list(quo(1L), quo(2L))) }) test_that("default arguments are properly captured (#201)", { fn <- function(x = x) enexpr(x) expect_identical(fn(), quote(x)) # This is just for consistency. This causes an infinite recursion # when evaluated as Hong noted fn <- function(x = x) list(enquo(x), quo(x)) out <- fn() expect_identical(out[[1]], out[[2]]) }) test_that("names-unquoting can be switched off", { foo <- "foo" bar <- "bar" expect_identical(exprs(foo := bar, .unquote_names = FALSE), named_list(quote(foo := bar))) expect_identical(exprs(!! foo := !! bar, .unquote_names = FALSE), named_list(quote("foo" := "bar"))) expect_identical(quos(foo := bar, .unquote_names = FALSE), quos_list(new_quosure(quote(foo := bar)))) expect_identical(quos(!! foo := !! bar, .unquote_names = FALSE), quos_list(new_quosure(quote("foo" := "bar")))) }) test_that("endots() captures arguments", { # enquos() fn <- function(foo, ..., bar) enquos(foo, bar, ...) expect_identical(fn(arg1, arg2, bar = arg3()), quos(arg1, arg3(), arg2)) # enexprs() fn <- function(foo, ..., bar) enexprs(foo, bar, ...) expect_identical(fn(arg1, arg2, bar = arg3()), exprs(arg1, arg3(), arg2)) }) test_that("endots() requires symbols", { expect_error(enquos(foo(bar)), "must be argument names") expect_error(enquos(1), "must be argument names") expect_error(enquos("foo"), "must be argument names") expect_error(enexprs(foo(bar)), "must be argument names") expect_error(enexprs(1), "must be argument names") expect_error(enexprs("foo"), "must be argument names") }) test_that("endots() returns a named list", { # enquos() fn <- function(foo, bar) enquos(foo, bar) expect_identical(names(fn()), c("", "")) fn <- function(arg, ...) enquos(other = arg, ...) expect_identical(fn(arg = 1, b = 2), quos(other = 1, b = 2)) # enexprs() fn <- function(foo, bar) enexprs(foo, bar) expect_identical(names(fn()), c("", "")) fn <- function(arg, ...) enexprs(other = arg, ...) expect_identical(fn(arg = 1, b = 2), exprs(other = 1, b = 2)) }) test_that("endots() captures missing arguments", { # enquos() fn <- function(foo) enquos(foo)[[1]] expect_identical(fn(), quo()) fn <- function(...) enquos(...) expect_identical(fn(), quos()) # enexprs() fn <- function(foo) enexprs(foo)[[1]] expect_identical(fn(), expr()) fn <- function(...) enexprs(...) expect_identical(fn(), exprs()) }) test_that("endots() supports `.named`", { # enquos() fn <- function(arg, ...) enquos(arg, ..., .named = TRUE) expect_identical(fn(foo, bar), quos(foo = foo, bar = bar)) # enexprs() fn <- function(arg, ...) enexprs(arg, ..., .named = TRUE) expect_identical(fn(foo, bar), exprs(foo = foo, bar = bar)) }) test_that("endots() supports `.unquote_names`", { # enquos() fn <- function(...) enquos(..., .unquote_names = TRUE) expect_identical(fn(!!"foo" := bar), quos(foo = bar)) fn <- function(...) enquos(..., .unquote_names = FALSE) expect_identical(fn(!!"foo" := bar), quos(!!"foo" := bar, .unquote_names = FALSE)) # enexprs() fn <- function(...) enexprs(..., .unquote_names = TRUE) expect_identical(fn(!!"foo" := bar), exprs(foo = bar)) fn <- function(...) enexprs(..., .unquote_names = FALSE) expect_identical(fn(!!"foo" := bar), exprs(!!"foo" := bar, .unquote_names = FALSE)) }) test_that("endots() supports `.ignore_empty`", { # enquos() fn <- function(...) enquos(..., .ignore_empty = "all") expect_identical(fn(, ), quos()) fn <- function(...) enquos(..., .ignore_empty = "trailing") expect_identical(fn(foo, ), quos(foo)) # enexprs() fn <- function(...) enexprs(..., .ignore_empty = "all") expect_identical(fn(, ), exprs()) fn <- function(...) enexprs(..., .ignore_empty = "trailing") expect_identical(fn(foo, ), exprs(foo)) }) test_that("endots() supports `.ignore_null` (#1450)", { # enquos() fn <- function(...) enquos(..., .ignore_null = "all") expect_identical(fn(NULL, NULL), quos()) expect_identical(fn(foo = NULL, NULL), quos(foo = NULL)) expect_identical(fn(!!!list(foo = NULL), NULL), quos(foo = NULL)) fn <- function(foo, ...) enquos(foo, ..., .ignore_null = "all") expect_identical(fn(NULL, NULL), quos()) fn <- function(...) enquos(...) expect_identical(fn(NULL, NULL), quos(NULL, NULL)) # enexprs() fn <- function(...) enexprs(..., .ignore_null = "all") expect_identical(fn(NULL, NULL), exprs()) fn <- function(...) enexprs(...) expect_identical(fn(NULL, NULL), exprs(NULL, NULL)) }) test_that("ensyms() captures multiple symbols", { fn <- function(arg, ...) ensyms(arg, ...) expect_identical(fn(foo, bar, baz), exprs(foo, bar, baz)) expect_snapshot(err(fn(foo()))) }) test_that("enquos() works with lexically scoped dots", { capture <- function(...) { eval_bare(quote(enquos(...)), child_env(env())) } expect_identical(capture("foo"), quos_list(quo("foo"))) }) test_that("enquo() works with lexically scoped arguments", { capture <- function(arg) { eval_bare(quote(enquo(arg)), child_env(env())) } expect_identical(capture(foo), quo(foo)) }) test_that("closures are captured with their calling environment", { expect_reference(quo_get_env(quo(!!function() NULL)), environment()) }) test_that("the missing argument is captured", { expect_equal_( quos(!!missing_arg(), .ignore_empty = "none"), quos(, ), ignore_formula_env = TRUE ) fn <- function(x) { g(!!enquo(x)) } g <- function(...) { quos(...) } expect_equal_( fn(), quos(!!missing_arg()), ignore_formula_env = TRUE ) }) test_that("missing names are forwarded", { x <- set_names(1:2, c(NA, NA)) expect_identical_(names(exprs(!!!x)), chr(na_chr, na_chr)) }) test_that("auto-naming uses type_sum() (#573)", { expect_named(quos(foo, !!(1:3), .named = TRUE), c("foo", "")) x <- list(env(), 1:3, letters) expect_named(exprs_auto_name(x), c("", "", "")) }) test_that("auto-naming supports the .data pronoun", { exprs <- exprs(.data[[toupper("foo")]], .data$bar, .named = TRUE) expect_named(exprs, c("FOO", "bar")) }) test_that("enexprs() and enquos() support `.ignore_empty = 'all'` (#414)", { myexprs <- function(what, x, y) enexprs(x = x, y = y, .ignore_empty = what) expect_identical(myexprs("none"), exprs(x = , y = )) expect_identical(myexprs("trailing"), exprs(x = , y = )) expect_identical(myexprs("all"), exprs()) myquos <- function(what, x, y) enquos(x = x, y = y, .ignore_empty = what) expect_identical(myquos("none"), quos(x = , y = )) expect_identical(myquos("trailing"), quos(x = , y = )) expect_identical(myquos("all"), quos()) }) test_that("`enquos()` does not discard named missing arguments (#1229)", { fn <- function(...) enquos(..., .ignore_empty = "all") expect_equal( fn(x = ), quos(x = ) ) expect_equal( fn(, foo), quos(foo) ) }) test_that("enexprs() and enquos() support empty dots", { myexprs <- function(what, ...) enexprs(..., .ignore_empty = what) expect_identical(myexprs("none"), exprs()) expect_identical(myexprs("trailing"), exprs()) expect_identical(myexprs("all"), exprs()) myquos <- function(what, ...) enquos(..., .ignore_empty = what) expect_identical(myquos("none"), quos()) expect_identical(myquos("trailing"), quos()) expect_identical(myquos("all"), quos()) }) test_that("supplying `!!!` with a name warns", { local_options(lifecycle_verbosity = "warning") expect_no_warning_(quos(!!!1, 2, !!!NULL)) expect_defunct(quos(foo = !!!1, 2, bar = !!!NULL), "Only the operand's names are retained") }) test_that("ensym() unwraps quosures", { fn <- function(arg) ensym(arg) expect_identical(fn(!!quo(foo)), quote(foo)) expect_identical(fn(!!quo("foo")), quote(foo)) expect_snapshot(err(fn(!!quo(foo())))) }) test_that("ensyms() unwraps quosures", { fn <- function(...) ensyms(...) expect_identical(fn(!!!quos(foo, "bar")), exprs(foo, bar)) expect_snapshot(err(fn(!!!quos(foo, bar())))) }) test_that("enquo0() and enquos0() capture arguments without injection", { fn <- function(arg) enquo0(arg) expect_equal( fn(foo(!!1)), quo(foo(!!quote(!!1))) ) fn <- function(...) enquos0(...) expect_equal_( fn(x = foo(!!1), !!!1:3, z = 3), list(x = quo(foo(!!quote(!!1))), quo(!!quote(!!!1:3)), z = quo(3)) ) }) test_that("enquo0() and enquos0() don't rewrap quosures", { fn <- function(arg) enquo0(arg) quo <- local(quo(x)) expect_equal(fn(!!quo), quo) fn <- function(...) enquos0(...) quo <- local(quo(x)) expect_equal(fn(!!quo), list(quo)) }) test_that("enquo() defuses numbered dots (#1137)", { f <- function(arg) enquo(..1) expect_error( f(foo), "'...' used in an incorrect context" ) f <- function(...) enquo(..1) expect_error( f(), "fewer than 1" ) f <- function(...) enquo(..2) expect_error( f(1), "fewer than 2" ) }) test_that("enquos() defuses numbered dots (#1137)", { f <- function(...) enquos(...) g <- function(...) f(..1) expect_equal( g(foo), quos(foo) ) f <- function(...) enquos(...) g <- function(...) f(..1, ..2) h <- function(...) g(..1, ...) expect_equal( h(foo, bar), quos(foo, foo) ) g <- function(...) f(..1, ..3) expect_equal( h(foo, bar), quos(foo, bar) ) g <- function(...) f(..1, ..4) expect_error( h(foo, bar), "fewer than 4 elements" ) }) test_that("`defer()` does not crash with environments containing quosures (#1085)", { f <- function() { withr::defer(2) dots <- quos(integer(1)) quo(c(!!!dots)) } expect_no_error(f()) # No crash }) test_that("auto-named expressions can be unique-repaired", { dots_names <- function(...) { dots <- enquos(...) dots <- exprs_auto_name(dots, repair_auto = "unique") names(dots) } expect_snapshot({ expect_equal( dots_names(1, foo = 1, 1, foo = 2), c("1...1", "foo", "1...3", "foo") ) expect_equal( dots_names(bar, foo = 1, bar, foo = 2), c("bar...1", "foo", "bar...3", "foo") ) }) }) test_that("can capture forced numbered dot", { fn <- function(..., x = ..1) { force(x) enquo(x) } expect_equal(fn(1 + 1), quo(2)) }) test_that("`enexprs()` and variants support `.named = NULL` (#1223)", { fn <- function(...) enexprs(..., .named = NULL) expect_equal(fn(), list()) expect_equal(fn(1), list(1)) expect_equal(fn(x = 1), list(x = 1)) fn <- function(...) enquos(..., .named = NULL) expect_equal(fn(), unname(quos())) expect_equal(fn(1), unname(quos(1))) expect_equal(fn(x = 1), quos(x = 1)) }) test_that("`.named = NULL` yields `NULL` names (#1505)", { fn <- function() enquos(.named = NULL) expect_null(names(fn())) fn <- function(...) enquos(..., .named = NULL) expect_null(names(fn())) expect_null(names(fn(foo))) expect_null(names(quos(.named = NULL))) expect_null(names(quos(foo, .named = NULL))) }) test_that("embraced empty arg are detected consistently (#1421)", { fn_quos <- function(cond, ...) { quos_it({{cond}}, ...) } fn_enquos <- function(cond, ...) { enquos_it({{cond}}, ...) } quos_it <- function(..., .ignore_empty = "all") { quos(..., .ignore_empty = .ignore_empty) } enquos_it <- function(..., .ignore_empty = "all") { enquos(..., .ignore_empty = .ignore_empty) } expect_equal(fn_quos(), quos()) expect_equal(fn_enquos(), quos()) expect_equal(fn_quos(.ignore_empty = "trailing"), quos()) expect_equal(fn_enquos(.ignore_empty = "trailing"), quos()) })