From 61b007a808a7b164a10df026e68c018585d17a51 Mon Sep 17 00:00:00 2001 From: Dawie Griesel Date: Mon, 26 Oct 2026 23:42:14 +0200 Subject: [PATCH] Ship box module functions to the worker and keep NULL function bodies A box module's environment is not an R namespace, so functions defined in a module, or attached by a top-level box::use(), were neither shipped nor reported missing and failed with "could not find function" on the worker. They are now shipped as the global environment's are (#29). S4 generics, such as DBI::dbConnect() imported through box, are shipped as they are so they keep the method tables dispatch needs. With srcrefs, `function(e) NULL` lost its body when capture rewrote it, since assigning NULL into a call deletes the element; only call bodies are now rewritten (#30). --- NEWS.md | 16 ++++++ R/capture.R | 21 ++++++-- tests/testthat/test-capture.R | 92 +++++++++++++++++++++++++++++++++++ 3 files changed, 126 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 9050ec5..ea7352a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,21 @@ # shinyasync (development version) +## Bug fixes + +* Functions defined in a box module are shipped to the worker. A box + module's own environment is not an R namespace, so a helper defined at the + top of a view module, or one an imported box function calls from its own + module, was found in the session but neither shipped nor reported as + missing, and the task failed with "could not find function". Functions a + top-level `box::use()` attaches are shipped too (#29). +* An S4 generic, such as `DBI::dbConnect()` imported with `box::use()`, is + shipped as it is instead of being rebound to a copy of its environment, + which lost its method tables and failed dispatch on the worker. +* `function(e) NULL` keeps its `NULL` body when the expression carries source + references, as code from a sourced file, a box module or the console does. + The rewrite deleted the body, so the function returned its srcref instead + (#30). + # shinyasync 0.5.0 ## Breaking changes diff --git a/R/capture.R b/R/capture.R index 425a669..0188620 100644 --- a/R/capture.R +++ b/R/capture.R @@ -219,7 +219,9 @@ analyze_expr <- function(expr, env) { if (identical(head, quote(`function`)) && n >= 3L) { params <- names(x[[2]]) - x[[3]] <- walk(x[[3]], c(locals, params), TRUE, isolated) + # Only a call can be rewritten, and assigning NULL into a call deletes + # the element: `function(e) NULL` would take its srcref as its body. + if (is.call(x[[3]])) x[[3]] <- walk(x[[3]], c(locals, params), TRUE, isolated) return(x) } @@ -504,7 +506,7 @@ collect_globals <- function(names, env, soft = character(), cache = NULL, return(NULL) } if (!identical(where, globalenv()) && !isNamespace(where) && - !startsWith(env_name, "imports:") && env_name != "") { + !startsWith(env_name, "imports:") && env_name != "" && !is_box_env(where)) { return(NULL) # Autoloads, tools:rstudio and similar } @@ -631,9 +633,22 @@ lookup <- function(name, env, mode = "any") { list(found = FALSE) } +# A box module's own environment ("namespace:") or the one a top-level +# box::use() attaches ("mod:"). Neither is an R namespace a worker could +# find again by name, so their objects are shipped as the global environment's +# are. The marker test is box's own is_namespace(). +is_box_env <- function(env) { + inherits(env, "box$mod") || + exists(".__module__.", envir = env, mode = "environment", inherits = FALSE) +} + +# Functions shipped as they are rather than rebound to a clone: those of a +# package, and S4 generics, whose environment holds the method tables dispatch +# needs (box binds DBI::dbConnect() in a module's imports like any function). in_namespace <- function(f) { e <- environment(f) - is.null(e) || isNamespace(e) || identical(e, baseenv()) + is.null(e) || isNamespace(e) || identical(e, baseenv()) || + (isS4(f) && exists(".Generic", envir = e, inherits = FALSE)) } is_reactive_like <- function(x) { diff --git a/tests/testthat/test-capture.R b/tests/testthat/test-capture.R index 469793b..698fdf1 100644 --- a/tests/testthat/test-capture.R +++ b/tests/testthat/test-capture.R @@ -353,3 +353,95 @@ test_that("session calls through a module object, as box::use(shiny) binds them, expect_equal(a$hoisted, list(quote(input$n))) expect_true("other" %in% a$free) }) + +test_that("a function with a NULL body keeps it when the expression has srcrefs", { + # Parsed with srcrefs, as a sourced file, a box module or the console has + # it, `function(e) NULL` carries its srcref as a fourth element. + expr <- parse(text = "tryCatch(stop('boom'), error = function(e) NULL)", keep.source = TRUE)[[1]] + a <- analyze_expr(expr, environment()) + handler <- a$expr[[3]] + expect_identical(handler[[1]], quote(`function`)) + expect_null(handler[[3]]) + expect_null(eval(a$expr, globalenv())) +}) + +# The shapes box gives a module: its own environment, named "namespace:" +# and marked by `.__module__.`, whose parent holds its imports; and the +# `box$mod` environment a top-level box::use() attaches. +box_namespace <- function(name, imports = list()) { + imp <- list2env(imports, parent = baseenv()) + attr(imp, "name") <- paste0("imports:", name) + ns <- new.env(parent = imp) + attr(ns, "name") <- paste0("namespace:", name) + assign(".__module__.", new.env(), envir = ns) + ns +} +in_env <- function(f, env) { + environment(f) <- env + f +} + +test_that("a function defined in a box module is shipped", { + view <- box_namespace("view") + view$local_helper <- in_env(function(x) x + offset, view) + view$offset <- 1 + server_env <- new.env(parent = view) + + deps <- collect_globals(quote(local_helper(41)), server_env) + expect_named(deps$values, "local_helper") + expect_length(deps$missing, 0) + f <- deps$values$local_helper + expect_identical(parent.env(environment(f)), globalenv()) + expect_equal(f(41), 42) +}) + +test_that("an imported box function is shipped with the helpers its module defines", { + helpers <- box_namespace("helpers") + helpers$helper <- in_env(function(x) x * 2, helpers) + helpers$f <- in_env(function(x) helper(x), helpers) + view <- box_namespace("view", imports = list(f = helpers$f)) + server_env <- new.env(parent = view) + + deps <- collect_globals(quote(f(21)), server_env) + f <- deps$values$f + expect_setequal(ls(environment(f)), c("f", "helper")) + expect_equal(f(21), 42) +}) + +test_that("a function attached by a top-level box::use() is shipped", { + helpers <- box_namespace("helpers") + helpers$f <- in_env(function(x) x * 2, helpers) + attached <- new.env(parent = globalenv()) + class(attached) <- "box$mod" + attr(attached, "name") <- "mod:helpers" + attached$f <- helpers$f + caller <- new.env(parent = attached) + + deps <- collect_globals(quote(f(21)), caller) + expect_named(deps$values, "f") + expect_equal(deps$values$f(21), 42) +}) + +test_that("box module functions run on the worker", { + local_pool(1) + view <- box_namespace("view", imports = list(reactiveAsync = reactiveAsync)) + view$local_helper <- in_env(function(x) x + 1, view) + server <- in_env(function(input, output, session) { + r <- reactiveAsync(local_helper(input$n)) + output$x <- shiny::renderText(r()) + }, new.env(parent = view)) + + shiny::testServer(server, { + session$setInputs(n = 41) + wait_for(function() status_async(r) == "success", session) + expect_equal(shiny::isolate(r()), 42) + }) +}) + +test_that("an S4 generic a box module imports is shipped as it is", { + # Rebound to a clone, a generic loses the method tables in its own + # environment and dispatch fails ("unable to find an inherited method"). + view <- box_namespace("view", imports = list(show_it = show)) + deps <- collect_globals(quote(show_it(1)), new.env(parent = view)) + expect_identical(deps$values$show_it, show) +})