test_that("accepts expressions", { expect_identical(eval_tidy(10), 10) expect_identical(eval_tidy(quote(letters)), letters) }) test_that("eval_tidy uses quosure environment", { x <- 10 quo <- local({ y <- 100 quo(x + y) }) expect_equal(eval_tidy(quo), 110) }) test_that("data must be uniquely named", { expect_error(eval_tidy(NULL, list(x = 1, x = 2)), "has duplicate columns") data <- set_names(data.frame(x = 1, x = 2, y = 3, y = 4), c("x", "x", "y", "y")) expect_error(eval_tidy(NULL, data), "has duplicate columns") }) test_that("can supply unnamed empty data", { expect_identical(eval_tidy("foo", list()), "foo") expect_identical(eval_tidy("foo", data.frame()), "foo") }) test_that("looks first in `data`", { x <- 10 data <- list(x = 100) expect_equal(eval_tidy(quo(x), data), 100) }) test_that("pronouns resolve ambiguity looks first in `data`", { x <- 10 data <- list(x = 100) expect_equal(eval_tidy(quo(.data$x), data), 100) expect_equal(eval_tidy(quo(.env$x), data), 10) }) test_that("pronouns complain about missing values", { expect_data_pronoun_error(eval_tidy(quo(.data$x), list()), "Column `x` not found in `.data`") expect_data_pronoun_error(eval_tidy(quo(.data$x), data.frame()), "Column `x` not found in `.data`") }) test_that("nested quosures look in their own env", { n <- 10 f <- function() { n <- 100 quo(n) } quo <- quo(!!f()) expect_equal(eval_tidy(quo), 100) }) test_that("nested quosure thunks rechain properly in the non-data mask", { bar <- "foo" quo <- quo(identity(!!quo(toupper(!!quo(identity(bar)))))) expect_identical(eval_tidy(quo), "FOO") }) test_that("unquoted formulas can use data", { f1 <- function() { z <- 100 x <- 2 quo(x + z) } f2 <- function() { z <- 100 quo(.data$x + .env$z) } z <- 10 expect_identical(eval_tidy(f2(), list(x = 1)), 101) expect_identical(eval_tidy(quo(!! f1()), data = list(x = 1)), 101) expect_identical(eval_tidy(quo(!! f2()), data = list(x = 1)), 101) }) test_that("bare formulas are not evaluated", { f <- local(~x) expect_identical(eval_tidy(quo(!! f)), f) f <- a ~ b expect_identical(eval_tidy(quo(!! f)), f) }) test_that("quosures are not evaluated if not forced", { fn <- function(arg, force) { if (force) arg else "bar" } f1 <- quo(fn(!! quo(stop("forced!")), force = FALSE)) f2 <- quo(fn(!! local(quo(stop("forced!"))), force = FALSE)) expect_identical(eval_tidy(f1), "bar") expect_identical(eval_tidy(f2), "bar") f_forced1 <- quo(fn(!! quo(stop("forced!")), force = TRUE)) f_forced2 <- quo(fn(!! local(quo(stop("forced!"))), force = TRUE)) expect_error(eval_tidy(f_forced1), "forced!") expect_error(eval_tidy(f_forced2), "forced!") }) test_that("can unquote captured arguments", { var <- quo(cyl) fn <- function(arg) eval_tidy(enquo(arg), mtcars) expect_identical(fn(var), quo(cyl)) expect_identical(fn(!!var), mtcars$cyl) }) test_that("quosures are evaluated recursively", { foo <- "bar" expect_identical(eval_tidy(quo(foo)), "bar") expect_identical(eval_tidy(quo(!!quo(!! quo(foo)))), "bar") }) test_that("quosures have lazy semantics", { fn <- function(arg) "unforced" expect_identical(eval_tidy(quo(fn(~stop()))), "unforced") }) test_that("can unquote hygienically within captured arg", { fn <- function(df, arg) eval_tidy(enquo(arg), df) foo <- "bar"; var <- quo(foo) expect_identical(fn(mtcars, list(var, !!var)), list(quo(foo), "bar")) var <- quo(cyl) expect_identical(fn(mtcars, (!!var) > 4), mtcars$cyl > 4) expect_identical(fn(mtcars, list(var, !!var)), list(quo(cyl), mtcars$cyl)) expect_equal( fn(mtcars, list(~var, !!var)), list(~var, mtcars$cyl), ignore_formula_env = TRUE ) expect_equal( fn(mtcars, list(~~var, !!quo(var), !!quo(quo(var)))), list(~~var, quo(cyl), quo(var)), ignore_formula_env = TRUE ) }) test_that("can unquote for old-style NSE functions", { var <- quo(foo) fn <- function(x) substitute(x) expect_identical(quo(fn(!!quo_get_expr(var))), quo(fn(foo))) expect_identical(eval_tidy(quo(fn(!!quo_get_expr(var)))), quote(foo)) }) test_that("all quosures in the call are evaluated", { foobar <- function(x) paste0("foo", x) x <- new_quosure(call("foobar", local({ bar <- "bar"; quo(bar) }))) f <- new_quosure(call("identity", x)) expect_identical(eval_tidy(f), "foobar") }) test_that("two-sided formulas are not treated as quosures", { expect_identical(eval_tidy(new_quosure(a ~ b)), a ~ b) }) test_that("formulas are evaluated in evaluation environment", { f <- eval_tidy(quo(foo ~ bar), list(foo = "bar")) expect_false(identical(f_env(f), current_env())) }) test_that("evaluation env is cleaned up", { f <- local(quo(function() list(f = ~letters, env = environment()))) fn <- eval_tidy(f) out <- fn() expect_identical(out$f, with_env(env = out$env, ~letters)) }) test_that("inner formulas are rechained to evaluation env", { env <- child_env(NULL) f1 <- quo(env$eval_env1 <- current_env()) f2 <- quo({ !! f1 env$eval_env2 <- current_env() }) eval_tidy(f2, mtcars) expect_identical(env$eval_env1, env$eval_env2) expect_true(env_inherits(env$eval_env2, get_env(f2))) }) test_that("empty quosure self-evaluates", { quo <- quo(is_missing(!! quo())) expect_true(eval_tidy(quo)) }) test_that("cannot replace elements of pronouns", { expect_error(eval_tidy(quo(.data$foo <- "bar"), mtcars), "Can't modify the data pronoun") }) test_that("formulas are not evaluated as quosures", { expect_identical(eval_tidy(~letters), ~letters) }) test_that("tilde calls are evaluated in overscope", { quo <- quo({ foo <- "foo" ~foo }) f <- eval_tidy(quo) expect_true(env_has(f_env(f), "foo")) }) test_that(".env pronoun refers to current quosure (#174)", { inner_quo <- local({ var <- "inner" quo(.env$var) }) outer_quo <- local({ var <- "outer" quo(identity(!! inner_quo)) }) expect_identical(eval_tidy(outer_quo, list()), "inner") }) test_that("can call tilde with named arguments (#226)", { expect_equal( eval_tidy(quote(`~`(foo = x, bar = y))), `~`(foo = x, bar = y), ignore_formula_env = TRUE ) expect_equal( eval_tidy(quote(`~`(foo = x, bar = y, baz = z))), `~`(foo = x, bar = y, baz = z), ignore_formula_env = TRUE ) }) test_that("Arguments to formulas are not stripped from their attributes (#227)", { quo <- quo(x) f <- eval_tidy(quo(~!!quo)) expect_identical(f_rhs(f), quo) f <- eval_tidy(quo(!!quo(x) ~ a)) expect_identical(f_lhs(f), quo) }) test_that("evaluating an empty quosure fails", { expect_error(eval_tidy(quo()), "not found") }) test_that("can supply a data mask as data", { mask <- as_data_mask(list(x = 1L)) eval_tidy(quo(x <- 2L), mask) expect_identical(eval_tidy(quo(x), mask), 2L) }) test_that("as_data_pronoun() creates pronoun", { data <- as_data_pronoun(mtcars) expect_s3_class(data, "rlang_data_pronoun") data_env <- .subset2(data, 1) expect_reference(env_parent(data_env), empty_env()) expect_true(all(env_names(data_env) %in% names(mtcars))) expect_data_pronoun_error(data$foobar, "Column `foobar` not found in `.data`") expect_identical(data[["cyl"]], mtcars$cyl) }) test_that("can create pronoun from a mask", { top <- env(a = 1) bottom <- env(top, b = 2) mask <- new_data_mask(bottom, top) .data <- as_data_pronoun(mask) expect_s3_class(.data, "rlang_data_pronoun") expect_identical(.data$a, 1) expect_identical(.data$b, 2) }) test_that("pronoun has print() and str() method", { data <- as_data_pronoun(mtcars) expect_output(print(data), "") expect_output(str(data), "") data <- as_data_pronoun(list(a = 1)) expect_output(print(data), "") }) test_that("data mask can escape", { fn <- eval_tidy(quote(function() cyl), mtcars) expect_identical(fn(), mtcars$cyl) }) test_that("inner formulas are evaluated in the current frame", { quo <- quo(local(list(f_env = f_env(~foo), env = current_env()))) envs <- eval_tidy(quo) expect_identical(envs$f_env, envs$env) quo <- quo(as_function(~list(f_env = get_env(~foo), env = current_env()))()) envs <- eval_tidy(quo) expect_identical(envs$f_env, envs$env) }) test_that("names are translated to native when creating data mask", { with_latin1_locale({ str_utf8 <- "\u00fc" str_native <- enc2native(str_utf8) d <- set_names(list("value"), str_utf8) s <- sym(str_native) expect_identical(eval_tidy(s, data = d), "value") foreign_utf8 <- "\u5FCD" foreign_native <- enc2native(foreign_utf8) d <- setNames(list("value"), foreign_utf8) s <- sym(foreign_native) expect_identical(eval_tidy(s, data = d), "value") }) }) test_that("new_data_mask() checks `top` is a parent of `bottom`", { top <- env() bottom <- env(top) expect_no_error(new_data_mask(bottom, top)) expect_error(new_data_mask(top, bottom), "`top` is not a parent of `bottom`") }) test_that("data mask inherits from last environment", { mask <- new_data_mask(NULL, NULL) expect_reference(env_parent(mask), empty_env()) eval_tidy(NULL, mask) expect_reference(env_parent(mask), current_env()) env <- env() quo <- new_quosure(NULL, env) eval_tidy(quo, mask) expect_reference(env_parent(mask), env) }) test_that("is_data_pronoun() detects pronouns", { expect_true(!!is_data_pronoun(quote(.data$foo))) expect_true(!!is_data_pronoun(quote(.data[[foo]]))) expect_false(!!is_data_pronoun(quote(.data[foo]))) expect_false(!!is_data_pronoun(quote(data[[foo]]))) }) test_that("data_pronoun_name() extracts name", { expr <- quote(.data[[foo]]) expect_null(data_pronoun_name(expr)) expr <- quote(.data[[toupper("foo")]]) expect_null(data_pronoun_name(expr)) expr <- quote(`$`(.data, toupper("foo"))) expect_null(data_pronoun_name(expr)) expect_identical(data_pronoun_name(quote(.data[["foo"]])), "foo") expect_identical(data_pronoun_name(quote(.data$foo)), "foo") }) test_that(".data pronoun walks the ancestry of environments", { e <- 0 e1 <- env(a = 1, b = 1, c = 1) e2 <- env(a = 2, b = 2, e1) e3 <- env(a = 3, e2) data_mask <- new_data_mask(e3, e1) .data <- as_data_pronoun(data_mask) expect_equal(.data$a, 3) expect_equal(.data$b, 2) expect_equal(.data$c, 1) expect_data_pronoun_error(.data$d, "Column `d` not found in `.data`") expect_data_pronoun_error(.data$e, "Column `e` not found in `.data`") expect_data_pronoun_error(.data$.data, "Column `.data` not found in `.data`") expect_data_pronoun_error(.data$.env, "Column `.env` not found in `.data`") expect_data_pronoun_error(.data$.top_env, "Column `.top_env` not found in `.data`") expect_equal(.data[["a"]], 3) expect_equal(.data[["b"]], 2) expect_equal(.data[["c"]], 1) expect_data_pronoun_error(.data[["d"]], "Column `d` not found in `.data`") expect_data_pronoun_error(.data[["e"]], "Column `e` not found in `.data`") expect_data_pronoun_error(.data[[".data"]], "Column `.data` not found in `.data`") expect_data_pronoun_error(.data[[".env"]], "Column `.env` not found in `.data`") expect_data_pronoun_error(.data[[".top_env"]], "Column `.top_env` not found in `.data`") expect_error(.data["a"]) }) test_that("can inspect the exported pronoun", { expect_output(print(rlang::.data), "") }) test_that("data pronoun doesn't skip functions (#1061, #5608)", { top <- env(c = "c") bottom <- env(top, c = base::c) mask <- new_data_mask(bottom, top) .data <- as_data_pronoun(mask) expect_identical(.data$c, base::c) }) test_that("leaked quosure masks are not mistaken with data masks", { local_lifecycle_silence() e <- eval_tidy(quote(current_env())) expect_no_error(eval_tidy("foo", e)) }) test_that("quosures look for data masks lexically", { out <- eval_tidy(data = mtcars, expr({ fn <- as_function(~ !!quo(cyl)) list( fn(), local(!!quo(disp)) ) })) expect_identical(out, list(mtcars$cyl, mtcars$disp)) }) test_that("can evaluate quosures created in the data mask without infloop", { quo <- eval_tidy(quote(quo(a)), list(a = "foo")) expect_identical(eval_bare(quo, quo_get_env(quo)), "foo") }) test_that("`.env` pronoun is constructed", { pronoun <- eval_tidy(quote(.env), mtcars) expect_s3_class(pronoun, "rlang_ctxt_pronoun") expect_reference(env_parent(pronoun), current_env()) }) test_that("the `.env` pronoun is not an environment", { pronoun <- eval_tidy(quote(.env), mtcars) expect_length(pronoun, 0L) expect_named(pronoun, chr()) }) test_that("subsetting `.env` evaluates", { expect_error(eval_tidy(quote(.env[["cyl"]]), mtcars, env()), "not found") cyl <- "foo" expect_identical(eval_tidy(quote(.env$cyl), mtcars, env()), "foo") expect_identical(eval_tidy(quote(.env[["cyl"]]), mtcars, env()), "foo") }) test_that("mask inherits from `env` after evaluation", { flag <- env(empty_env()) mask <- new_data_mask(env()) eval_tidy(NULL, mask, flag) expect_true(env_inherits(mask, flag)) }) test_that("can't take the names() and length() of the `.data` pronoun", { pronoun <- as_data_pronoun(mtcars) expect_length(pronoun, 0L) expect_named(pronoun, chr()) }) test_that("eval_tidy() does not infloop when the quosure inherits from the mask", { # New r-devel error: cycles in parent chains are not allowed skip_if(getRversion() >= "4.4.0" && grepl("devel", R.version$status)) mask <- as_data_mask(list(foo = 1)) quo <- new_quosure(quote(foo), mask) expect_identical(eval_tidy(quo, mask), 1) top <- env(foo = 1) bottom <- env(top) mask <- new_data_mask(bottom, top) quo <- new_quosure(quote(foo), top) expect_identical(eval_tidy(quo, mask), 1) }) test_that(".data pronoun handles promises (#908)", { e <- env() env_bind_lazy(e, a = c(1)) mask <- new_data_mask(e) mask$.data <- as_data_pronoun(mask) expect_equal(eval_tidy(expr(.data$a * 2), mask), 2) }) test_that("can evaluate tilde in nested masks", { tilde <- eval_tidy(quo(eval_tidy(~1))) expect_identical( eval_bare(tilde, f_env(tilde)), tilde ) }) test_that("eval_tidy() propagates visibility", { expect_visible(eval_tidy(quo(list(invisible(list()))))) expect_invisible(eval_tidy(quo(invisible(list())))) expect_invisible(eval_tidy(quo(identity(!!local(quo(invisible(list()))))))) }) test_that("quosures that inherit from the mask are not rechained", { local_data <- "bar" mask <- new_data_mask(env(mask_data = "foo")) q1 <- eval_tidy(quote(rlang::quo(letters)), mask, base_env()) expr <- quote(paste(letters[[1]], mask_data, local_data)) q2 <- eval_tidy(quote(local(rlang::quo(!!expr))), mask) expect_equal(eval_tidy(q1, mask, base_env()), letters) # This used to hang (tidyverse/dplyr#5927) expect_equal(eval_tidy(q2, mask, base_env()), "a foo bar") }) test_that("eval_tidy() has dimnames method (#1265)", { expect_equal( eval_tidy(quote(dimnames(.data)), mtcars), list(chr(), chr()) ) }) test_that("fake pronoun fails informatively", { expect_snapshot({ "Fake pronouns" f <- function() .data$foo (expect_error(f(), "subset")) f <- function() .data[["foo"]] (expect_error(f(), "subset")) }) }) test_that("`.data` pronoun fails informatively", { f <- function(data = NULL) g(data) g <- function(data) h(.data$foo, data = data) h <- function(x, data) i({{ x }}, data) i <- function(x, data) eval_tidy(enquo(x), data) expect_snapshot({ (expect_error(f())) (expect_error(f(mtcars))) g <- function(data) h(.data[[2]], data) (expect_error(f(mtcars))) g <- function(data) h(.data["foo"], data = data) (expect_error(f(mtcars))) g <- function(data) h(.data[["foo"]] <- 1, data = data) (expect_error(f(mtcars))) g <- function(data) h(.data$foo <- 1, data = data) (expect_error(f(mtcars))) g <- function(data) h(.env["foo"], data = data) (expect_error(f(mtcars))) g <- function(data) h(.env$foo <- 1, data = data) (expect_error(f(mtcars))) g <- function(data) h(.env[["foo"]] <- 1, data = data) (expect_error(f(mtcars))) }) }) # Lifecycle ---------------------------------------------------------- test_that("supplying environment as data is deprecated", { local_options(lifecycle_verbosity = "warning") `_x` <- "foo" expect_deprecated(eval_tidy("foo", current_env()), "deprecated") local_options(lifecycle_verbosity = "quiet") expect_identical(eval_tidy(quo(`_x`), current_env()), "foo") expect_error(eval_tidy(quo(`_y`), current_env()), "not found") })