Merge pull request #501 from yjunechoe/env-scoping-safeguards

Env scoping safeguards

R/utils.R

@@ -259,6 +259,10 @@ resolve_columns <- function(x, var_expr, preconditions = NULL, ...,
     } else {
       # Else (mid-planning): grab columns attempted to subset
       fail <- out$i
+      # If failure is due to scoping a bad object in the env, re-throw error
+      if (!is.character(fail) && !rlang::is_integerish(fail)) {
+        rlang::cnd_signal(out)
+      }
       success <- resolve_columns_possible(tbl, var_expr)
       out <- c(success, fail) %||% NA_character_
     }
@@ -299,9 +303,7 @@ resolve_columns_internal <- function(tbl, var_expr, ..., call) {
   }
   # Special case `vars()`-expression for backwards compatibility
   if (rlang::quo_is_call(var_expr, "vars")) {
-    # Convert to the idiomatic `c()`-expr
-    c_expr <- rlang::call2("c", !!!rlang::call_args(var_expr))
-    var_expr <- rlang::quo_set_expr(var_expr, c_expr)
+    var_expr <- rlang::quo_set_expr(var_expr, vars_to_c(var_expr))
   }
 
   # Proceed with tidyselect
@@ -315,6 +317,16 @@ resolve_columns_internal <- function(tbl, var_expr, ..., call) {
   column
 }
 
+# Convert to the idiomatic `c()`-expr before passing off to tidyselect
+# + ensure that vars() always scopes symbols to data (vars(a) -> c("a"))
+vars_to_c <- function(var_expr) {
+  var_args <- lapply(rlang::call_args(var_expr), function(var_arg) {
+    if (rlang::is_symbol(var_arg)) rlang::as_name(var_arg) else var_arg
+  })
+  c_expr <- rlang::call2("c", !!!var_args)
+  c_expr
+}
+
 resolve_label <- function(label, columns = "", segments = "") {
   n_columns <- length(columns)
   n_segments <- length(segments)

tests/testthat/test-tidyselect_fails_safely.R

@@ -1,4 +1,5 @@
 agent <- create_agent(small_table)
+z <- rlang::missing_arg()
 nonexistent_col <- "z"
 
 test_that("tidyselect errors signaled at report, not during development of validation plan", {
@@ -121,11 +122,23 @@ test_that("tidyselect errors cannot be downgraded in assertion/expectation on ta
 
 })
 
-# test_that("Other things that may need to get ironed out", {
-#   # Empty `vars()` in rows_* functions resolve to `list(NA)` instead of `NA`
-#   agent %>% rows_distinct(vars())
-#   agent %>% rows_complete(vars())
-#   # Attempting to select using a non-existent variable silently fails
-#   agent %>% col_vals_not_null(all_of(nonexistent_var)) %>% interrogate()
-#   # Current heuristic for re-throwing the error relies on whether agent is "::QUIET::" ...
-# })
+test_that("env scoping with bare symbol patterns", {
+
+  # `z` is external vector of valid column
+  z <- "a"
+  rlang::local_options(lifecycle_verbosity = "warning")
+  expect_warning({small_table %>% col_vals_not_null(z)}, "deprecated")
+
+  # `z` is not character
+  z <- mtcars
+  rlang::local_options(lifecycle_verbosity = "quiet")
+  # c() and vars() both error, but different reasons
+  ## c() scopes z in env and determines its invalid
+  expect_error({small_table %>% col_vals_not_null(c(z))}, "`z` must be numeric or character")
+  ## vars() doesn't attempt to scope z in env at all
+  expect_error({small_table %>% col_vals_not_null(vars(z))}, "Column `z` doesn't exist")
+
+  # Cleanup
+  z <- rlang::missing_arg()
+
+})

tests/testthat/test-tidyselect_fails_safely_batch.R

@@ -1,4 +1,5 @@
 agent <- create_agent(tbl = small_table[, c("a", "b", "c")])
+z <- rlang::missing_arg()
 mixed_cols <- c("a", "z")
 
 # Column selection expressions to test