diff --git a/.Rbuildignore b/.Rbuildignore index a36915b7f..84a298547 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -35,3 +35,5 @@ ^README-npm\.md$ ^CRAN-SUBMISSION$ ^LICENSE\.md$ +^docs$ +^\.context$ diff --git a/.gitignore b/.gitignore index 732e6ec77..54b9db829 100644 --- a/.gitignore +++ b/.gitignore @@ -22,3 +22,5 @@ madge.svg # GHA remotes installation .github/r-depends.rds .claude/settings.local.json +/docs/ +.context diff --git a/NEWS.md b/NEWS.md index 73e7aa1f4..af10216a1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,14 @@ ## New features +* `session$destroy()` and `session$onDestroy()` are now available on + module session proxies to clean up "dangling reactivity" when dynamic + module UI is removed. Calling `session$destroy()` invokes all + registered `onDestroy()` callbacks for that scope and its descendants, + tearing down reactive values, expressions, and observers. A parent can + also destroy a child module scope by id with `session$destroy(id)`, so it + can tear down a module using the same id it used to insert the UI (#4372). + * New `startApp()` runs a Shiny app in non-blocking mode, returning a `ShinyAppHandle` object with `stop()`, `status()`, `url()`, and `result()` methods. When a new app is started, any previously running non-blocking app diff --git a/R/insert-ui.R b/R/insert-ui.R index e18a1a903..a03a61893 100644 --- a/R/insert-ui.R +++ b/R/insert-ui.R @@ -119,6 +119,40 @@ insertUI <- function(selector, } +#' @section Cleaning up module server-side state: +#' When `removeUI()` removes a module's UI, the server-side reactive objects +#' (observers, reactive values, etc.) created by that module continue to run. +#' The parent inserted the module's UI under an `id`, so it can tear down the +#' module's server-side state by that same `id`: +#' +#' ``` +#' # In the parent server: +#' myModuleServer("my_module") +#' removeUI(selector = "#my_module") +#' session$destroy("my_module") +#' ``` +#' +#' If teardown must happen somewhere that doesn't have the parent session or +#' `id`, a module can instead return its own `session$destroy` as a handle: +#' +#' ``` +#' myModuleServer <- function(id) { +#' moduleServer(id, function(input, output, session) { +#' # ... module logic ... +#' +#' # Return a handle that the caller can invoke during teardown +#' list(destroy = session$destroy) +#' }) +#' } +#' +#' mod <- myModuleServer("my_module") +#' removeUI(selector = "#my_module") +#' mod$destroy() +#' ``` +#' +#' See the [session] help topic for details on composability and data ownership +#' patterns when using `session$destroy()` with dynamic modules. +#' #' @rdname insertUI #' @export removeUI <- function(selector, diff --git a/R/mock-session.R b/R/mock-session.R index 5f0977511..00f617de2 100644 --- a/R/mock-session.R +++ b/R/mock-session.R @@ -129,7 +129,6 @@ makeExtraMethods <- function() { "doBookmark", "exportTestValues", "flushOutput", - "getBookmarkExclude", "getTestSnapshotUrl", "incrementBusyCount", "manageHiddenOutputs", @@ -159,7 +158,6 @@ makeExtraMethods <- function() { "sendProgress", "sendRemoveTab", "sendRemoveUI", - "setBookmarkExclude", "setShowcase", "showProgress", "updateQueryString" @@ -255,6 +253,7 @@ MockShinySession <- R6Class( private$flushCBs <- Callbacks$new() private$flushedCBs <- Callbacks$new() private$endedCBs <- Callbacks$new() + private$destroyCallbacksByNs <- Map$new() private$file_generators <- fastmap() @@ -317,6 +316,30 @@ MockShinySession <- R6Class( onEnded = function(sessionEndedCallback) { private$endedCBs$register(sessionEndedCallback) }, + #' @description Registers a callback to be invoked when the session scope + #' is destroyed. Returns a function that can be called to unregister the + #' callback. + #' @param callback The callback to invoke on destroy. + onDestroy = function(callback) { + # Use sentinel key since fastmap disallows empty string keys + ns <- "..root" + if (!private$destroyCallbacksByNs$containsKey(ns)) { + private$destroyCallbacksByNs$set(ns, Callbacks$new()) + } + private$destroyCallbacksByNs$get(ns)$register(callback) + }, + #' @description Destroys a module session scope. On the root session, an + #' `id` is required: `session$destroy(id)` tears down the child module + #' scope of that `id`. Calling `destroy()` with no `id` on the root + #' session is an error. + #' @param id Optional module `id` whose scope should be destroyed. + destroy = function(id = NULL) { + if (is.null(id)) { + stop("`$destroy()` cannot be called on the root session without an `id`. Pass a module `id` to tear down that scope (e.g. `session$destroy(\"my_module\")`), or call `$destroy()` on a module session.") + } + validateDestroyId(id) + self$makeScope(id)$destroy() + }, #' @description Returns `FALSE` if the session has not yet been closed isEnded = function(){ private$was_closed }, @@ -330,9 +353,23 @@ MockShinySession <- R6Class( withReactiveDomain(self, { private$endedCBs$invoke(onError = printError, ..stacktraceon = TRUE) }) + private$invokeDestroyCallbacks("") private$was_closed <- TRUE }, + #' @description Set input names to be excluded from bookmarking. + #' @param names Character vector of input names. + setBookmarkExclude = function(names) { + private$bookmarkExclude <- names + }, + #' @description Returns the set of input names to be excluded from bookmarking, + #' including those registered by module scopes. + getBookmarkExclude = function() { + scopedExcludes <- lapply(private$getBookmarkExcludeFuns, function(f) f()) + scopedExcludes <- unlist(scopedExcludes) + c(private$bookmarkExclude, scopedExcludes) + }, + #FIXME: this is wrong. Will need to be more complex. #' @description Unsophisticated mock implementation that merely invokes # the given callback immediately. @@ -517,8 +554,17 @@ MockShinySession <- R6Class( #' @param namespace Character vector indicating a namespace. #' @return A new session proxy. makeScope = function(namespace) { + if (identical(namespace, "..root")) { + stop( + "The module namespace '..root' is reserved for internal use.", + call. = FALSE + ) + } ns <- NS(namespace) - createSessionProxy( + + bookmarkExclude <- character(0) + + scope <- createSessionProxy( self, input = .createReactiveValues(private$.input, readonly = TRUE, ns = ns), output = structure(.createOutputWriter(self, ns = ns), class = "shinyoutput"), @@ -526,8 +572,36 @@ MockShinySession <- R6Class( ns = function(namespace) ns(namespace), setInputs = function(...) { self$setInputs(!!!mapNames(ns, rlang::dots_list(..., .homonyms = "error"))) + }, + setBookmarkExclude = function(names) { + bookmarkExclude <<- names + }, + getBookmarkExclude = function() { + bookmarkExclude + }, + onDestroy = function(callback) { + private$getOrCreateDestroyCallbacks(namespace)$register(callback) + }, + destroy = function(id = NULL) { + if (is.null(id)) { + private$invokeDestroyCallbacks(namespace) + } else { + validateDestroyId(id) + self$makeScope(ns(id))$destroy() + } } ) + + unsub_exclude <- private$registerBookmarkExclude(function() { + excluded <- scope$getBookmarkExclude() + ns(excluded) + }) + + scope$onDestroy(function() { + if (is.function(unsub_exclude)) unsub_exclude() + }) + + scope }, #' @description Set the environment associated with a testServer() call, but #' only if it has not previously been set. This ensures that only the @@ -643,6 +717,26 @@ MockShinySession <- R6Class( flushedCBs = NULL, # @field endedCBs `Callbacks` called when session ends. endedCBs = NULL, + # @field destroyCallbacksByNs Map of namespace -> Callbacks for destroy. + destroyCallbacksByNs = NULL, + # @field bookmarkExclude Character vector of input names to exclude from bookmarking. + bookmarkExclude = character(0), + # @field getBookmarkExcludeFuns List of functions returning exclude names (from scopes). + getBookmarkExcludeFuns = list(), + # @field getBookmarkExcludeFunsNextId Monotonic counter for exclude fun IDs. + getBookmarkExcludeFunsNextId = 0L, + + # @description Register a function that returns input names to exclude from + # bookmarking. Returns an unsubscribe function. + # @param fun A function that returns a character vector of namespaced names. + registerBookmarkExclude = function(fun) { + private$getBookmarkExcludeFunsNextId <- private$getBookmarkExcludeFunsNextId + 1L + id <- as.character(private$getBookmarkExcludeFunsNextId) + private$getBookmarkExcludeFuns[[id]] <- fun + function() { + private$getBookmarkExcludeFuns[[id]] <- NULL + } + }, # @field unhandledErrorCallbacks `Callbacks` called when an unhandled error # occurs. unhandledErrorCallbacks = Callbacks$new(), @@ -665,6 +759,53 @@ MockShinySession <- R6Class( #' output, or `NULL` if no output is currently executing. currentOutputName = NULL, + # @description Get or create a Callbacks object for the given namespace. + # @param ns The namespace key. + # @return A Callbacks object. + getOrCreateDestroyCallbacks = function(ns) { + if (!nzchar(ns)) ns <- "..root" + if (!private$destroyCallbacksByNs$containsKey(ns)) { + private$destroyCallbacksByNs$set(ns, Callbacks$new()) + } + private$destroyCallbacksByNs$get(ns) + }, + + # @description Invoke destroy callbacks for the given namespace prefix + # and all child namespaces, deepest-first. + # @param nsPrefix The namespace prefix to match. + invokeDestroyCallbacks = function(nsPrefix = "") { + allNs <- private$destroyCallbacksByNs$keys() + isRoot <- !nzchar(nsPrefix) + + if (!isRoot) { + nsPrefixWithSep <- paste0(nsPrefix, ns.sep) + matching <- allNs[allNs == nsPrefix | startsWith(allNs, nsPrefixWithSep)] + } else { + matching <- allNs + } + + if (length(matching) > 0L) { + # Sort deepest-first (most separators first); root sentinel always last + depths <- nchar(gsub(paste0("[^", ns.sep, "]"), "", matching)) + isRootSentinel <- matching == "..root" + matching <- matching[order(-depths, isRootSentinel, matching)] + + for (ns in matching) { + cbs <- private$destroyCallbacksByNs$get(ns) + if (!is.null(cbs)) { + cbs$invoke(onError = printError) + } + private$destroyCallbacksByNs$remove(ns) + } + } + + # Clean up namespaced inputs + if (!isRoot) { + nsPrefixWithSep <- paste0(nsPrefix, ns.sep) + private$.input$destroyByPrefix(nsPrefixWithSep) + } + }, + # @description Writes a downloadable file to disk. If the `content` function # associated with a download handler does not write a file, an error is # signaled. Created files are deleted upon session close. diff --git a/R/modules.R b/R/modules.R index f0083f52b..27ad384f5 100644 --- a/R/modules.R +++ b/R/modules.R @@ -80,7 +80,43 @@ find_ancestor_session <- function(x, depth = 20) { #' almost always be used). #' #' @return The return value, if any, from executing the module server function -#' @seealso +#' +#' @section Destroying module reactivity: +#' When module UI is added and removed dynamically (e.g. via [insertUI()] and +#' [removeUI()]), the server-side reactive objects created by `moduleServer()` +#' continue to run after the UI is removed. The parent inserted the module's +#' UI under an `id`, so it can tear down all reactive values, expressions, and +#' observers in that scope by that same `id`: +#' +#' ``` +#' # In parent server: +#' myModuleServer("myid") +#' removeUI(selector = "#myid") +#' session$destroy("myid") +#' ``` +#' +#' If teardown must happen somewhere that doesn't have the parent session or +#' `id`, a module can instead return its own `session$destroy` as a handle: +#' +#' ``` +#' myModuleServer <- function(id) { +#' moduleServer(id, function(input, output, session) { +#' # ... module logic ... +#' +#' # Return a cleanup function for the caller to invoke +#' list(result = ..., destroy = session$destroy) +#' }) +#' } +#' +#' mod <- myModuleServer("myid") +#' removeUI(selector = "#myid") +#' mod$destroy() +#' ``` +#' +#' See the [session] help topic for details on composability and data ownership +#' patterns when using `session$destroy()`. +#' +#' @seealso [session], [removeUI()], #' #' @examples #' # Define the UI for a module diff --git a/R/reactive-domains.R b/R/reactive-domains.R index 5b207853f..4f1ee236e 100644 --- a/R/reactive-domains.R +++ b/R/reactive-domains.R @@ -43,7 +43,9 @@ NULL ## ------------------------------------------------------------------------ createMockDomain <- function() { callbacks <- Callbacks$new() + destroyCBs <- Callbacks$new() ended <- FALSE + destroyed <- FALSE domain <- new.env(parent = emptyenv()) domain$ns <- function(id) id domain$token <- "mock-domain" @@ -53,12 +55,23 @@ createMockDomain <- function() { domain$isEnded <- function() { ended } + domain$onDestroy <- function(callback) { + return(destroyCBs$register(callback)) + } + domain$destroy <- function() { + if (!destroyed) { + destroyed <<- TRUE + destroyCBs$invoke() + } + invisible() + } domain$reactlog <- function(logEntry) NULL domain$end <- function() { if (!ended) { ended <<- TRUE callbacks$invoke() } + domain$destroy() invisible() } domain$incrementBusyCount <- function() NULL diff --git a/R/reactives.R b/R/reactives.R index 3a7b75c76..f8b83816a 100644 --- a/R/reactives.R +++ b/R/reactives.R @@ -65,6 +65,34 @@ Dependents <- R6Class( ) ) +# Helper to create an onDestroy wrapper closure that only captures the weakref, +# avoiding accidental strong references to `self`/`private` from the enclosing +# initialize() environment. +make_weak_destroy_wrapper <- function(wr) { + # force() is critical: without it, `wr` is a promise that retains a reference + # to the calling environment (e.g., initialize()), which holds `self` strongly. + # Forcing the promise replaces it with the evaluated value, breaking the + # reference chain and allowing the weakref key to be GC'd. + force(wr) + function() { + obj <- rlang::wref_key(wr) + if (!is.null(obj)) { + obj$destroy() + } + } +} + +destroyedReactiveError <- function(label = NULL) { + msg <- if (!is.null(label) && nzchar(label)) { + paste0("Can't access reactive `", label, "`; its module session has been destroyed") + } else { + "Can't access reactive; its module session has been destroyed" + } + structure( + class = c("shiny.destroyed.error", "error", "condition"), + list(message = msg) + ) +} # ReactiveVal --------------------------------------------------------------- @@ -76,7 +104,9 @@ ReactiveVal <- R6Class( value = NULL, label = NULL, frozen = FALSE, - dependents = NULL + dependents = NULL, + .destroyed = FALSE, + .destroyHandle = NULL ), public = list( .isRecordingOtel = FALSE, # Needs to be set by Shiny @@ -93,8 +123,14 @@ ReactiveVal <- R6Class( domain <- getDefaultReactiveDomain() rLog$define(private$reactId, value, private$label, type = "reactiveVal", domain) .otelLabel <<- otel_log_label_set_reactive_val(private$label, domain = domain) + + if (!is.null(domain) && is.function(domain$onDestroy)) { + wr <- rlang::new_weakref(key = self) + private$.destroyHandle <- domain$onDestroy(make_weak_destroy_wrapper(wr)) + } }, get = function() { + if (private$.destroyed) stop(destroyedReactiveError(private$label)) private$dependents$register() if (private$frozen) @@ -103,6 +139,7 @@ ReactiveVal <- R6Class( private$value }, set = function(value) { + if (private$.destroyed) stop(destroyedReactiveError(private$label)) if (identical(private$value, value)) { return(invisible(FALSE)) } @@ -135,6 +172,19 @@ ReactiveVal <- R6Class( isFrozen = function() { private$frozen }, + # TODO: Add an exported S3 function (e.g., destroyReactive(x)) to destroy + # individual reactive objects. See spec for details. + destroy = function() { + if (private$.destroyed) return(invisible()) + private$.destroyed <- TRUE + if (is.function(private$.destroyHandle)) { + private$.destroyHandle() + private$.destroyHandle <- NULL + } + private$dependents$invalidate(log = FALSE) + private$value <- NULL + invisible() + }, format = function(...) { # capture.output(print()) is necessary because format() doesn't # necessarily return a character vector, e.g. data.frame. @@ -371,6 +421,8 @@ ReactiveValues <- R6Class( .isRecordingOtel = FALSE, # Needs to be set by Shiny .otelAttrs = NULL, # Needs to be set by Shiny + .destroyed = FALSE, + .destroyHandle = NULL, initialize = function( @@ -387,9 +439,16 @@ ReactiveValues <- R6Class( .allValuesDeps <<- Dependents$new(reactId = rLog$asListAllIdStr(.reactId)) .valuesDeps <<- Dependents$new(reactId = rLog$asListIdStr(.reactId)) .dedupe <<- dedupe + + domain <- getDefaultReactiveDomain() + if (!is.null(domain) && is.function(domain$onDestroy)) { + wr <- rlang::new_weakref(key = self) + .destroyHandle <<- domain$onDestroy(make_weak_destroy_wrapper(wr)) + } }, get = function(key) { + if (.destroyed) stop(destroyedReactiveError(.label)) # get value right away to use for logging keyValue <- .values$get(key) @@ -413,6 +472,7 @@ ReactiveValues <- R6Class( }, set = function(key, value, force = FALSE) { + if (.destroyed) stop(destroyedReactiveError(.label)) # if key exists # if it is the same value, return # @@ -585,6 +645,48 @@ ReactiveValues <- R6Class( .valuesDeps$register() return(listValue) + }, + + destroyByPrefix = function(nsPrefix) { + keys <- .values$keys() + matching <- keys[startsWith(keys, nsPrefix)] + if (length(matching) == 0L) return(invisible()) + + for (key in matching) { + dep <- .dependents$get(key) + if (!is.null(dep)) { + dep$invalidate(log = FALSE) + .dependents$remove(key) + } + .values$remove(key) + .metadata$remove(key) + } + .nameOrder <<- setdiff(.nameOrder, matching) + .namesDeps$invalidate(log = FALSE) + .allValuesDeps$invalidate(log = FALSE) + .valuesDeps$invalidate(log = FALSE) + invisible() + }, + + destroy = function() { + if (.destroyed) return(invisible()) + .destroyed <<- TRUE + if (is.function(.destroyHandle)) { + .destroyHandle() + .destroyHandle <<- NULL + } + for (key in .dependents$keys()) { + dep <- .dependents$get(key) + if (!is.null(dep)) dep$invalidate(log = FALSE) + } + .namesDeps$invalidate(log = FALSE) + .allValuesDeps$invalidate(log = FALSE) + .valuesDeps$invalidate(log = FALSE) + .dependents <<- Map$new() + .values <<- Map$new() + .metadata <<- Map$new() + .nameOrder <<- character(0) + invisible() } ) @@ -920,6 +1022,8 @@ Observable <- R6Class( .execCount = integer(0), .mostRecentCtxId = character(0), .ctx = 'Context', + .destroyed = FALSE, + .destroyHandle = NULL, .isRecordingOtel = FALSE, # Needs to be set by Shiny .otelLabel = NULL, # Needs to be set by Shiny @@ -956,8 +1060,14 @@ Observable <- R6Class( .mostRecentCtxId <<- "" .ctx <<- NULL rLog$define(.reactId, .value, .label, type = "observable", .domain) + + if (!is.null(.domain) && is.function(.domain$onDestroy)) { + wr <- rlang::new_weakref(key = self) + .destroyHandle <<- .domain$onDestroy(make_weak_destroy_wrapper(wr)) + } }, getValue = function() { + if (.destroyed) stop(destroyedReactiveError(.label)) .dependents$register() if (.invalidated || .running) { @@ -975,6 +1085,22 @@ Observable <- R6Class( else invisible(.value) }, + destroy = function() { + if (.destroyed) return(invisible()) + .destroyed <<- TRUE + if (is.function(.destroyHandle)) { + .destroyHandle() + .destroyHandle <<- NULL + } + .dependents$invalidate(log = FALSE) + .value <<- NULL + .error <<- FALSE + if (!is.null(.ctx)) { + .ctx$invalidate() + .ctx <<- NULL + } + invisible() + }, format = function() { simpleExprToFunction(fn_body(.origFunc), "reactive") }, @@ -1248,6 +1374,7 @@ Observer <- R6Class( # We must unsubscribe when this observer is destroyed, or else # the observer cannot be garbage collected until the session ends. .autoDestroyHandle = 'ANY', + .autoDestroyOnDestroyHandle = NULL, .invalidateCallbacks = list(), .execCount = integer(0), .onResume = 'function', @@ -1285,6 +1412,7 @@ Observer <- R6Class( .autoDestroy <<- FALSE .autoDestroyHandle <<- NULL + .autoDestroyOnDestroyHandle <<- NULL setAutoDestroy(autoDestroy) .reactId <<- nextGlobalReactId() @@ -1408,12 +1536,19 @@ Observer <- R6Class( destroy() } else { .autoDestroyHandle <<- onReactiveDomainEnded(.domain, .onDomainEnded) + if (is.function(.domain$onDestroy)) { + wr <- rlang::new_weakref(key = self) + .autoDestroyOnDestroyHandle <<- .domain$onDestroy(make_weak_destroy_wrapper(wr)) + } } } } else { if (!is.null(.autoDestroyHandle)) .autoDestroyHandle() .autoDestroyHandle <<- NULL + if (!is.null(.autoDestroyOnDestroyHandle)) + .autoDestroyOnDestroyHandle() + .autoDestroyOnDestroyHandle <<- NULL } invisible(oldValue) @@ -1453,6 +1588,11 @@ Observer <- R6Class( } .autoDestroyHandle <<- NULL + if (!is.null(.autoDestroyOnDestroyHandle)) { + .autoDestroyOnDestroyHandle() + } + .autoDestroyOnDestroyHandle <<- NULL + if (!is.null(.ctx)) { .ctx$invalidate() } @@ -1876,6 +2016,7 @@ invalidateLater <- function(millis, session = getDefaultReactiveDomain()) { rLog$invalidateLater(ctx$.reactId, ctx$id, millis, session) clear_on_ended_callback <- function() {} + clear_on_destroy_callback <- function() {} scheduler <- defineScheduler(session) @@ -1886,6 +2027,7 @@ invalidateLater <- function(millis, session = getDefaultReactiveDomain()) { } clear_on_ended_callback() + clear_on_destroy_callback() if (!session$isClosed()) { session$cycleStartAction(function() { @@ -1903,7 +2045,18 @@ invalidateLater <- function(millis, session = getDefaultReactiveDomain()) { # need to deregister the onEnded(timerHandle) callback each time when the # scheduled task executes; after the task executes, the timerHandle() # function is essentially a no-op, so we can deregister it. - clear_on_ended_callback <- session$onEnded(timerHandle) + clear_on_ended_callback <- session$onEnded(function() { + timerHandle() + clear_on_destroy_callback() + }) + + # Also register with onDestroy so module destroy cancels pending timers. + # Cross-deregister: when destroy fires, clean up the onEnded registration + # (and vice versa — the timer callback above already clears both). + clear_on_destroy_callback <- session$onDestroy(function() { + timerHandle() + clear_on_ended_callback() + }) } invisible() diff --git a/R/shiny.R b/R/shiny.R index 7f135f046..30d0ba2ab 100644 --- a/R/shiny.R +++ b/R/shiny.R @@ -145,6 +145,34 @@ workerId <- local({ #' explicitly namespaced for the current module, `session$ns("name")` #' will return the fully-qualified ID. #' } +#' \item{onDestroy(callback)}{ +#' Registers a callback to be invoked when the session scope ends. +#' Returns a function that can be called to unregister the callback. +#' For the root session, callbacks are invoked when the session closes, +#' after `session$onEnded()` callbacks. Note, `session$destroy()` is not +#' allowed for root sessions. For module session proxies, callbacks are +#' invoked when `session$destroy()` is called. +#' } +#' \item{destroy(id = NULL)}{ +#' Destroys a module session scope (and any descendant scopes) by invoking +#' all registered `onDestroy()` callbacks. This includes cleaning up all +#' reactive values, observers, and reactive expressions created within +#' that scope (and any descendant scopes). +#' +#' Called with no `id` on a module session proxy (e.g. the `session` +#' inside [moduleServer()]), it destroys that module's own scope. Called +#' with an `id`, it destroys the child module scope of that `id` — this is +#' how a parent tears down a module it added, using the same id it used to +#' insert the UI: +#' +#' ``` +#' removeUI(selector = "#editor") +#' session$destroy("editor") +#' ``` +#' +#' On the root session an `id` is required; `session$destroy()` with no +#' `id` is an error (the root session is torn down via `close()`). +#' } #' \item{onEnded(callback)}{ #' Synonym for `onSessionEnded`. #' } @@ -286,6 +314,78 @@ workerId <- local({ #' A reactive read of the current [bootstrapLib()] theme. #' } #' +#' @section Destroying a module: +#' Every reactive object (values, expressions, observers) is **scoped** to the +#' session in which it was created. Destroying a module session tears down only +#' the objects in that scope; the parent session and sibling modules are +#' unaffected. This scoping is what makes modules safe to add and remove +#' dynamically — without it, destroying one module could leak callbacks or +#' invalidate reactive objects that belong to another part of the app. +#' +#' The parent that inserted the module's UI under an `id` can tear it down by +#' that same `id`, without the module having to hand anything back: +#' +#' ``` +#' # In the parent server: insert, then later remove and destroy by id +#' observeEvent(input$add, { +#' insertUI("#container", ui = myModuleUI("editor")) +#' myModuleServer("editor") +#' }) +#' observeEvent(input$remove, { +#' removeUI(selector = "#editor") +#' session$destroy("editor") +#' }) +#' ``` +#' +#' Inside the module, `session$destroy()` (with no `id`) destroys the module's +#' own scope. A module can expose this as a handle for callers that need to +#' trigger teardown from somewhere that doesn't have the parent session or +#' `id` (see the data ownership section below for an example). +#' +#' @section Module data ownership: +#' The key rule: **data that must outlive a module should live outside it.** +#' A reactive value created inside a module is destroyed with the module. +#' A reactive value created in the caller's scope and passed in survives +#' destruction. +#' +#' Returning a reactive value from a module works when the module lives for +#' the entire session. However, if you plan to call `session$destroy()`, the +#' returned value will be destroyed and can no longer be read: +#' +#' ``` +#' myModuleServer <- function(id) { +#' moduleServer(id, function(input, output, session) { +#' result <- reactiveVal(0) +#' # ... update result ... +#' list(result = result, destroy = session$destroy) +#' }) +#' } +#' +#' mod <- myModuleServer("editor") +#' mod$destroy() +#' mod$result() +#' #> Error: Can't access reactive; its module session has been destroyed +#' ``` +#' +#' Instead, pass a reactive value **into** the module. The value lives in +#' the caller's scope and survives destruction: +#' +#' ``` +#' myModuleServer <- function(id, result) { +#' moduleServer(id, function(input, output, session) { +#' observeEvent(input$save, { +#' result(input$data) +#' }) +#' }) +#' } +#' +#' # Caller creates and owns the value +#' saved_data <- reactiveVal(NULL) +#' myModuleServer("editor", result = saved_data) +#' # saved_data is still valid after the module is destroyed +#' ``` +#' +#' @seealso [moduleServer()], [removeUI()] #' @name session NULL @@ -339,6 +439,16 @@ NS <- function(namespace, id = NULL) { ns.sep <- "-" +# Validate the `id` passed to `session$destroy(id)`. Must be a single, +# non-empty, non-NA string. The reserved `..root` sentinel is additionally +# rejected by `makeScope()`. +validateDestroyId <- function(id) { + if (!is.character(id) || length(id) != 1L || is.na(id) || !nzchar(id)) { + stop("`id` must be a single, non-empty string.", call. = FALSE) + } + invisible(id) +} + #' @include utils.R ShinySession <- R6Class( 'ShinySession', @@ -359,6 +469,7 @@ ShinySession <- R6Class( .clientData = 'ANY', # Internal ReactiveValues object for other data sent from the client busyCount = 0L, # Number of observer callbacks that are pending. When 0, we are idle closedCallbacks = 'Callbacks', + destroyCallbacksByNs = 'Map', flushCallbacks = 'Callbacks', flushedCallbacks = 'Callbacks', inputReceivedCallbacks = 'Callbacks', @@ -369,6 +480,7 @@ ShinySession <- R6Class( restoredCallbacks = 'Callbacks', bookmarkExclude = character(0), # Names of inputs to exclude from bookmarking getBookmarkExcludeFuns = list(), + getBookmarkExcludeFunsNextId = 0L, timingRecorder = 'ShinyServerTimingRecorder', testMode = FALSE, # Are we running in test mode? @@ -463,8 +575,12 @@ ShinySession <- R6Class( # object because the return values of the functions are needed, but # Callback$invoke() discards return values. registerBookmarkExclude = function(fun) { - len <- length(private$getBookmarkExcludeFuns) + 1 - private$getBookmarkExcludeFuns[[len]] <- fun + private$getBookmarkExcludeFunsNextId <- private$getBookmarkExcludeFunsNextId + 1L + id <- as.character(private$getBookmarkExcludeFunsNextId) + private$getBookmarkExcludeFuns[[id]] <- fun + function() { + private$getBookmarkExcludeFuns[[id]] <- NULL + } }, # Save output values and errors. This is only used for testing mode. @@ -689,6 +805,90 @@ ShinySession <- R6Class( head() } + invisible() + }, + + # Sentinel key for root-level destroy callbacks (fastmap disallows empty string keys) + destroyNsRoot = "..root", + + destroyNsKey = function(ns) { + if (!nzchar(ns)) private$destroyNsRoot else ns + }, + + getOrCreateDestroyCallbacks = function(ns) { + key <- private$destroyNsKey(ns) + if (!private$destroyCallbacksByNs$containsKey(key)) { + private$destroyCallbacksByNs$set(key, Callbacks$new()) + } + private$destroyCallbacksByNs$get(key) + }, + invokeDestroyCallbacks = function(nsPrefix = "") { + allNs <- private$destroyCallbacksByNs$keys() + isRoot <- !nzchar(nsPrefix) + + if (!isRoot) { + nsPrefixWithSep <- paste0(nsPrefix, ns.sep) + # Match the namespace itself and any children + matching <- allNs[allNs == nsPrefix | startsWith(allNs, nsPrefixWithSep)] + } else { + matching <- allNs + } + + if (length(matching) > 0L) { + # Sort deepest-first (most separators first); root sentinel always last + depths <- nchar(gsub(paste0("[^", ns.sep, "]"), "", matching)) + isRootSentinel <- matching == private$destroyNsRoot + matching <- matching[order(-depths, isRootSentinel, matching)] + + for (ns in matching) { + cbs <- private$destroyCallbacksByNs$get(ns) + if (!is.null(cbs)) { + cbs$invoke(onError = printError) + } + private$destroyCallbacksByNs$remove(ns) + } + } + + # Clean up inputs and clientData for matched namespaces + if (!isRoot) { + nsPrefixWithSep <- paste0(nsPrefix, ns.sep) + private$.input$destroyByPrefix(nsPrefixWithSep) + private$.clientData$destroyByPrefix(nsPrefixWithSep) + # Output-related clientData uses "output_-..." naming + private$.clientData$destroyByPrefix(paste0("output_", nsPrefixWithSep)) + } + + # Clean up outputs for matched namespaces + outputNames <- rlang::names2(private$.outputs) + if (!isRoot) { + nsPrefixWithSep <- paste0(nsPrefix, ns.sep) + matchingOutputs <- outputNames[startsWith(outputNames, nsPrefixWithSep)] + } else { + matchingOutputs <- outputNames + } + for (outName in matchingOutputs) { + if (!is.null(private$.outputs[[outName]])) { + private$.outputs[[outName]]$destroy() + } + private$.outputs[[outName]] <- NULL + private$.outputOptions[[outName]] <- NULL + private$invalidatedOutputValues$remove(outName) + private$invalidatedOutputErrors$remove(outName) + } + + # Clean up dynamic routes + if (!isRoot) { + nsPrefixWithSep <- paste0(nsPrefix, ns.sep) + downloadNames <- self$downloads$keys() + for (name in downloadNames[startsWith(downloadNames, nsPrefixWithSep)]) { + self$downloads$remove(name) + } + fileNames <- self$files$keys() + for (name in fileNames[startsWith(fileNames, nsPrefixWithSep)]) { + self$files$remove(name) + } + } + invisible() } ), @@ -721,6 +921,7 @@ ShinySession <- R6Class( private$invalidatedOutputErrors <- Map$new() private$fileUploadContext <- FileUploadContext$new() private$closedCallbacks <- Callbacks$new() + private$destroyCallbacksByNs <- Map$new() private$flushCallbacks <- Callbacks$new() private$flushedCallbacks <- Callbacks$new() private$inputReceivedCallbacks <- Callbacks$new() @@ -804,6 +1005,13 @@ ShinySession <- R6Class( self }, makeScope = function(namespace) { + if (identical(namespace, private$destroyNsRoot)) { + stop( + "The module namespace '", private$destroyNsRoot, + "' is reserved for internal use.", + call. = FALSE + ) + } ns <- NS(namespace) # Private items for this scope. Can't be part of the scope object because @@ -871,6 +1079,18 @@ ShinySession <- R6Class( c(dots, quoted_ = TRUE, env_ = env_), quote = TRUE ) + }, + + onDestroy = function(callback) { + private$getOrCreateDestroyCallbacks(namespace)$register(callback) + }, + destroy = function(id = NULL) { + if (is.null(id)) { + private$invokeDestroyCallbacks(namespace) + } else { + validateDestroyId(id) + self$makeScope(ns(id))$destroy() + } } ) @@ -926,7 +1146,7 @@ ShinySession <- R6Class( # When scope is created, register these bookmarking callbacks on the main # session object. They will invoke the scope's own callbacks, if any are # present. - self$onBookmark(function(state) { + unsub_bookmark <- self$onBookmark(function(state) { # Exit if no user-defined callbacks. if (bookmarkCallbacks$count() == 0) return() @@ -960,7 +1180,7 @@ ShinySession <- R6Class( } }) - self$onRestore(function(state) { + unsub_restore <- self$onRestore(function(state) { # Exit if no user-defined callbacks. if (restoreCallbacks$count() == 0) return() @@ -970,7 +1190,7 @@ ShinySession <- R6Class( restoreCallbacks$invoke(scopeState) }) - self$onRestored(function(state) { + unsub_restored <- self$onRestored(function(state) { # Exit if no user-defined callbacks. if (restoredCallbacks$count() == 0) return() @@ -981,11 +1201,25 @@ ShinySession <- R6Class( }) # Returns the excluded names with the scope's ns prefix on them. - private$registerBookmarkExclude(function() { + unsub_exclude <- private$registerBookmarkExclude(function() { excluded <- scope$getBookmarkExclude() ns(excluded) }) + # Clean up bookmark registrations when this scope is destroyed + scope$onDestroy(function() { + if (is.function(unsub_bookmark)) unsub_bookmark() + if (is.function(unsub_restore)) unsub_restore() + if (is.function(unsub_restored)) unsub_restored() + if (is.function(unsub_exclude)) unsub_exclude() + + # Reset local var states just in case, even though they won't be used anymore + unsub_bookmark <<- NULL + unsub_restore <<- NULL + unsub_restored <<- NULL + unsub_exclude <<- NULL + }) + scope }, ns = function(id) { @@ -1040,6 +1274,27 @@ ShinySession <- R6Class( "Synonym for onSessionEnded" return(self$onSessionEnded(endedCallback)) }, + onDestroy = function(callback) { + "Registers a callback to be invoked when the session scope is destroyed + via `destroy()`. Returns a function that can be called to + unregister the callback. For module sessions, use this to register + cleanup logic that runs when the module's UI is removed and + `session$destroy()` is called." + private$getOrCreateDestroyCallbacks("")$register(callback) + }, + destroy = function(id = NULL) { + "Destroys a module session scope, cleaning up its reactive state and + invoking its `onDestroy()` callbacks. On the root session, an + `id` is required: `session$destroy(id)` tears down the + child module scope of that `id`. Calling `destroy()` + with no `id` on the root session is an error; the root session + is torn down via `close()`." + if (is.null(id)) { + stop("`$destroy()` cannot be called on the root ShinySession without an `id`. Pass a module `id` to tear down that scope (e.g. `session$destroy(\"my_module\")`), or call `$destroy()` on a module session.") + } + validateDestroyId(id) + self$makeScope(id)$destroy() + }, onInputReceived = function(callback) { "Registers the given callback to be invoked when the session receives new data from the client." @@ -1090,6 +1345,7 @@ ShinySession <- R6Class( private$closedCallbacks$invoke(onError = printError, ..stacktraceon = TRUE) }) }) + private$invokeDestroyCallbacks("") }, isClosed = function() { return(self$closed) @@ -1110,9 +1366,9 @@ ShinySession <- R6Class( defineOutput = function(name, func, label) { "Binds an output generating function to this name. The function can either - take no parameters, or have named parameters for \\code{name} and - \\code{shinysession} (in the future this list may expand, so it is a good idea - to also include \\code{...} in your function signature)." + take no parameters, or have named parameters for `name` and + `shinysession` (in the future this list may expand, so it is a good idea + to also include `...` in your function signature)." # jcheng 08/31/2012: User submitted an example of a dynamically calculated # name not working unless name was eagerly evaluated. Yikes! @@ -1371,7 +1627,7 @@ ShinySession <- R6Class( }, showProgress = function(id, persistent=FALSE) { 'Send a message to the client that recalculation of the output identified - by \\code{id} is in progress. There is currently no mechanism for + by `id` is in progress. There is currently no mechanism for explicitly turning off progress for an output component; instead, all progress is implicitly turned off when flushOutput is next called. diff --git a/man/MockShinySession.Rd b/man/MockShinySession.Rd index d9ae01cd8..860b6b3c6 100644 --- a/man/MockShinySession.Rd +++ b/man/MockShinySession.Rd @@ -89,9 +89,13 @@ user. Always \code{NULL} for a \code{MockShinySesion}.} \item \href{#method-MockShinySession-onFlush}{\code{MockShinySession$onFlush()}} \item \href{#method-MockShinySession-onFlushed}{\code{MockShinySession$onFlushed()}} \item \href{#method-MockShinySession-onEnded}{\code{MockShinySession$onEnded()}} + \item \href{#method-MockShinySession-onDestroy}{\code{MockShinySession$onDestroy()}} + \item \href{#method-MockShinySession-destroy}{\code{MockShinySession$destroy()}} \item \href{#method-MockShinySession-isEnded}{\code{MockShinySession$isEnded()}} \item \href{#method-MockShinySession-isClosed}{\code{MockShinySession$isClosed()}} \item \href{#method-MockShinySession-close}{\code{MockShinySession$close()}} + \item \href{#method-MockShinySession-setBookmarkExclude}{\code{MockShinySession$setBookmarkExclude()}} + \item \href{#method-MockShinySession-getBookmarkExclude}{\code{MockShinySession$getBookmarkExclude()}} \item \href{#method-MockShinySession-cycleStartAction}{\code{MockShinySession$cycleStartAction()}} \item \href{#method-MockShinySession-fileUrl}{\code{MockShinySession$fileUrl()}} \item \href{#method-MockShinySession-setInputs}{\code{MockShinySession$setInputs()}} @@ -188,6 +192,49 @@ user. Always \code{NULL} for a \code{MockShinySesion}.} } } +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-MockShinySession-onDestroy}{}}} +\subsection{\code{MockShinySession$onDestroy()}}{ + Registers a callback to be invoked when the session scope +is destroyed. Returns a function that can be called to unregister the +callback. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{MockShinySession$onDestroy(callback)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{callback}}{The callback to invoke on destroy.} + } + \if{html}{\out{
}} + } +} + +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-MockShinySession-destroy}{}}} +\subsection{\code{MockShinySession$destroy()}}{ + Destroys a module session scope. On the root session, an +\code{id} is required: \code{session$destroy(id)} tears down the child module +scope of that \code{id}. Calling \code{destroy()} with no \code{id} on the root +session is an error. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{MockShinySession$destroy(id = NULL)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{id}}{Optional module \code{id} whose scope should be destroyed.} + } + \if{html}{\out{
}} + } +} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MockShinySession-isEnded}{}}} @@ -224,6 +271,38 @@ user. Always \code{NULL} for a \code{MockShinySesion}.} } } +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-MockShinySession-setBookmarkExclude}{}}} +\subsection{\code{MockShinySession$setBookmarkExclude()}}{ + Set input names to be excluded from bookmarking. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{MockShinySession$setBookmarkExclude(names)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{names}}{Character vector of input names.} + } + \if{html}{\out{
}} + } +} + +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-MockShinySession-getBookmarkExclude}{}}} +\subsection{\code{MockShinySession$getBookmarkExclude()}}{ + Returns the set of input names to be excluded from bookmarking, +including those registered by module scopes. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{MockShinySession$getBookmarkExclude()} + \if{html}{\out{
}} + } +} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MockShinySession-cycleStartAction}{}}} diff --git a/man/insertUI.Rd b/man/insertUI.Rd index a9c9a89a0..06bb01ada 100644 --- a/man/insertUI.Rd +++ b/man/insertUI.Rd @@ -79,6 +79,40 @@ It's particularly useful to pair \code{removeUI} with \code{insertUI()}, but the no restriction on what you can use it on. Any element that can be selected through a jQuery selector can be removed through this function. } +\section{Cleaning up module server-side state}{ + +When \code{removeUI()} removes a module's UI, the server-side reactive objects +(observers, reactive values, etc.) created by that module continue to run. +The parent inserted the module's UI under an \code{id}, so it can tear down the +module's server-side state by that same \code{id}: + +\if{html}{\out{
}}\preformatted{# In the parent server: +myModuleServer("my_module") +removeUI(selector = "#my_module") +session$destroy("my_module") +}\if{html}{\out{
}} + +If teardown must happen somewhere that doesn't have the parent session or +\code{id}, a module can instead return its own \code{session$destroy} as a handle: + +\if{html}{\out{
}}\preformatted{myModuleServer <- function(id) \{ + moduleServer(id, function(input, output, session) \{ + # ... module logic ... + + # Return a handle that the caller can invoke during teardown + list(destroy = session$destroy) + \}) +\} + +mod <- myModuleServer("my_module") +removeUI(selector = "#my_module") +mod$destroy() +}\if{html}{\out{
}} + +See the \link{session} help topic for details on composability and data ownership +patterns when using \code{session$destroy()} with dynamic modules. +} + \examples{ ## Only run this example in interactive R sessions if (interactive()) { diff --git a/man/moduleServer.Rd b/man/moduleServer.Rd index b77145a67..23b97b601 100644 --- a/man/moduleServer.Rd +++ b/man/moduleServer.Rd @@ -30,6 +30,41 @@ Starting in Shiny 1.5.0, we recommend using \code{moduleServer} instead of to understand, and modules created with \code{moduleServer} can be tested with \code{\link[=testServer]{testServer()}}. } +\section{Destroying module reactivity}{ + +When module UI is added and removed dynamically (e.g. via \code{\link[=insertUI]{insertUI()}} and +\code{\link[=removeUI]{removeUI()}}), the server-side reactive objects created by \code{moduleServer()} +continue to run after the UI is removed. The parent inserted the module's +UI under an \code{id}, so it can tear down all reactive values, expressions, and +observers in that scope by that same \code{id}: + +\if{html}{\out{
}}\preformatted{# In parent server: +myModuleServer("myid") +removeUI(selector = "#myid") +session$destroy("myid") +}\if{html}{\out{
}} + +If teardown must happen somewhere that doesn't have the parent session or +\code{id}, a module can instead return its own \code{session$destroy} as a handle: + +\if{html}{\out{
}}\preformatted{myModuleServer <- function(id) \{ + moduleServer(id, function(input, output, session) \{ + # ... module logic ... + + # Return a cleanup function for the caller to invoke + list(result = ..., destroy = session$destroy) + \}) +\} + +mod <- myModuleServer("myid") +removeUI(selector = "#myid") +mod$destroy() +}\if{html}{\out{
}} + +See the \link{session} help topic for details on composability and data ownership +patterns when using \code{session$destroy()}. +} + \examples{ # Define the UI for a module counterUI <- function(id, label = "Counter") { @@ -103,5 +138,5 @@ if (interactive()) { } \seealso{ -\url{https://shiny.posit.co/articles/modules.html} +\link{session}, \code{\link[=removeUI]{removeUI()}}, \url{https://shiny.posit.co/articles/modules.html} } diff --git a/man/session.Rd b/man/session.Rd index e0b73509c..4b0fdd570 100644 --- a/man/session.Rd +++ b/man/session.Rd @@ -53,6 +53,33 @@ Server-side version of \code{\link[=NS]{ns <- NS(id)}}. If bare IDs need to be explicitly namespaced for the current module, \code{session$ns("name")} will return the fully-qualified ID. } +\item{onDestroy(callback)}{ +Registers a callback to be invoked when the session scope ends. +Returns a function that can be called to unregister the callback. +For the root session, callbacks are invoked when the session closes, +after \code{session$onEnded()} callbacks. Note, \code{session$destroy()} is not +allowed for root sessions. For module session proxies, callbacks are +invoked when \code{session$destroy()} is called. +} +\item{destroy(id = NULL)}{ +Destroys a module session scope (and any descendant scopes) by invoking +all registered \code{onDestroy()} callbacks. This includes cleaning up all +reactive values, observers, and reactive expressions created within +that scope (and any descendant scopes). + +Called with no \code{id} on a module session proxy (e.g. the \code{session} +inside \code{\link[=moduleServer]{moduleServer()}}), it destroys that module's own scope. Called +with an \code{id}, it destroys the child module scope of that \code{id} — this is +how a parent tears down a module it added, using the same id it used to +insert the UI: + +\if{html}{\out{
}}\preformatted{removeUI(selector = "#editor") +session$destroy("editor") +}\if{html}{\out{
}} + +On the root session an \code{id} is required; \code{session$destroy()} with no +\code{id} is an error (the root session is torn down via \code{close()}). +} \item{onEnded(callback)}{ Synonym for \code{onSessionEnded}. } @@ -201,3 +228,78 @@ relating to the session. The following list describes the items available in the environment; they can be accessed using the \code{$} operator (for example, \code{session$clientData$url_search}). } +\section{Destroying a module}{ + +Every reactive object (values, expressions, observers) is \strong{scoped} to the +session in which it was created. Destroying a module session tears down only +the objects in that scope; the parent session and sibling modules are +unaffected. This scoping is what makes modules safe to add and remove +dynamically — without it, destroying one module could leak callbacks or +invalidate reactive objects that belong to another part of the app. + +The parent that inserted the module's UI under an \code{id} can tear it down by +that same \code{id}, without the module having to hand anything back: + +\if{html}{\out{
}}\preformatted{# In the parent server: insert, then later remove and destroy by id +observeEvent(input$add, \{ + insertUI("#container", ui = myModuleUI("editor")) + myModuleServer("editor") +\}) +observeEvent(input$remove, \{ + removeUI(selector = "#editor") + session$destroy("editor") +\}) +}\if{html}{\out{
}} + +Inside the module, \code{session$destroy()} (with no \code{id}) destroys the module's +own scope. A module can expose this as a handle for callers that need to +trigger teardown from somewhere that doesn't have the parent session or +\code{id} (see the data ownership section below for an example). +} + +\section{Module data ownership}{ + +The key rule: \strong{data that must outlive a module should live outside it.} +A reactive value created inside a module is destroyed with the module. +A reactive value created in the caller's scope and passed in survives +destruction. + +Returning a reactive value from a module works when the module lives for +the entire session. However, if you plan to call \code{session$destroy()}, the +returned value will be destroyed and can no longer be read: + +\if{html}{\out{
}}\preformatted{myModuleServer <- function(id) \{ + moduleServer(id, function(input, output, session) \{ + result <- reactiveVal(0) + # ... update result ... + list(result = result, destroy = session$destroy) + \}) +\} + +mod <- myModuleServer("editor") +mod$destroy() +mod$result() +#> Error: Can't access reactive; its module session has been destroyed +}\if{html}{\out{
}} + +Instead, pass a reactive value \strong{into} the module. The value lives in +the caller's scope and survives destruction: + +\if{html}{\out{
}}\preformatted{myModuleServer <- function(id, result) \{ + moduleServer(id, function(input, output, session) \{ + observeEvent(input$save, \{ + result(input$data) + \}) + \}) +\} + +# Caller creates and owns the value +saved_data <- reactiveVal(NULL) +myModuleServer("editor", result = saved_data) +# saved_data is still valid after the module is destroyed +}\if{html}{\out{
}} +} + +\seealso{ +\code{\link[=moduleServer]{moduleServer()}}, \code{\link[=removeUI]{removeUI()}} +} diff --git a/tests/testthat/test-destroy.R b/tests/testthat/test-destroy.R new file mode 100644 index 000000000..149fa630c --- /dev/null +++ b/tests/testthat/test-destroy.R @@ -0,0 +1,927 @@ +test_that("destroyedReactiveError creates correct condition", { + err <- destroyedReactiveError("test label") + expect_s3_class(err, "shiny.destroyed.error") + expect_s3_class(err, "error") + expect_match(conditionMessage(err), "test label") + expect_match(conditionMessage(err), "destroyed") +}) + +test_that("destroyedReactiveError can be caught specifically", { + expect_error( + stop(destroyedReactiveError("my_reactive")), + class = "shiny.destroyed.error" + ) +}) + +test_that("ReactiveVal$destroy() sets destroyed flag and invalidates dependents", { + rv_impl <- ReactiveVal$new(10, label = "test_rv") + + # Track invalidation + invalidated <- FALSE + ctx <- Context$new(domain = NULL) + ctx$onInvalidate(function() invalidated <<- TRUE) + ctx$run(function() rv_impl$get()) + + rv_impl$destroy() + flushReact() + + expect_true(invalidated) +}) + +test_that("ReactiveVal$destroy() is idempotent", { + rv_impl <- ReactiveVal$new(10, label = "test_rv") + rv_impl$destroy() + expect_no_error(rv_impl$destroy()) +}) + +test_that("destroyed ReactiveVal$get() raises shiny.destroyed.error", { + rv_impl <- ReactiveVal$new(10, label = "test_rv") + rv_impl$destroy() + expect_error(rv_impl$get(), class = "shiny.destroyed.error") +}) + +test_that("destroyed ReactiveVal$set() raises shiny.destroyed.error", { + rv_impl <- ReactiveVal$new(10, label = "test_rv") + rv_impl$destroy() + expect_error(rv_impl$set(20), class = "shiny.destroyed.error") +}) + +test_that("ReactiveVal$destroy() does not emit rLog or otel", { + rv_impl <- ReactiveVal$new(10, label = "test_rv") + ctx <- Context$new(domain = NULL) + ctx$run(function() rv_impl$get()) + expect_no_error({ + rv_impl$destroy() + flushReact() + }) +}) + +test_that("Observable$destroy() sets destroyed flag and invalidates dependents", { + o <- Observable$new(function() 42, label = "test_obs", domain = NULL) + # Force first evaluation + isolate(o$getValue()) + + # Track invalidation of downstream + invalidated <- FALSE + ctx <- Context$new(domain = NULL) + ctx$onInvalidate(function() invalidated <<- TRUE) + ctx$run(function() o$getValue()) + + o$destroy() + flushReact() + + expect_true(invalidated) +}) + +test_that("Observable$destroy() is idempotent", { + o <- Observable$new(function() 42, label = "test_obs", domain = NULL) + o$destroy() + expect_no_error(o$destroy()) +}) + +test_that("destroyed Observable$getValue() raises shiny.destroyed.error", { + o <- Observable$new(function() 42, label = "test_obs", domain = NULL) + o$destroy() + expect_error(isolate(o$getValue()), class = "shiny.destroyed.error") +}) + +test_that("Observable$destroy() clears value and error refs", { + o <- Observable$new(function() list(big = rep(1, 1e6)), label = "test_obs", domain = NULL) + isolate(o$getValue()) + o$destroy() + expect_null(o$.value) + expect_false(o$.error) +}) + +test_that("Observer registers weak destroy callback with domain$onDestroy", { + domain <- createMockDomain() + # Add onDestroy to mock domain + destroyCBs <- Callbacks$new() + domain$onDestroy <- function(callback) destroyCBs$register(callback) + + withReactiveDomain(domain, { + val <- reactiveVal(0) + count <- 0L + obs <- observe({ val(); count <<- count + 1L }) + }) + flushReact() + expect_equal(count, 1L) + + # Verify something was registered with onDestroy + expect_gt(destroyCBs$count(), 0) +}) + +test_that("Observer$destroy() deregisters from onDestroy", { + domain <- createMockDomain() + destroyCBs <- Callbacks$new() + domain$onDestroy <- function(callback) destroyCBs$register(callback) + + withReactiveDomain(domain, { + obs <- observe({ TRUE }) + }) + flushReact() + initial_count <- destroyCBs$count() + + obs$destroy() + # The unsubscribe handle should have deregistered the callback + expect_lt(destroyCBs$count(), initial_count) +}) + +test_that("ReactiveVal$destroy() deregisters its onDestroy callback", { + domain <- createMockDomain() + destroyCBs <- Callbacks$new() + domain$onDestroy <- function(callback) destroyCBs$register(callback) + + withReactiveDomain(domain, { + rv <- reactiveVal(10) + }) + rv_impl <- attr(rv, ".impl") + + initial_count <- destroyCBs$count() + expect_gt(initial_count, 0) + + rv_impl$destroy() + expect_lt(destroyCBs$count(), initial_count) +}) + +test_that("Observable$destroy() deregisters its onDestroy callback", { + domain <- createMockDomain() + destroyCBs <- Callbacks$new() + domain$onDestroy <- function(callback) destroyCBs$register(callback) + + withReactiveDomain(domain, { + r <- reactive({ 42 }) + }) + + initial_count <- destroyCBs$count() + expect_gt(initial_count, 0) + + o <- attr(r, "observable") + o$destroy() + expect_lt(destroyCBs$count(), initial_count) +}) + +test_that("ReactiveVal auto-registers weak destroy callback with domain", { + domain <- createMockDomain() + destroyCBs <- Callbacks$new() + domain$onDestroy <- function(callback) destroyCBs$register(callback) + + withReactiveDomain(domain, { + rv <- reactiveVal(10) + }) + + expect_gt(destroyCBs$count(), 0) +}) + +test_that("Observable auto-registers weak destroy callback with domain", { + domain <- createMockDomain() + destroyCBs <- Callbacks$new() + domain$onDestroy <- function(callback) destroyCBs$register(callback) + + withReactiveDomain(domain, { + r <- reactive({ 42 }) + }) + + expect_gt(destroyCBs$count(), 0) +}) + +test_that("ReactiveVal without domain does not error on creation", { + rv_impl <- ReactiveVal$new(10, label = "no_domain") + isolate(expect_equal(rv_impl$get(), 10)) + rv_impl$set(20) + isolate(expect_equal(rv_impl$get(), 20)) +}) + +test_that("Observable without domain does not error on creation", { + o <- Observable$new(function() 42, label = "no_domain", domain = NULL) + expect_false(o$.destroyed) +}) + +test_that("weakref key becomes NULL after GC of ReactiveVal", { + domain <- createMockDomain() + wrs <- list() + domain$onDestroy <- function(callback) { + wrs[[length(wrs) + 1L]] <<- callback + function() {} + } + + withReactiveDomain(domain, { + rv <- reactiveVal(10) + }) + rv_impl <- attr(rv, ".impl") + + expect_equal(length(wrs), 1L) + # The wrapper is a function that closes over the weakref + expect_true(is.function(wrs[[1L]])) + + # Remove all references to the R6 object + rm(rv, rv_impl) + gc() + + # The wrapper function should still exist, but when called + # it should be a no-op because the weakref key is gone + expect_no_error(wrs[[1L]]()) +}) + +test_that("weakref key becomes NULL after GC of Observable", { + domain <- createMockDomain() + wrs <- list() + domain$onDestroy <- function(callback) { + wrs[[length(wrs) + 1L]] <<- callback + function() {} + } + + withReactiveDomain(domain, { + r <- reactive({ 42 }) + }) + + expect_equal(length(wrs), 1L) + + rm(r) + gc() + + # Calling the wrapper after GC should be a no-op + expect_no_error(wrs[[1L]]()) +}) + +test_that("weakref key becomes NULL after GC of Observer", { + domain <- createMockDomain() + wrs <- list() + domain$onDestroy <- function(callback) { + wrs[[length(wrs) + 1L]] <<- callback + function() {} + } + + withReactiveDomain(domain, { + rv <- reactiveVal(0) + obs <- observe({ rv() }) + }) + flushReact() + + # Find the observer's wrapper (there may be wrappers from reactiveVal too) + initial_count <- length(wrs) + expect_gte(initial_count, 1L) + + obs$destroy() + rm(obs) + gc() + + # All wrappers should be safe to call after GC + for (w in wrs) { + expect_no_error(w()) + } +}) + +test_that("weakref key can be GC'd when no strong references remain", { + domain <- createMockDomain() + wrs <- list() + domain$onDestroy <- function(callback) { + wrs[[length(wrs) + 1L]] <<- callback + function() {} + } + + withReactiveDomain(domain, { + rv <- reactiveVal(999) + }) + rv_impl <- attr(rv, ".impl") + weak_check <- rlang::new_weakref(rv_impl) + + expect_false(is.null(rlang::wref_key(weak_check))) + + rm(rv, rv_impl) + gc() + + # After removing all references, the object should be GC'd + expect_null(rlang::wref_key(weak_check)) +}) + +test_that("ReactiveValues$destroyByPrefix removes keys matching namespace prefix", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "test") + rv$set("mymod-x", 1) + rv$set("mymod-y", 2) + rv$set("other-z", 3) + rv$set("mymod-inner-a", 4) + + rv$destroyByPrefix("mymod-") + + expect_equal(sort(isolate(rv$names())), "other-z") + expect_equal(isolate(rv$get("other-z")), 3) +}) + +test_that("ReactiveValues$destroyByPrefix invalidates dependents of removed keys", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "test") + rv$set("mymod-x", 10) + + invalidated <- FALSE + ctx <- Context$new(domain = NULL) + ctx$onInvalidate(function() invalidated <<- TRUE) + ctx$run(function() rv$get("mymod-x")) + + rv$destroyByPrefix("mymod-") + flushReact() + + expect_true(invalidated) +}) + +test_that("ReactiveValues$destroyByPrefix invalidates names() dependents", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "test") + rv$set("mymod-x", 10) + + invalidated <- FALSE + ctx <- Context$new(domain = NULL) + ctx$onInvalidate(function() invalidated <<- TRUE) + ctx$run(function() rv$names()) + + rv$destroyByPrefix("mymod-") + flushReact() + + expect_true(invalidated) +}) + +test_that("ReactiveValues$destroyByPrefix is no-op when no keys match", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "test") + rv$set("other-x", 1) + + expect_no_error(rv$destroyByPrefix("mymod-")) + expect_equal(isolate(rv$names()), "other-x") +}) + +test_that("ReactiveValues$destroy() sets destroyed flag and invalidates dependents", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "test") + rv$set("x", 1) + + invalidated <- FALSE + ctx <- Context$new(domain = NULL) + ctx$onInvalidate(function() invalidated <<- TRUE) + ctx$run(function() rv$get("x")) + + rv$destroy() + flushReact() + + expect_true(invalidated) +}) + +test_that("ReactiveValues$destroy() is idempotent", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "test") + rv$destroy() + expect_no_error(rv$destroy()) +}) + +test_that("destroyed ReactiveValues$get() raises shiny.destroyed.error", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "test") + rv$set("x", 1) + rv$destroy() + expect_error(rv$get("x"), class = "shiny.destroyed.error") +}) + +test_that("destroyed ReactiveValues$set() raises shiny.destroyed.error", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "test") + rv$destroy() + expect_error(rv$set("x", 1), class = "shiny.destroyed.error") +}) + +test_that("ReactiveValues auto-registers weak destroy callback with domain", { + domain <- createMockDomain() + destroyCBs <- Callbacks$new() + domain$onDestroy <- function(callback) destroyCBs$register(callback) + + withReactiveDomain(domain, { + rv <- reactiveValues(a = 1) + }) + + expect_gt(destroyCBs$count(), 0) +}) + +test_that("ReactiveValues without domain does not error on creation", { + rv <- ReactiveValues$new(dedupe = FALSE, label = "no_domain") + rv$set("x", 1) + expect_equal(isolate(rv$get("x")), 1) +}) + +test_that("MockShinySession$onDestroy registers callback and returns unsubscribe", { + session <- MockShinySession$new() + called <- FALSE + unsub <- session$onDestroy(function() called <<- TRUE) + expect_true(is.function(unsub)) +}) + +test_that("MockShinySession$destroy() with no id throws an error", { + session <- MockShinySession$new() + expect_error(session$destroy(), "without an `id`") +}) + +test_that("root session$destroy(id) tears down the named module scope", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + called <- FALSE + scope$onDestroy(function() called <<- TRUE) + + expect_false(called) + # Destroy the scope from the root session using only its id + session$destroy("mod1") + expect_true(called) +}) + +test_that("root session$destroy(id) destroys the scope's reactive state", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + obs_val <- NULL + observer_ran <- 0L + withReactiveDomain(scope, { + rv <- reactiveVal(10) + obs <- observe({ + observer_ran <<- observer_ran + 1L + obs_val <<- rv() + }) + }) + flushReact() + expect_equal(observer_ran, 1L) + + session$destroy("mod1") + flushReact() + + # Observer should not run again + expect_equal(observer_ran, 1L) + + # Accessing the destroyed reactive should error + rv_impl <- attr(rv, ".impl") + expect_error(isolate(rv_impl$get()), class = "shiny.destroyed.error") +}) + +test_that("session$destroy(id) is equivalent to makeScope(id)$destroy()", { + session <- MockShinySession$new() + scope <- session$makeScope("mymod") + + session$setInputs(`mymod-x` = 1, other = 2) + flushReact() + + session$destroy("mymod") + flushReact() + + expect_null(isolate(session$input$`mymod-x`)) + expect_equal(isolate(session$input$other), 2) +}) + +test_that("module session$destroy(id) tears down a nested child scope", { + session <- MockShinySession$new() + parent <- session$makeScope("parent") + child <- parent$makeScope("child") + + child_called <- FALSE + parent_called <- FALSE + child$onDestroy(function() child_called <<- TRUE) + parent$onDestroy(function() parent_called <<- TRUE) + + # Destroy the child from the parent session using only its id + parent$destroy("child") + expect_true(child_called) + # Parent itself should remain alive + expect_false(parent_called) +}) + +test_that("session$destroy(id) on an unknown id is a harmless no-op", { + session <- MockShinySession$new() + expect_no_error(session$destroy("never_created")) +}) + +test_that("session$destroy(id) validates the id argument", { + session <- MockShinySession$new() + expect_error(session$destroy(1), "single, non-empty string") + expect_error(session$destroy(c("a", "b")), "single, non-empty string") + expect_error(session$destroy(""), "single, non-empty string") + expect_error(session$destroy(NA_character_), "single, non-empty string") +}) + +test_that("session$destroy(id) does not leak bookmark-exclude callbacks", { + session <- MockShinySession$new() + before <- session$getBookmarkExclude() + session$makeScope("mod1") + session$destroy("mod1") + expect_equal(session$getBookmarkExclude(), before) +}) + +test_that("MockShinySession$close() invokes destroy callbacks", { + session <- MockShinySession$new() + called <- FALSE + session$onDestroy(function() called <<- TRUE) + session$close() + expect_true(called) +}) + +test_that("MockShinySession$close() fires destroy callbacks deepest-first", { + session <- MockShinySession$new() + parent <- session$makeScope("parent") + child <- parent$makeScope("child") + + order <- character(0) + session$onDestroy(function() order <<- c(order, "root")) + parent$onDestroy(function() order <<- c(order, "parent")) + child$onDestroy(function() order <<- c(order, "child")) + + session$close() + expect_equal(order, c("child", "parent", "root")) +}) + +test_that("MockShinySession destroy cleans up namespaced inputs", { + session <- MockShinySession$new() + scope <- session$makeScope("mymod") + + session$setInputs(`mymod-x` = 1, `mymod-y` = 2, other = 3) + flushReact() + + scope$destroy() + flushReact() + + expect_equal(isolate(session$input$other), 3) + expect_null(isolate(session$input$`mymod-x`)) + expect_null(isolate(session$input$`mymod-y`)) +}) + +test_that("root onDestroy callbacks fire after module callbacks during close", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + order <- character(0) + session$onDestroy(function() order <<- c(order, "root")) + scope$onDestroy(function() order <<- c(order, "mod1")) + + session$close() + expect_equal(order, c("mod1", "root")) +}) + +test_that("session proxy onDestroy registers and fires on destroy", { + session <- MockShinySession$new() + scope <- session$makeScope("mymod") + + called <- FALSE + scope$onDestroy(function() called <<- TRUE) + + expect_false(called) + scope$destroy() + expect_true(called) +}) + +test_that("session proxy destroy() invokes callbacks", { + session <- MockShinySession$new() + scope <- session$makeScope("mymod") + + called <- FALSE + scope$onDestroy(function() called <<- TRUE) + + scope$destroy() + expect_true(called) +}) + +test_that("session proxy destroy() cleans up child namespaces", { + session <- MockShinySession$new() + scope <- session$makeScope("parent") + child <- scope$makeScope("child") + + parent_called <- FALSE + child_called <- FALSE + scope$onDestroy(function() parent_called <<- TRUE) + child$onDestroy(function() child_called <<- TRUE) + + scope$destroy() + expect_true(parent_called) + expect_true(child_called) +}) + +test_that("session proxy destroy() fires deepest-first", { + session <- MockShinySession$new() + scope <- session$makeScope("parent") + child <- scope$makeScope("child") + + order <- character(0) + scope$onDestroy(function() order <<- c(order, "parent")) + child$onDestroy(function() order <<- c(order, "child")) + + scope$destroy() + expect_equal(order, c("child", "parent")) +}) + +test_that("session proxy destroy() is idempotent", { + session <- MockShinySession$new() + scope <- session$makeScope("mymod") + + count <- 0L + scope$onDestroy(function() count <<- count + 1L) + + scope$destroy() + scope$destroy() + expect_equal(count, 1L) +}) + +test_that("full module destroy cleans up all reactive state", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + obs_val <- NULL + observer_ran <- 0L + + withReactiveDomain(scope, { + rv <- reactiveVal(10) + r <- reactive({ rv() * 2 }) + obs <- observe({ + observer_ran <<- observer_ran + 1L + obs_val <<- r() + }) + }) + flushReact() + + expect_equal(observer_ran, 1L) + expect_equal(obs_val, 20) + + # Destroy the module scope + scope$destroy() + flushReact() + + # Observer should not run again + expect_equal(observer_ran, 1L) + + # Accessing destroyed reactives should error + rv_impl <- attr(rv, ".impl") + expect_error(rv_impl$get(), class = "shiny.destroyed.error") + + o <- attr(r, "observable") + expect_error(isolate(o$getValue()), class = "shiny.destroyed.error") +}) + +test_that("destroy then re-create module works cleanly", { + session <- MockShinySession$new() + + # First instance + scope1 <- session$makeScope("mod1") + val1 <- NULL + withReactiveDomain(scope1, { + rv1 <- reactiveVal(1) + observe({ val1 <<- rv1() }) + }) + flushReact() + expect_equal(val1, 1) + + # Destroy first instance + scope1$destroy() + flushReact() + + # Second instance with same namespace + scope2 <- session$makeScope("mod1") + val2 <- NULL + withReactiveDomain(scope2, { + rv2 <- reactiveVal(99) + observe({ val2 <<- rv2() }) + }) + flushReact() + expect_equal(val2, 99) +}) + +test_that("nested module destroy cleans up grandchild scopes", { + session <- MockShinySession$new() + parent <- session$makeScope("parent") + child <- parent$makeScope("child") + grandchild <- child$makeScope("gc") + + order <- character(0) + parent$onDestroy(function() order <<- c(order, "parent")) + child$onDestroy(function() order <<- c(order, "child")) + grandchild$onDestroy(function() order <<- c(order, "grandchild")) + + parent$destroy() + + # Deepest-first ordering + expect_equal(order, c("grandchild", "child", "parent")) +}) + +test_that("invalidateLater timer is cancelled on module destroy", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + count <- 0L + withReactiveDomain(scope, { + observe({ + invalidateLater(100) + count <<- count + 1L + }) + }) + session$elapse(0) + flushReact() + expect_equal(count, 1L) + + # Timer should fire if we elapse enough time + session$elapse(100) + flushReact() + expect_equal(count, 2L) + + # Destroy the module scope — timer should be cancelled + scope$destroy() + flushReact() + + # Elapsing time should NOT cause the observer to run again + session$elapse(200) + flushReact() + expect_equal(count, 2L) +}) + +test_that("invalidateLater cleans up onEnded registration after module destroy", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + withReactiveDomain(scope, { + observe({ + invalidateLater(100) + }) + }) + session$elapse(0) + flushReact() + + # Destroy the module — should deregister onEnded callback + scope$destroy() + flushReact() + + # Session close should not error (stale callbacks already cleaned up) + expect_no_error(session$close()) +}) + +test_that("invalidateLater cleans up onDestroy registration after timer fires", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + withReactiveDomain(scope, { + observe({ + invalidateLater(100) + }) + }) + session$elapse(0) + flushReact() + + # Let the timer fire naturally — should deregister onDestroy callback + session$elapse(200) + flushReact() + + # Destroying after timer already fired should not error + expect_no_error(scope$destroy()) +}) + +test_that("invalidateLater cleans up onDestroy registration on session close", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + withReactiveDomain(scope, { + observe({ + invalidateLater(100) + }) + }) + session$elapse(0) + flushReact() + + # Closing the full session should clean up everything without error + expect_no_error(session$close()) +}) + +test_that("invalidateLater timer is cancelled on root session close", { + session <- MockShinySession$new() + + count <- 0L + withReactiveDomain(session, { + observe({ + invalidateLater(100) + count <<- count + 1L + }) + }) + session$elapse(0) + flushReact() + expect_equal(count, 1L) + + # Timer fires normally before close + session$elapse(100) + flushReact() + expect_equal(count, 2L) + + # Close the root session — timer should be cancelled via onEnded + session$close() + flushReact() + + session$elapse(200) + flushReact() + expect_equal(count, 2L) +}) + +test_that("invalidateLater cleans up both registrations on root session close", { + session <- MockShinySession$new() + + withReactiveDomain(session, { + observe({ + invalidateLater(100) + }) + }) + session$elapse(0) + flushReact() + + # Closing the root session fires onEnded and then onDestroy; + # both registrations should be cleaned up without error + expect_no_error(session$close()) +}) + +test_that("invalidateLater cleans up onDestroy after timer fires on root session", { + session <- MockShinySession$new() + + withReactiveDomain(session, { + observe({ + invalidateLater(100) + }) + }) + session$elapse(0) + flushReact() + + # Let timer fire naturally — clears both onEnded and onDestroy + session$elapse(200) + flushReact() + + # Closing the session after timer already fired should not error + expect_no_error(session$close()) +}) + +test_that("module scope bookmark-exclude is cleaned up on destroy", { + session <- MockShinySession$new() + scope <- session$makeScope("mod1") + + scope$setBookmarkExclude(c("a", "b")) + + # Root session should see the module's excludes (namespaced) + expect_true("mod1-a" %in% session$getBookmarkExclude()) + expect_true("mod1-b" %in% session$getBookmarkExclude()) + + scope$destroy() + + # After destroy, module's excludes should be gone + expect_false("mod1-a" %in% session$getBookmarkExclude()) + expect_false("mod1-b" %in% session$getBookmarkExclude()) +}) + +test_that("multiple module scopes have independent bookmark-exclude cleanup", { + session <- MockShinySession$new() + scope1 <- session$makeScope("mod1") + scope2 <- session$makeScope("mod2") + + scope1$setBookmarkExclude("x") + scope2$setBookmarkExclude("y") + + expect_true("mod1-x" %in% session$getBookmarkExclude()) + expect_true("mod2-y" %in% session$getBookmarkExclude()) + + # Destroy only mod1 + scope1$destroy() + + expect_false("mod1-x" %in% session$getBookmarkExclude()) + expect_true("mod2-y" %in% session$getBookmarkExclude()) + + # Destroy mod2 + scope2$destroy() + expect_false("mod2-y" %in% session$getBookmarkExclude()) +}) + +test_that("root setBookmarkExclude persists after module destroy", { + session <- MockShinySession$new() + session$setBookmarkExclude(c("global_input")) + + scope <- session$makeScope("mod1") + scope$setBookmarkExclude("a") + + expect_true("global_input" %in% session$getBookmarkExclude()) + expect_true("mod1-a" %in% session$getBookmarkExclude()) + + scope$destroy() + + # Root excludes should still be there + expect_true("global_input" %in% session$getBookmarkExclude()) + expect_false("mod1-a" %in% session$getBookmarkExclude()) +}) + +test_that("makeScope rejects reserved namespace '..root'", { + session <- MockShinySession$new() + expect_error(session$makeScope("..root"), "reserved") +}) + +test_that("createMockDomain supports onDestroy and destroy", { + domain <- createMockDomain() + + called <- FALSE + domain$onDestroy(function() called <<- TRUE) + + expect_false(called) + domain$destroy() + expect_true(called) +}) + +test_that("createMockDomain destroy is idempotent", { + domain <- createMockDomain() + + count <- 0L + domain$onDestroy(function() count <<- count + 1L) + + domain$destroy() + domain$destroy() + expect_equal(count, 1L) +}) diff --git a/tests/testthat/test-mock-session.R b/tests/testthat/test-mock-session.R index 107a9049c..d43d759b3 100644 --- a/tests/testthat/test-mock-session.R +++ b/tests/testthat/test-mock-session.R @@ -250,18 +250,11 @@ test_that("session supports sendInputMessage", { expect_true(TRUE) # testthat insists that every test must have an expectation }) -test_that("session supports setBookmarkExclude", { +test_that("session supports setBookmarkExclude and getBookmarkExclude", { session <- MockShinySession$new() - withr::with_options(list("shiny.mocksession.warn" = TRUE), { - expect_warning(session$setBookmarkExclude(names=1)) - }) -}) - -test_that("session supports getBookmarkExclude", { - session <- MockShinySession$new() - withr::with_options(list("shiny.mocksession.warn" = TRUE), { - expect_warning(session$getBookmarkExclude()) - }) + expect_equal(session$getBookmarkExclude(), character(0)) + session$setBookmarkExclude(c("x", "y")) + expect_equal(session$getBookmarkExclude(), c("x", "y")) }) test_that("session supports onBookmark", { diff --git a/tests/testthat/test-test-server.R b/tests/testthat/test-test-server.R index 20db048e2..5523a9034 100644 --- a/tests/testthat/test-test-server.R +++ b/tests/testthat/test-test-server.R @@ -491,20 +491,21 @@ test_that("session ended handlers work", { server <- function(input, output, session){} testServer(server, { - rv <- reactiveValues(closed = FALSE) + state <- new.env(parent = emptyenv()) + state$closed <- FALSE session$onEnded(function(){ - rv$closed <- TRUE + state$closed <- TRUE }) expect_equal(session$isEnded(), FALSE) expect_equal(session$isClosed(), FALSE) - expect_false(rv$closed) + expect_false(state$closed) session$close() expect_equal(session$isEnded(), TRUE) expect_equal(session$isClosed(), TRUE) - expect_true(rv$closed) + expect_true(state$closed) }) })