test_that("quo_get_expr() and quo_get_env() retrieve quosure components", { quo <- quo(foo) expect_identical(quo_get_expr(quo), quote(foo)) expect_identical(quo_get_env(quo), environment()) }) test_that("quo_set_expr() and quo_set_env() set quosure components", { orig <- quo() env <- env() quo <- quo_set_expr(orig, quote(foo)) expect_identical(quo_get_expr(quo), quote(foo)) expect_identical(quo_get_expr(orig), missing_arg()) quo <- quo_set_env(orig, env) expect_identical(quo_get_env(quo), env) expect_identical(quo_get_env(orig), empty_env()) }) test_that("quosure getters and setters check inputs", { expect_error(quo_get_expr(10L), "`quo` must be a quosure") expect_error(quo_set_expr(10L, NULL), "`quo` must be a quosure") expect_error(quo_get_env(10L), "`quo` must be a quosure") expect_error(quo_set_env(10L, env()), "`quo` must be a quosure") expect_error(quo_set_env(quo(), 10L), "`env` must be an environment") }) test_that("generic getters work on quosures", { expect_identical(get_expr(quo(foo)), quote(foo)) expect_identical(get_env(quo(foo)), environment()) }) test_that("generic setters work on quosures", { orig <- quo() env <- env() quo <- set_env(set_expr(orig, quote(foo)), env) expect_identical(quo_get_expr(quo), quote(foo)) expect_identical(quo_get_env(quo), env) }) test_that("can flatten empty quosure", { expect_identical(quo_squash(quo()), missing_arg()) }) test_that("new_quosure() checks inputs", { expect_error(new_quosure(quote(a), env = list()), "must be an environment") }) test_that("new_quosure() produces expected internal structure", { quo <- new_quosure(quote(abc)) expect_identical(structure(~abc, class = c("quosure", "formula")), quo) }) test_that("new_quosure() double wraps", { quo1 <- quo(foo) quo2 <- new_quosure(quo1) expect_identical(quo_get_expr(quo2), quo1) }) test_that("as_quosure() uses correct env", { fn <- function(expr, env = caller_env()) { f <- as_quosure(expr, env) list(env = current_env(), quo = g(f)) } g <- function(expr, env = caller_env()) { as_quosure(expr, env) } quo_env <- child_env(NULL) quo <- new_quosure(quote(expr), quo_env) out_expr_default <- fn(quote(expr)) out_quo_default <- fn(quo) expect_identical(quo_get_env(out_expr_default$quo), current_env()) expect_identical(quo_get_env(out_quo_default$quo), quo_env) user_env <- child_env(NULL) out_expr <- fn(quote(expr), user_env) out_quo <- fn(quo, user_env) expect_identical(quo_get_env(out_expr$quo), user_env) expect_identical(out_quo$quo, quo) }) test_that("explicit promise works only one level deep", { f <- function(x) list(env = current_env(), f = g(x)) g <- function(y) enquo(y) out <- f(1 + 2 + 3) expected_f <- with_env(out$env, quo(x)) expect_identical(out$f, expected_f) }) test_that("can capture optimised constants", { arg <- function() { quo("foobar") } arg_bytecode <- compiler::cmpfun(arg) expect_identical(arg(), quo("foobar")) expect_identical(arg_bytecode(), quo("foobar")) dots <- function() { quos("foo", "bar") } dots_bytecode <- compiler::cmpfun(dots) expect_identical(dots(), quos("foo", "bar")) expect_identical(dots_bytecode(), quos("foo", "bar")) }) test_that("quosures are spliced", { q <- quo(foo(!! quo(bar), !! quo(baz(!! quo(baz), 3)))) expect_identical(quo_text(q), "foo(bar, baz(baz, 3))") q <- expr_interp(~foo::bar(!! function(x) ...)) expect_identical(f_text(q), "foo::bar(function (x) \n...)") q <- quo(!! quo(!! quo(foo(!! quo(!! quo(bar(!! quo(!! quo(!! quo(baz)))))))))) expect_identical(quo_text(q), "foo(bar(baz))") }) test_that("formulas are not spliced", { expect_identical(quo_text(quo(~foo(~bar))), "~foo(~bar)") }) test_that("splicing does not affect original quosure", { f <- ~foo(~bar) quo_text(f) expect_identical(f, ~foo(~bar)) }) test_that("as_quosure() doesn't convert functions", { expect_identical(as_quosure(base::mean), set_env(quo(!! base::mean), empty_env())) }) test_that("as_quosure() coerces formulas", { expect_identical(as_quosure(~foo), quo(foo)) }) test_that("quo_squash() warns", { expect_warning(regexp = NA, quo_squash(quo(foo), warn = TRUE)) expect_warning(quo_squash(quo(list(!! quo(foo))), warn = TRUE), "inner quosure") }) test_that("quo_deparse() indicates quosures with `^`", { x <- quo(list(!! quo(NULL), !! quo(foo()))) ctxt <- new_quo_deparser(crayon = FALSE) expect_identical(quo_deparse(x, ctxt), "^list(^NULL, ^foo())") }) test_that("quosure deparser respects width", { x <- quo(foo(quo(!!quo(bar)))) expect_identical(length(quo_deparse(x, new_quo_deparser(width = 8L))), 3L) expect_identical(length(quo_deparse(x, new_quo_deparser(width = 9L))), 2L) }) test_that("quosure predicates work", { expect_true(quo_is_missing(quo())) expect_true(quo_is_symbol(quo(sym), "sym")) expect_false(quo_is_symbol(quo(sym), "foo")) expect_true(quo_is_call(quo(call()))) expect_true(quo_is_call(quo(ns::call()), "call", 0L, "ns")) expect_false(quo_is_call(quo(ns::call()), "call", 1L, "ns")) expect_true(quo_is_symbolic(quo(sym))) expect_true(quo_is_symbolic(quo(call()))) expect_true(quo_is_null(quo(NULL))) expect_false(quo_is_missing(quo(10L))) expect_false(quo_is_symbol(quo(10L))) expect_false(quo_is_call(quo(10L))) expect_false(quo_is_symbolic(quo(10L))) expect_false(quo_is_symbolic(quo(10L))) expect_false(quo_is_null(quo(10L))) }) test_that("new_quosures() checks that elements are quosures", { expect_error(new_quosures(list(1)), "list of quosures") }) test_that("new_quosures() and as_quosures() return named lists", { exp <- structure(list(), names = chr(), class = c("quosures", "list")) expect_identical(new_quosures(list()), exp) expect_identical(as_quosures(list()), exp) }) test_that("as_quosures() applies default environment", { out <- as_quosures(list(quote(foo), quote(bar)), env = base_env()) exp <- quos_list(new_quosure(quote(foo), base_env()), new_quosure(quote(bar), base_env())) expect_identical(out, exp) }) test_that("as_quosures() auto-names if requested", { x <- list(quote(foo), quote(bar)) expect_named(as_quosures(x, global_env(), named = TRUE), c("foo", "bar")) }) test_that("quosures class has subset assign methods", { local_options(lifecycle_verbosity = "warning") x <- quos(1, 2) x[1:2] <- list(quo(3), quo(4)) expect_identical(x, quos(3, 4)) expect_warning(x[2] <- list(4), "deprecated") ## expect_error(x[2] <- list(4), "Can't assign a double vector to a list of quosures") x[[2]] <- quo(10) expect_identical(x, quos(3, 10)) ## expect_error(x[[2]] <- list(4), "Can't assign a list to a list of quosures") x <- quos(foo = 1, bar = 2) x$bar <- quo(100) expect_identical(x, quos(foo = 1, bar = 100)) ## expect_error(x$foo <- list(4), "Can't assign a list to a list of quosures") }) test_that("can remove quosures by assigning NULL", { x <- quos(1, b = 2) x[[1]] <- NULL expect_identical(x, quos(b = 2)) x$b <- NULL expect_identical(x, quos()) }) test_that("can't cast a quosure to base types (#523)", { expect_deprecated( out <- as.character(quo(foo)), "on a quosure", fixed = TRUE ) expect_identical(out, c("~", "foo")) }) test_that("quosures fail with common operations (#478, tidyverse/dplyr#3476)", { q <- quo(NULL) expect_error(q + 10, "!!myquosure \\+ rhs") expect_error(q > q, "!!myquosure1 > !!myquosure2") expect_error(10 == q, "lhs == !!myquosure") expect_error(abs(q), "abs\\(!!myquosure\\)") expect_error(mean(q), "mean\\(!!myquosure\\)") expect_error(stats::median(q), "median\\(!!myquosure\\)") expect_error(stats::quantile(q), "quantile\\(!!myquosure\\)") expect_error(-q, "-!!myquosure") expect_error(-q, "+!!myquosure") }) test_that("negating quosure fails with informative message", { expect_error(!quo(), "can only be unquoted within a quasiquotation") }) test_that("can cast quosure lists to bare lists", { expect_identical(as.list(quos(a)), named_list(quo(a))) }) test_that("can concatenate quosure lists", { expect_identical(c(quos(a, b), quos(foo = c)), quos(a, b, foo = c)) }) test_that("new_quosure() checks input", { expect_error(new_quosure(NULL, NULL), "`env` must be an environment") }) test_that("as_string(quo) produces informative error message", { expect_error(as_string(quo(foo)), "a object to a string") }) test_that("`[` properly reconstructs quosure lists", { expect_identical(quos(1, 2, 3)[2:3], quos(2, 3)) expect_identical(quos(1, 2, 3)[2:3], new_quosures(list(quo(2), quo(3)))) }) test_that("quosure lists are considered vectors", { skip_if_not_installed("vctrs", "0.2.3") expect_true(vctrs::vec_is(quos())) expect_identical(vctrs::vec_slice(quos(1, 2, 3), 2:3), quos(2, 3)) }) test_that("quosure attributes are cloned (#1142)", { x <- quos() attr(x, "foo") <- TRUE y <- quos() expect_true(setequal(names(attributes(y)), c("names", "class"))) }) test_that("quo_squash() supports nested missing args", { expect_equal( quo_squash(expr(foo(!!quo()))), quote(foo(, ))[1:2] ) expect_equal( quo_squash(expr(foo(bar(!!quo(), !!quo())))), quote(foo(bar(, ))) ) expect_equal(quo_squash(missing_arg()), missing_arg()) expect_equal(quo_squash(quo()), missing_arg()) }) test_that("quo_squash() handles quosures in function positions", { expr <- call2(quo(`==`), 1, 2) expect_equal(quo_squash(expr), quote(1 == 2)) }) test_that("quosures can be concatenated with lists of quosures (#1446)", { expect_equal( c(quo(1), quos(2)), quos(1, 2) ) expect_equal( c(quos(1), quo(2)), quos(1, 2) ) }) test_that("quo_squash() handles nested quosured quosures", { q <- new_quosure(quo(1)) expect_equal(quo_squash(q), 1) expect_equal(quo_squash(quo(foo(!!q))), quote(foo(1))) }) # Lifecycle ---------------------------------------------------------- test_that("as_quosure() still provides default env", { local_lifecycle_warnings() expect_warning(quo <- as_quosure(quote(foo)), "explicit environment") expect_reference(quo_get_env(quo), current_env()) }) test_that("can still concatenate quosure lists and non-quosures", { local_lifecycle_silence() expect_identical(c(quos(foo), list(1)), named_list(quo(foo), 1)) })