testServer(): Properly capture module return values

NEWS.md

@@ -7,7 +7,7 @@ shiny 1.4.0.9001
 
 ### New features
 
-* The new `shinyAppTemplate()` function creates a new template Shiny application, where components are optional, such as helper files in an R/ subdirectory, a module, and various kids of tests. ([#2704](https://github.com/rstudio/shiny/pull/2704))
+* The new `shinyAppTemplate()` function creates a new template Shiny application, where components are optional, such as helper files in an R/ subdirectory, a module, and various kinds of tests. ([#2704](https://github.com/rstudio/shiny/pull/2704))
 
 * `runTests()` is a new function that behaves much like R CMD check. `runTests()` invokes all of the top-level R files in the tests/ directory inside an application, in that application's environment. ([#2585](https://github.com/rstudio/shiny/pull/2585))
 

R/app.R

@@ -238,8 +238,13 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
   }
   onStop <- function() {
     setwd(oldwd)
-    monitorHandle()
-    monitorHandle <<- NULL
+    # It is possible that while calling appObj()$onStart() or loadingSupport, an error occured
+    # This will cause `onStop` to be called.
+    #   The `oldwd` will exist, but `monitorHandle` is not a function yet.
+    if (is.function(monitorHandle)) {
+      monitorHandle()
+      monitorHandle <<- NULL
+    }
   }
 
   structure(
@@ -447,8 +452,13 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
   }
   onStop <- function() {
     setwd(oldwd)
-    monitorHandle()
-    monitorHandle <<- NULL
+    # It is possible that while calling appObj()$onStart() or loadingSupport, an error occured
+    # This will cause `onStop` to be called.
+    #   The `oldwd` will exist, but `monitorHandle` is not a function yet.
+    if (is.function(monitorHandle)) {
+      monitorHandle()
+      monitorHandle <<- NULL
+    }
   }
 
   structure(

R/app_template.R

@@ -55,8 +55,8 @@
 #'   prompt the user to select which template items will be added to the new app
 #'   directory. With "all", all template items will be added to the app
 #'   directory.
-#' @param dryrun If `TRUE`, don't actually write any files; just print out what
-#'   would be written.
+#' @param dryrun If `TRUE`, don't actually write any files; just print out which
+#'   files would be written.
 #'
 #' @export
 shinyAppTemplate <- function(path = NULL, examples = "default", dryrun = FALSE)

R/modules.R

@@ -134,10 +134,12 @@ moduleServer <- function(id, module, session = getDefaultReactiveDomain()) {
   if (inherits(session, "MockShinySession")) {
     body(module) <- rlang::expr({
       session$setEnv(base::environment())
-      session$setReturned({ !!!body(module) })
+      !!body(module)
     })
+    session$setReturned(callModule(module, id, session = session))
+  } else {
+    callModule(module, id, session = session)
   }
-  callModule(module, id, session = session)
 }
 
 

R/test-server.R

@@ -18,10 +18,9 @@ isModuleServer <- function(x) {
 #'   in the server function environment, meaning that the parameters of the
 #'   server function (e.g. `input`, `output`, and `session`) will be available
 #'   along with any other values created inside of the server function.
-#' @param ... Additional arguments to pass to the module function. These
-#'   arguments are processed with [rlang::list2()] and so are
-#'   _[dynamic][rlang::dyn-dots]_. If `app` is a module, and no `id` argument is
-#'   provided, one will be generated and supplied automatically.
+#' @param args Additional arguments to pass to the module function.
+#'   If `app` is a module, and no `id` argument is provided, one will be
+#'   generated and supplied automatically.
 #' @return The result of evaluating `expr`.
 #' @include mock-session.R
 #' @rdname testServer
@@ -37,7 +36,7 @@ isModuleServer <- function(x) {
 #'   })
 #' }
 #'
-#' testServer(server, {
+#' testServer(server, args = list(multiplier = 2), {
 #'   session$setInputs(x = 1)
 #'   # You're also free to use third-party
 #'   # testing packages like testthat:
@@ -49,14 +48,13 @@ isModuleServer <- function(x) {
 #'   stopifnot(myreactive() == 4)
 #'   stopifnot(output$txt == "I am 4")
 #'   # Any additional arguments, below, are passed along to the module.
-#' }, multiplier = 2)
+#' })
 #' @export
-testServer <- function(app = NULL, expr, ...) {
+testServer <- function(app = NULL, expr, args = list()) {
 
   require(shiny)
 
   quosure <- rlang::enquo(expr)
-  args <- rlang::list2(...)
   session <- getDefaultReactiveDomain()
 
   if (inherits(session, "MockShinySession"))
@@ -142,4 +140,6 @@ testServer <- function(app = NULL, expr, ...) {
       )
     )
   }
+
+  invisible()
 }

inst/app_template/tests/testthat.R

@@ -3,7 +3,7 @@ library(testthat)
 test_dir(
   "./testthat",
   # Run in the app's environment containing all support methods.
-  env = shiny::loadSupport("../"),
+  env = shiny::loadSupport(),
   # Display the regular progress output and throw an error if any test error is found
   reporter = c("progress", "fail")
 )

man/shinyAppTemplate.Rd

@@ -17,8 +17,8 @@ prompt the user to select which template items will be added to the new app
 directory. With "all", all template items will be added to the app
 directory.}
 
-\item{dryrun}{If \code{TRUE}, don't actually write any files; just print out what
-would be written.}
+\item{dryrun}{If \code{TRUE}, don't actually write any files; just print out which
+files would be written.}
 }
 \description{
 This function populates a directory with files for a Shiny application.

man/testServer.Rd

@@ -4,7 +4,7 @@
 \alias{testServer}
 \title{Reactive testing for Shiny server functions and modules}
 \usage{
-testServer(app = NULL, expr, ...)
+testServer(app = NULL, expr, args = list())
 }
 \arguments{
 \item{app}{The path to an application or module to test. In addition to
@@ -19,10 +19,9 @@ in the server function environment, meaning that the parameters of the
 server function (e.g. \code{input}, \code{output}, and \code{session}) will be available
 along with any other values created inside of the server function.}
 
-\item{...}{Additional arguments to pass to the module function. These
-arguments are processed with \code{\link[rlang:list2]{rlang::list2()}} and so are
-\emph{\link[rlang:dyn-dots]{dynamic}}. If \code{app} is a module, and no \code{id} argument is
-provided, one will be generated and supplied automatically.}
+\item{args}{Additional arguments to pass to the module function.
+If \code{app} is a module, and no \code{id} argument is provided, one will be
+generated and supplied automatically.}
 }
 \value{
 The result of evaluating \code{expr}.
@@ -44,7 +43,7 @@ server <- function(id, multiplier = 2, prefix = "I am ") {
   })
 }
 
-testServer(server, {
+testServer(server, args = list(multiplier = 2), {
   session$setInputs(x = 1)
   # You're also free to use third-party
   # testing packages like testthat:
@@ -56,5 +55,5 @@ testServer(server, {
   stopifnot(myreactive() == 4)
   stopifnot(output$txt == "I am 4")
   # Any additional arguments, below, are passed along to the module.
-}, multiplier = 2)
+})
 }

tests/test-helpers/app1-standard/tests/runner2.R

@@ -2,7 +2,7 @@
 
 
 withr::with_environment(
-  shiny::loadSupport("../"),
+  shiny::loadSupport(),
   {
     runner2_B <- 2
 

tests/test-modules/107_scatterplot/tests/testthat.R

@@ -2,6 +2,6 @@ library(testthat)
 
 test_dir(
   "./testthat",
-  env = shiny::loadSupport("../"),
+  env = shiny::loadSupport(),
   reporter = c("progress", "fail")
 )

tests/test-modules/107_scatterplot/tests/testthat/test-linked-scatterplot-module.R

@@ -3,9 +3,11 @@ context("linkedScatterServer")
 
 testServer(
   linkedScatterServer,
-  data = reactive(ggplot2::mpg),
-  left = reactive(c("cty", "hwy")),
-  right = reactive(c("drv", "hwy")),
+  args = list(
+    data = reactive(ggplot2::mpg),
+    left = reactive(c("cty", "hwy")),
+    right = reactive(c("drv", "hwy"))
+  ),
   {
 
     # Init count... 0

tests/test-modules/12_counter/tests/testthat.R

@@ -5,6 +5,6 @@ library(testthat)
 # the supporting files that were already loaded into that env.
 testthat::test_dir(
   "./testthat",
-  env = shiny::loadSupport("../"),
+  env = shiny::loadSupport(),
   reporter = c("summary", "fail")
 )

tests/testthat/test-test-server-app.R

@@ -104,5 +104,5 @@ test_that("a Shiny app object with a module inside can be tested", {
 })
 
 test_that("It's an error to pass arguments to a server", {
-  expect_error(testServer(test_path("..", "test-modules", "06_tabsets"), {}, an_arg = 123))
+  expect_error(testServer(test_path("..", "test-modules", "06_tabsets"), {}, args = list(an_arg = 123)))
 })

tests/testthat/test-test-server-nesting.R

@@ -17,9 +17,9 @@ test_that("Nested modules", {
     })
   }
 
-  testServer(parent, {
+  testServer(parent, args = list(id = "parent-id"), {
     expect_equal(output$txt, "foo")
-  }, id = "parent-id")
+  })
 
 })
 
@@ -30,9 +30,9 @@ test_that("Lack of ID", {
     })
   }
 
-  testServer(module, {
+  testServer(module, args = list(id = "foo"), {
     expect_equal(output$txt, "foo-x")
-  }, id = "foo")
+  })
 })
 
 test_that("testServer works with nested module servers", {
@@ -50,10 +50,10 @@ test_that("testServer works with nested module servers", {
     })
   }
 
-  testServer(outerModule, {
+  testServer(outerModule, args = list(id = "foo"), {
     session$setInputs(x = 1)
     expect_equal(output$someVar, "a value: 2")
-  }, id = "foo")
+  })
 })
 
 test_that("testServer calls do not nest in module functions", {

tests/testthat/test-test-server-scope.R

@@ -14,12 +14,12 @@ test_that("Variables outside of the module are inaccessible", {
     }
   }, envir = new.env(parent = globalenv()))
 
-  testServer(module, {
+  testServer(module, args = list(x = 0), {
     expect_equal(x, 0)
     expect_equal(y, 1)
     expect_equal(z, 2)
     expect_equal(exists("outside"), FALSE)
-  }, x = 0)
+  })
 })
 
 test_that("Variables outside the testServer() have correct visibility", {
@@ -34,11 +34,11 @@ test_that("Variables outside the testServer() have correct visibility", {
   x <- 99
   z <- 123
 
-  testServer(module, {
+  testServer(module, args = list(x = 0), {
     expect_equal(x, 0)
     expect_equal(y, 1)
     expect_equal(z, 123)
-  }, x = 0)
+  })
 })
 
 test_that("testServer allows lexical environment access through session$env", {

tests/testthat/test-test-server.R

@@ -11,24 +11,7 @@ test_that("testServer passes dots", {
       expect_equal(someArg, 123)
     })
   }
-  testServer(module, {}, someArg = 123)
-})
-
-test_that("testServer passes dynamic dots", {
-  module <- function(id, someArg) {
-    expect_false(missing(someArg))
-    moduleServer(id, function(input, output, session) {
-      expect_equal(someArg, 123)
-    })
-  }
-
-  # Test with !!! to splice in a whole named list constructed with base::list()
-  moreArgs <- list(someArg = 123)
-  testServer(module, {}, !!!moreArgs)
-
-  # Test with !!/:= to splice in an argument name
-  argName <- "someArg"
-  testServer(module, {}, !!argName := 123)
+  testServer(module, {}, args = list(someArg = 123))
 })
 
 test_that("testServer handles observers", {
@@ -414,7 +397,7 @@ test_that("testServer handles modules with additional arguments", {
   testServer(module, {
     expect_equal(output$txt1, "val1")
     expect_equal(output$txt2, "val2")
-  }, arg1="val1", arg2="val2")
+  }, list(arg1="val1", arg2="val2"))
 })
 
 test_that("testServer captures htmlwidgets", {
@@ -565,25 +548,13 @@ test_that("accessing a non-existent output gives an informative message", {
 
   testServer(module, {
     expect_error(output$dontexist, "hasn't been defined yet: output\\$server1-dontexist")
-  }, id = "server1")
+  }, list(id = "server1"))
 
   testServer(module, {
     expect_error(output$dontexist, "hasn't been defined yet: output\\$.*-dontexist")
   })
 })
 
-test_that("testServer returns a meaningful result", {
-  result <- testServer(function(id) {
-    moduleServer(id, function(input, output, session) {
-      reactive({ input$x * 2 })
-    })
-  }, {
-    session$setInputs(x = 2)
-    session$getReturned()()
-  })
-  expect_equal(result, 4)
-})
-
 test_that("assigning an output in a module function with a non-function errors", {
   module <- function(id) {
     moduleServer(id, function(input, output, session) {
@@ -680,3 +651,42 @@ test_that("session flush handlers work", {
 
   })
 })
+
+test_that("module return value captured", {
+  module_implicit_return <- function(id) {
+    moduleServer(id, function(input, output, session) {
+      123
+    })
+  }
+
+  testServer(module_implicit_return, {
+    expect_equal(session$returned, 123)
+  })
+
+  module_early_returns <- function(id, n) {
+    retval <<- NULL
+    moduleServer(id, function(input, output, session) {
+      if (n == 0) return(n)
+      if (n %% 2 == 0) {
+        retval <<- "even"
+      } else {
+        return(FALSE)
+      }
+      retval
+    })
+  }
+
+  testServer(module_early_returns, {
+    expect_equal(session$returned, 0)
+  }, args = list(n = 0))
+
+  testServer(module_early_returns, {
+    expect_equal(session$returned, FALSE)
+  }, args = list(n = 1))
+
+  testServer(module_early_returns, {
+    expect_equal(session$returned, "even")
+  }, args = list(n = 2))
+})
+
+#test_that("server return value captured", {})