moduleServer testing

R/mock-session.R

@@ -80,7 +80,6 @@ extract <- function(promise) {
 MockShinySession <- R6Class(
   'MockShinySession',
   portable = FALSE,
-  class = FALSE,
   public = list(
     #' @field env The environment associated with the session.
     env = NULL,
@@ -101,7 +100,8 @@ MockShinySession <- R6Class(
     userData = NULL,
     #' @field progressStack A stack of progress objects
     progressStack = 'Stack',
-
+    #' @field TRUE when a moduleServer()-based module is under test
+    isModuleServer = FALSE,
     #' @description Create a new MockShinySession
     initialize = function() {
       private$.input <- ReactiveValues$new(dedupe = FALSE, label = "input")

R/modules.R

@@ -121,23 +121,40 @@ createSessionProxy <- function(parentSession, ...) {
 #'
 #' @export
 moduleServer <- function(id, module, session = getDefaultReactiveDomain()) {
+  if (inherits(session, c("MockShinySession"))) session$isModuleServer <- TRUE
   callModule(module, id, session = session)
 }
 
-
 #' @rdname moduleServer
 #' @export
 callModule <- function(module, id, ..., session = getDefaultReactiveDomain()) {
-  if (!inherits(session, "ShinySession") && !inherits(session, "session_proxy")) {
-    stop("session must be a ShinySession or session_proxy object.")
+  if (!inherits(session, c("ShinySession", "MockShinySession", "session_proxy"))) {
+    stop("session must be a ShinySession, MockShinySession, or session_proxy object.")
   }
-  childScope <- session$makeScope(id)
-
-  withReactiveDomain(childScope, {
-    if (!is.function(module)) {
-      stop("module argument must be a function")
-    }
 
-    module(childScope$input, childScope$output, childScope, ...)
-  })
+  if (inherits(session, "MockShinySession") && session$isModuleServer) {
+    # If the module is under test *and* was called by moduleServer(), modify the
+    # module function locally by inserting the equivalent of `session$env <-
+    # environment()` at the beginning of its body. A similar operation is
+    # performed by .testModule() if the module is *not* called through
+    # moduleServer() but is under test. See .testModule() for details.
+    body(module) <- rlang::expr({
+      base::assign("env", base::environment(), envir = !!session)
+      !!!body(module)
+    })
+    isolate(
+      withReactiveDomain(
+        session,
+        withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
+          session$returned <- module(session$input, session$output, session, ...)
+        })
+      )
+    )
+  } else {
+    childScope <- session$makeScope(id)
+    withReactiveDomain(childScope, {
+      if (!is.function(module)) stop("module argument must be a function")
+      module(childScope$input, childScope$output, childScope, ...)
+    })
+  }
 }

R/test-module.R

@@ -64,33 +64,55 @@ testModule <- function(module, expr, ...) {
   )
 }
 
+isOldModule <- function(func) {
+  stopifnot(is.function(func))
+  required <- c("input", "output", "session")
+  declared <- names(formals(func))
+  setequal(required, intersect(required, declared))
+}
+
 #' @noRd
-#' @importFrom withr with_options
 .testModule <- function(module, quosure, dots, env) {
-  # Modify the module function locally by inserting `session$env <-
-  # environment()` at the beginning of its body. The dynamic environment of the
-  # module function is saved so that it may be referenced after the module
-  # function has returned. The saved dynamic environment is the basis for the
-  # `data` argument of tidy_eval() when used below to evaluate `quosure`, the
-  # test code expression.
-  body(module) <- rlang::expr({
-    session$env <- base::environment()
-    !!!body(module)
-  })
-
   session <- MockShinySession$new()
   on.exit(if (!session$isClosed()) session$close())
-  args <- append(dots, list(input = session$input, output = session$output, session = session))
 
-  isolate(
-    withReactiveDomain(
-      session,
-      withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
-        # Assigning to `$returned` causes a flush to happen automatically.
-        session$returned <- do.call(module, args)
-      })
+  if (isOldModule(module)) {
+    # If the module is an "old-style" module that accepts input, output, and
+    # session parameters, modify the function locally by inserting `session$env
+    # <- environment()` at the beginning of its body. The dynamic environment of
+    # the module function is saved so that it may be referenced after the module
+    # function has returned. The saved dynamic environment is the basis for the
+    # `data` argument of tidy_eval() when used below to evaluate `quosure`.
+    body(module) <- rlang::expr({
+      session$env <- base::environment()
+      !!!body(module)
+    })
+    args <- append(dots, list(input = session$input, output = session$output, session = session))
+    isolate(
+      withReactiveDomain(
+        session,
+        withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
+          # Assigning to `$returned` causes a flush to happen automatically.
+          session$returned <- do.call(module, args)
+        })
+      )
     )
-  )
+  } else {
+    # If the module is a "new-style" module, we rely on logic in callModule()
+    # that instruments the function if the session is a MockShinySession.
+    # Appending additional arguments is not necessary, as input/output/session
+    # will be provided in moduleServer(). `id` is also provided via
+    # moduleServer().
+    isolate(
+      withReactiveDomain(
+        session,
+        withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
+          # TODO Implement session$returned for new style modules
+          do.call(module, dots)
+        })
+      )
+    )
+  }
 
   # Evaluate `quosure` in a reactive context, and in the provided `env`, but
   # with `env` masked by a shallow view of `session$env`, the environment that

inst/_pkgdown.yml

@@ -207,7 +207,7 @@ reference:
     desc: Functions for modularizing Shiny apps
     contents:
       - NS
-      - callModule
+      - moduleServer
   - title: Embedding
     desc: Functions that are intended for third-party packages that embed Shiny applications.
     contents:

tests/testthat/test-test-moduleServer.R

@@ -0,0 +1,23 @@
+context("testModule-moduleServer")
+
+test_that("New-style modules work", {
+  counterServer <- local({
+    function(id) {
+      moduleServer(id, function(input, output, session) {
+        count <- reactiveVal(0)
+        observeEvent(input$button, {
+          count(count() + 1)
+        })
+        output$out <- renderText({
+          count()
+        })
+        count
+      })
+    }
+  })
+  testModule(counterServer, {
+    input$setInputs(button = 0)
+    input$setInputs(button = 1)
+    expect_equal(count(), 1)
+  }, id = "foob")
+})