fix(filter.epi_archive): avoid other lazy eval traps

Author: brookslogan

R/methods-epi_archive.R

@@ -1063,30 +1063,46 @@ filter.epi_archive <- function(.data, ..., .by = NULL, .format_aware = FALSE) {
               # They are expected to be active bindings, so directly
               # assigning has issues; `rm` first.
               rm(list = forbidden_colnames, envir = e)
-              delayedAssign("version", cli::cli_abort(c(
-                "Using `version` in `filter.epi_archive` may produce unexpected results.",
-                ">" = "See if `epix_as_of` or `epix_slide` would work instead.",
-                ">" = "If not, see `?filter.epi_archive` details for how to proceed."
-              ), class = "epiprocess__filter_archive__used_version"), assign.env = e)
+              eval_env <- new.env(parent = asNamespace("epiprocess")) # see (2) below
+              delayedAssign(
+                "version",
+                cli_abort(c(
+                  "Using `version` in `filter.epi_archive` may produce unexpected results.",
+                  ">" = "See if `epix_as_of` or `epix_slide` would work instead.",
+                  ">" = "If not, see `?filter.epi_archive` details for how to proceed."
+                ), class = "epiprocess__filter_archive__used_version"),
+                eval.env = eval_env,
+                assign.env = e
+              )
               for (measurement_colname in measurement_colnames) {
-                # Record current `measurement_colname` and set up delayed
-                # binding for error in a child environment, so that `for` loop
-                # updating its value and `rm` cleanup don't mess things up:
-                local({
-                  local_measurement_colname <- measurement_colname
-                  delayedAssign(measurement_colname, cli::cli_abort(c(
+                # Record current `measurement_colname` and set up execution for
+                # the promise for the error in its own dedicated environment, so
+                # that (1) `for` loop updating its value and `rm` cleanup don't
+                # mess things up. We can also (2) prevent changes to data mask
+                # ancestry (to involve user's quosure env rather than our
+                # quosure env) or contents (from edge case of user binding
+                # functions inside the mask) from potentially interfering by
+                # setting the promise's execution environment to skip over the
+                # data mask.
+                eval_env <- new.env(parent = asNamespace("epiprocess"))
+                eval_env[["local_measurement_colname"]] <- measurement_colname
+                delayedAssign(
+                  measurement_colname,
+                  cli_abort(c(
                     "Using `{format_varname(local_measurement_colname)}`
                      in `filter.epi_archive` may produce unexpected results.",
                     ">" = "See `?filter.epi_archive` details for how to proceed."
-                  ), class = "epiprocess__filter_archive__used_measurement"), assign.env = e)
-                })
+                  ), class = "epiprocess__filter_archive__used_measurement"),
+                  eval.env = eval_env,
+                  assign.env = e
+                )
               }
               break
             }
             e <- parent.env(e)
           }
-          # Don't mask similarly-named user objects:
-          rm(list = c("e", "measurement_colname"))
+          # Don't mask similarly-named user objects in ancestor envs:
+          rm(list = c("e", "measurement_colname", "eval_env"))
           TRUE
         },
         ...,

tests/testthat/test-methods-epi_archive.R

@@ -222,8 +222,10 @@ test_that("filter.epi_archive works as expected", {
     ea2 %>% filter(time_value >= as.Date("2020-06-02"), cases >= 2L),
     class = "epiprocess__filter_archive__used_measurement"
   )
+  # Check for `for` + `delayedAssign` mishap in `expect_snapshot` (we should say
+  # something about `cases` (the relevant colname), not `deaths` (the last
+  # measurement colname)):
   ea2p <- ea2_data %>%
-    # to check for `for` + `delayedAssign` mishap in expect_snapshot
     mutate(deaths = 0) %>%
     as_epi_archive()
   expect_error(
@@ -234,6 +236,21 @@ test_that("filter.epi_archive works as expected", {
     ea2p %>% filter(cases >= median(cases), .by = geo_value),
     error = TRUE, cnd_class = TRUE
   )
+  # Check that we are insulated from other lazy eval traps:
+  expected <- rlang::catch_cnd(ea2p %>% filter(cases >= median(cases), .by = geo_value))
+  expect_class(expected$parent, "epiprocess__filter_archive__used_measurement")
+  with(list(cli_abort = function(...) stop("now, pretend user didn't have cli attached")), {
+    expect_equal(rlang::catch_cnd(ea2p %>% filter(cases >= median(cases), .by = geo_value))$parent$message,
+                 expected$parent$message)
+  })
+  expect_equal(
+    rlang::catch_cnd(ea2p %>% filter({
+      c <- function(...) stop("and that they overwrote `c` to try to debug their own code")
+      cases >= median(cases)
+    }, .by = geo_value))$parent$message,
+    expected$parent$message
+  )
+
 
   # Escape hatch:
   expect_equal(