WIP loadSuppor for apps passed to testServer

R/mock-session.R

@@ -402,12 +402,18 @@ MockShinySession <- R6Class(
         setInputs = function(...) do.call(self$setInputs, mapNames(ns, ...))
       )
     },
-    #' @description Set the environment associated with a testServer() call.
+    #' @description Set the environment associated with a testServer() call, but
+    #'   only if it has not previously been set. This ensures that only the
+    #'   environment of the outermost module under test is the one retained. In
+    #'   other words, the first assignment wins.
     #' @param env The environment to retain.
     setEnv = function(env) {
-      self$env <- env
+      if (is.null(self$env)) self$env <- env
     },
-    #' @description Set the value returned by the module call and proactively flush.
+    #' @description Set the value returned by the module call and proactively
+    #'   flush. Note that this method may be called multiple times if modules
+    #'   are nested. The last assignment, corresponding to an invocation of
+    #'   setReturned() in the outermost module, wins.
     #' @param value The value returned from the module
     setReturned = function(value) {
       self$returned <- value

R/test-server.R

@@ -84,6 +84,11 @@ testServer <- function(app, expr, ...) {
     server <- appobj$serverFuncSource()
     if (! "session" %in% names(formals(server)))
       stop("Tested application server functions must declare input, output, and session arguments.")
+    appEnv <- new.env(parent = rlang::caller_env())
+    if (is.character(app)) {
+      loadSupport(app, appEnv, appEnv)
+      environment(server) <- appEnv
+    }
     body(server) <- rlang::expr({
       session$setEnv(base::environment())
       !!!body(server)

man/MockShinySession.Rd

@@ -675,7 +675,10 @@ Create and return a namespace-specific session proxy.
 \if{html}{\out{<a id="method-setEnv"></a>}}
 \if{latex}{\out{\hypertarget{method-setEnv}{}}}
 \subsection{Method \code{setEnv()}}{
-Set the environment associated with a testServer() call.
+Set the environment associated with a testServer() call, but
+only if it has not previously been set. This ensures that only the
+environment of the outermost module under test is the one retained. In
+other words, the first assignment wins.
 \subsection{Usage}{
 \if{html}{\out{<div class="r">}}\preformatted{MockShinySession$setEnv(env)}\if{html}{\out{</div>}}
 }
@@ -692,7 +695,10 @@ Set the environment associated with a testServer() call.
 \if{html}{\out{<a id="method-setReturned"></a>}}
 \if{latex}{\out{\hypertarget{method-setReturned}{}}}
 \subsection{Method \code{setReturned()}}{
-Set the value returned by the module call and proactively flush.
+Set the value returned by the module call and proactively
+flush. Note that this method may be called multiple times if modules
+are nested. The last assignment, corresponding to an invocation of
+setReturned() in the outermost module, wins.
 \subsection{Usage}{
 \if{html}{\out{<div class="r">}}\preformatted{MockShinySession$setReturned(value)}\if{html}{\out{</div>}}
 }

man/markdown.Rd

@@ -4,29 +4,34 @@
 \alias{markdown}
 \title{Insert inline Markdown}
 \usage{
-markdown(mds, extensions = TRUE, ...)
+markdown(mds, extensions = TRUE, .noWS = NULL, ...)
 }
 \arguments{
 \item{mds}{A character vector of Markdown source to convert to HTML. If the
-vector has more than one element, resulting HTML is concatenated.}
+vector has more than one element, a single-element character vector of
+concatenated HTML is returned.}
 
-\item{extensions}{Enable Github syntax extensions, defaults to \code{TRUE}.}
+\item{extensions}{Enable Github syntax extensions; defaults to \code{TRUE}.}
+
+\item{.noWS}{Character vector used to omit some of the whitespace that would
+normally be written around generated HTML. Valid options include \code{before},
+\code{after}, and \code{outside} (equivalent to \code{before} and \code{end}).}
 
 \item{...}{Additional arguments to pass to \code{\link[commonmark:markdown_html]{commonmark::markdown_html()}}.
 These arguments are \emph{\link[rlang:dyn-dots]{dynamic}}.}
 }
 \value{
-an \code{html}-classed character vector of rendered HTML
+a character vector marked as HTML.
 }
 \description{
-This function accepts a character vector of
-\href{https://en.wikipedia.org/wiki/Markdown}{Markdown}-syntax text and renders
-it to HTML that may be included in a UI.
+This function accepts
+\href{https://en.wikipedia.org/wiki/Markdown}{Markdown}-syntax text and returns
+HTML that may be included in Shiny UIs.
 }
 \details{
-Prior to interpretation as Markdown, leading whitespace is trimmed from text
-with \code{\link[glue:trim]{glue::trim()}}. This makes it possible to insert Markdown and for it to
-be processed correctly even when the call to \code{markdown()} is indented.
+Leading whitespace is trimmed from Markdown text with \code{\link[glue:trim]{glue::trim()}}.
+Whitespace trimming ensures Markdown is processed correctly even when the
+call to \code{markdown()} is indented within surrounding R code.
 
 By default, \link[commonmark:extensions]{Github extensions} are enabled, but this
 can be disabled by passing \code{extensions = FALSE}.

tests/test-modules/12_counter/R/my-module.R

@@ -0,0 +1,23 @@
+mymoduleUI <- function(id, label = "Counter") {
+  ns <- NS(id)
+  tagList(
+    actionButton(ns("button"), label = label),
+    verbatimTextOutput(ns("out"))
+  )
+}
+
+mymoduleServer <- function(id) {
+  moduleServer(
+    id,
+    function(input, output, session) {
+      count <- reactiveVal(0)
+      observeEvent(input$button, {
+        count(count() + 1)
+      })
+      output$out <- renderText({
+        count()
+      })
+      count
+    }
+  )
+}

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

@@ -0,0 +1,5 @@
+# Given a numeric vector, convert to strings, sort, and convert back to
+# numeric.
+lexical_sort <- function(x) {
+  as.numeric(sort(as.character(x)))
+}

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

@@ -0,0 +1,30 @@
+ui <- fluidPage(
+  # ======== Modules ========
+  # mymoduleUI is defined in R/my-module.R
+  mymoduleUI("mymodule1", "Click counter #1"),
+  mymoduleUI("mymodule2", "Click counter #2"),
+  # =========================
+  wellPanel(
+    sliderInput("size", "Data size", min = 5, max = 20, value = 10),
+    div("Lexically sorted sequence:"),
+    verbatimTextOutput("sequence")
+  )
+)
+
+server <- function(input, output, session) {
+  # ======== Modules ========
+  # mymoduleServer is defined in R/my-module.R
+  mymoduleServer("mymodule1")
+  mymoduleServer("mymodule2")
+  # =========================
+
+  data <- reactive({
+    # lexical_sort from R/utils.R
+    lexical_sort(seq_len(input$size))
+  })
+  output$sequence <- renderText({
+    paste(data(), collapse = " ")
+  })
+}
+
+shinyApp(ui, server)

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

@@ -0,0 +1,11 @@
+library(testthat)
+
+# Run in the "current" environment, because shiny::runTests() is going to
+# provision a new environment that's just for our test. And we'll want access to
+# the supporting files that were already loaded into that env.
+testthat::test_dir(
+  "./testthat",
+  reporter = SummaryReporter,
+  env = environment(),
+  stop_on_failure = TRUE
+)

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

@@ -0,0 +1,18 @@
+# Use testthat just for expectations
+library(testthat)
+
+testServer(mymoduleServer, {
+  # Set initial value of a button
+  session$setInputs(button = 0)
+
+  # Check the value of the reactiveVal `count()`
+  expect_equal(count(), 1)
+  # Check the value of the renderText()
+  expect_equal(output$out, "1")
+
+  # Simulate a click
+  session$setInputs(button = 1)
+
+  expect_equal(count(), 2)
+  expect_equal(output$out, "2")
+})

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

@@ -0,0 +1,11 @@
+# Use testthat just for expectations
+library(testthat)
+
+testServer('../..', {
+  # Set the `size` slider and check the output
+  session$setInputs(size = 6)
+  expect_equal(output$sequence, "1 2 3 4 5 6")
+
+  session$setInputs(size = 12)
+  expect_equal(output$sequence, paste0(lexical_sort(1:12), collapse = " "))
+})

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

@@ -0,0 +1,5 @@
+# Test the lexical_sort function from R/utils.R
+test_that("Lexical sorting works", {
+  expect_equal(lexical_sort(c(1, 2, 3)), c(1, 2, 3))
+  expect_equal(lexical_sort(c(1, 2, 3, 13, 11, 21)), c(1, 11, 13, 2, 21, 3))
+})

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

@@ -29,3 +29,55 @@ test_that("testServer works when referencing external globals", {
     expect_equal(get("global", session$env), 123)
   })
 })
+
+test_that("runApp works with a dir app that calls modules and uses testServer", {
+  app <- test_path("..", "test-modules", "12_counter")
+  run <- runTests(app)
+  expect_true(all(run$pass))
+})
+
+test_that("a Shiny app object with a module inside can be tested", {
+
+  counterUI <- function(id, label = "Counter") {
+    ns <- NS(id)
+    tagList(
+      actionButton(ns("button"), label = label),
+      verbatimTextOutput(ns("out"))
+    )
+  }
+
+  counterServer <- function(id) {
+    moduleServer(
+      id,
+      function(input, output, session) {
+        count <- reactiveVal(0)
+        observeEvent(input$button, {
+          count(count() + 1)
+        })
+        output$out <- renderText({
+          count()
+        })
+        count
+      }
+    )
+  }
+
+  ui <- fluidPage(
+    textInput("number", "A number"),
+    textOutput("numberDoubled"),
+    counterUI("counter1", "Counter #1"),
+    counterUI("counter2", "Counter #2")
+  )
+  server <- function(input, output, session) {
+    counterServer("counter1")
+    counterServer("counter2")
+    doubled <- reactive( { as.integer(input$number) * 2 })
+    output$numberDoubled <- renderText({ doubled() })
+  }
+  app <- shinyApp(ui, server)
+
+  testServer(app, {
+    session$setInputs(number = "42")
+    expect_equal(doubled(), 84)
+  })
+})