Merge remote-tracking branch 'origin/testServer-assign-env-once' into testserver-wip

DESCRIPTION

@@ -102,6 +102,7 @@ URL: http://shiny.rstudio.com
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:
     'app.R'
+    'app_template.R'
     'bookmark-state-local.R'
     'stack.R'
     'bookmark-state.R'

NAMESPACE

@@ -230,6 +230,7 @@ export(setSerializer)
 export(shinyApp)
 export(shinyAppDir)
 export(shinyAppFile)
+export(shinyAppTemplate)
 export(shinyOptions)
 export(shinyServer)
 export(shinyUI)
@@ -354,3 +355,4 @@ importFrom(htmltools,validateCssUnit)
 importFrom(htmltools,withTags)
 importFrom(promises,"%...!%")
 importFrom(promises,"%...>%")
+importFrom(rlang,env_clone)

R/app_template.R

@@ -0,0 +1,259 @@
+#' Generate a Shiny application from a template
+#'
+#' This function populates a directory with files for a Shiny application. They
+#' are based off of the "12_counter" example which can be run with
+#' `runExample()`.
+#'
+#' In an interactive R session, this function will, by default, prompt the user
+#' which components to add to the application.
+#'
+#' The full example application includes the following files and directories:
+#'
+#' ```
+#' appdir/
+#' ├── app.R
+#' ├── R
+#' │   ├── my-module.R
+#' │   └── utils.R
+#' └── tests
+#'     ├── server.R
+#'     ├── server
+#'     │   ├── test-mymodule.R
+#'     │   └── test-server.R
+#'     ├── shinytest.R
+#'     ├── shinytest
+#'     │   └── mytest.R
+#'     ├── testthat.R
+#'     └── testthat
+#'         ├── helper-load.R
+#'         └── test-utils.R
+#' ```
+#'
+#' Some notes about these files:
+#' * app.R is the main application file.
+#' * All files in the R/ subdirectory are automatically sourced when the
+#'   application is run.
+#' * The R/my-module.R file is automatically sourced when the application
+#'   is run. This file contains code for a [Shiny module](moduleServer()) which
+#'   is used in the application.
+#' * The tests/ directory contains various tests for the application. You may
+#'   choose to use or remove any of them. They can be executed by the
+#'   [runTests()] function.
+#' * tests/server.R is a test runner for test files in
+#'   tests/server/.
+#' * tests/server/test-mymodule.R is a test for the module.
+#' * tests/shinytest.R is a test runner for test files in the
+#'   tests/shinytest/ directory.
+#' * tests/shinytest/mytest.R is a test that uses the
+#'   [shinytest](https://rstudio.github.io/shinytest/) package to do
+#'   snapshot-based testing.
+#' * tests/testthat.R is a test runner for test files in the
+#'   tests/testthat/ directory.
+#' * tests/testthat/helper-load.R is a helper script that is automatically
+#'   loaded before running test-counter.R. (This is performed by the testthat
+#'   package.)
+#' * tests/testthat/test-utils.R is a set of tests that use the
+#'   [testthat](https://testthat.r-lib.org/) package for testing.
+#'
+#' @param path Path to create new shiny application template.
+#' @param examples Either one of "default", "ask", "all", or any combination of
+#'   "app", "rdir", "module", "shinytest", "testthat", and "server". In an
+#'   interactive session, "default" falls back to "ask"; in a non-interactive
+#'   session, "default" falls back to "all". With "ask", this function will
+#'   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.
+#'
+#' @export
+shinyAppTemplate <- function(path = NULL, examples = "default")
+{
+  choices <- c(
+    app       = "app.R            : Main application file",
+    rdir      = "R/utils.R        : Helper file with R code",
+    module    = "R/my-module.R    : Example module",
+    shinytest = "tests/shinytest/ : Tests using shinytest package",
+    testthat  = "tests/testthat/  : Tests using testthat",
+    server    = "tests/server/    : Tests of server and module code"
+  )
+
+  if (length(examples) == 1 && examples == "default") {
+    if (interactive()) {
+      examples <- "ask"
+    } else {
+      examples <- "all"
+    }
+  }
+
+  if (!identical(examples, "ask") &&
+      !identical(examples, "all") &&
+      any(! examples %in% names(choices)))
+  {
+    stop('`examples` must be one of "default", "ask", "all", or any combination of "',
+      paste(names(choices), collapse = '", "'), '".')
+  }
+
+  if (identical(examples, "ask")) {
+    response <- select_menu(
+      c(all = "All", choices),
+      title = paste0(
+        "Select which of the following to add at ", path, "/ :"
+      ),
+      msg = "Enter one or more numbers (with spaces), or an empty line to exit: \n"
+    )
+
+    examples <- names(response)
+  }
+
+  if ("all" %in% examples) {
+    examples <- names(choices)
+  }
+
+  if (length(examples) == 0) {
+    return(invisible())
+  }
+
+  # Check if a directory is empty, ignoring certain files
+  dir_is_empty <- function(path) {
+    files <- list.files(path, all.files = TRUE, no.. = TRUE)
+    # Ignore .DS_Store files, which are sometimes automatically created on macOS
+    files <- setdiff(files, ".DS_Store")
+    return(length(files) != 0)
+  }
+
+  # Helper to resolve paths relative to our example
+  example_path <- function(path) {
+    system.file("examples", "12_counter", path, package = "shiny")
+  }
+
+  # Helper to remove rdir code from a file
+  remove_rdir_code <- function(filename) {
+    txt <- readLines(filename)
+    txt <- txt[!grepl("# lexical_sort from R/utils.R", txt)]
+    txt <- sub("Lexically sorted sequence", "Sorted sequence", txt, fixed = TRUE)
+    txt <- sub("lexical_sort", "sort", txt, fixed = TRUE)
+    # Write with \n line endings on all platforms
+    con <- file(filename, open="wb")
+    writeLines(txt, con)
+    close(con)
+  }
+
+  # Helper to remove module code from a file
+  remove_module_code <- function(filename) {
+    txt <- readLines(filename)
+    start_lines <- grep("^ +# =+ Modules =+$", txt)
+    stop_lines  <- grep("^ +# =+$", txt)
+    if (length(start_lines) != length(stop_lines)) {
+      stop("Start and end markers are unbalanced.")
+    }
+    if (length(start_lines) == 0) {
+      return()
+    }
+    drop_lines <- unlist(lapply(seq_along(start_lines), function(i) {
+      seq(start_lines[i], stop_lines[i])
+    }))
+    # Write with \n line endings on all platforms
+    con <- file(filename, open="wb")
+    writeLines(txt[-drop_lines], con)
+    close(con)
+  }
+
+  # Copy the files for a tests/ subdirectory
+  copy_test_dir <- function(name, with_rdir, with_module) {
+    tests_dir <- file.path(path, "tests")
+    if (!dirExists(tests_dir)) {
+      dir.create(tests_dir, recursive = TRUE)
+    }
+    files <- dir(example_path("tests"), recursive = TRUE)
+    # Note: This is not the same as using dir(pattern = "^shinytest"), since
+    # that will not match files inside of shinytest/.
+    files <- files[grepl(paste0("^", name), files)]
+
+    # Filter out files related to R/utils.R, if applicable.
+    if (!with_rdir) {
+      files <- files[!grepl("utils", files)]
+    }
+
+    # Filter out module files, if applicable.
+    if (!with_module) {
+      files <- files[!grepl("module", files)]
+    }
+
+    # Create any subdirectories if needed
+    dirs <- setdiff(unique(dirname(files)), ".")
+    for (dir in dirs) {
+      dir.create(file.path(tests_dir, dir), recursive = TRUE)
+    }
+
+    file.copy(
+      file.path(example_path("tests"), files),
+      file.path(path, "tests", files)
+    )
+  }
+
+
+  if (is.null(path)) {
+    stop("`path` is missing.")
+  }
+  if (file.exists(path) && !dir.exists(path)) {
+    stop(path, " exists but is not a directory.")
+  }
+
+  if (dir.exists(path) && dir_is_empty(path)) {
+    if (interactive()) {
+      response <- readline(paste0(
+        ensure_trailing_slash(path),
+        " is not empty. Do you want to create a Shiny app in this directory anyway? [y/n] "
+      ))
+      if (tolower(response) != "y") {
+        return(invisible())
+      }
+    }
+  } else {
+    dir.create(path)
+  }
+
+  # app.R - If "app", populate with example; otherwise use empty file.
+  app_file <- file.path(path, "app.R")
+  if ("app" %in% examples) {
+    if (file.exists(app_file)) {
+      message(app_file, " already exists")
+    }
+    file.copy(example_path("app.R"), path)
+
+    if (!"rdir" %in% examples) {
+      remove_rdir_code(app_file)
+    }
+    if (!"module" %in% examples) {
+      remove_module_code(app_file)
+    }
+  }
+
+  # R/ dir with utils and/or module
+  r_dir <- file.path(path, "R")
+  if ("rdir" %in% examples) {
+    if (!dirExists(r_dir)) {
+      dir.create(r_dir, recursive = TRUE)
+    }
+    file.copy(example_path("R/utils.R"), r_dir, recursive = TRUE)
+  }
+  if ("module" %in% examples) {
+    if (!dirExists(r_dir)) {
+      dir.create(r_dir, recursive = TRUE)
+    }
+    file.copy(example_path("R/my-module.R"), r_dir, recursive = TRUE)
+  }
+
+  # tests/ dir
+  if ("shinytest" %in% examples) {
+    copy_test_dir("shinytest", "rdir" %in% examples, "module" %in% examples)
+  }
+  if ("testthat" %in% examples) {
+    copy_test_dir("testthat", "rdir" %in% examples, "module" %in% examples)
+  }
+  if ("server" %in% examples) {
+    copy_test_dir("server", "rdir" %in% examples, "module" %in% examples)
+  }
+  if ("app" %in% examples) {
+    message("Shiny application created at ", ensure_trailing_slash(path))
+  }
+}

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

@@ -1,13 +1,31 @@
-# Create a "data mask" suitable for passing to rlang::eval_tidy. Bindings in
-# `env` and bindings in the parent of `env` are merged into a single named list.
-# Bindings in `env` take precedence over bindings in the parent of `env`.
-#' @noRd
-makeMask <- function(env) {
-  stopifnot(length(rlang::env_parents(env)) > 1)
-  child <- as.list(env)
-  parent <- as.list(rlang::env_parent(env))
-  parent_only <- setdiff(names(parent), names(child))
-  append(child, parent[parent_only])
+# Constructs an rlang::eval_tidy() data mask with semantics appropriate for use
+# in testServer().
+#
+# env is assumed to be session$env, or the environment captured by invoking a
+# module under test.
+#
+# Consider the following module definition and its enclosing environment:
+#
+# x <- 1
+# m <- function(id) {
+#   y <- 2
+#   moduleServer(id, function(input, output, session){
+#     z <- 3
+#   })
+# }
+#
+# The data mask returned by this function should include z, session,
+# output, input, y, and id, but *not* x. Definitions not masked are
+# resolved in the environment in which testServer() is called.
+#
+# env is cloned because rlang::new_data_mask() mutates the parent of its `top`
+# argument.
+#' @importFrom rlang env_clone
+buildMask <- function(env) {
+  if (identical(parent.env(env), emptyenv()))
+    stop("env must have a non-empty parent")
+  clone <- env_clone(env, env_clone(parent.env(env), emptyenv()))
+  rlang::new_data_mask(clone, parent.env(clone))
 }
 
 #' @noRd
@@ -84,6 +102,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)
@@ -112,7 +135,7 @@ testServer <- function(app, expr, ...) {
     withReactiveDomain(
       session,
       withr::with_options(list(`shiny.allowoutputreads` = TRUE), {
-        rlang::eval_tidy(quosure, makeMask(session$env), rlang::caller_env())
+        rlang::eval_tidy(quosure, buildMask(session$env), rlang::caller_env())
       })
     )
   )

R/utils.R

@@ -316,6 +316,15 @@ resolve <- function(dir, relpath) {
   return(abs.path)
 }
 
+# Given a string, make sure it has a trailing slash.
+ensure_trailing_slash <- function(path) {
+  if (!grepl("/$", path)) {
+    path <- paste0(path, "/")
+  }
+  path
+}
+
+
 isWindows <- function() .Platform$OS.type == 'windows'
 
 # This is a wrapper for download.file and has the same interface.
@@ -1812,3 +1821,20 @@ cat_line <- function(...) {
   cat(paste(..., "\n", collapse = ""))
 }
 
+select_menu <- function(choices, title = NULL, msg = "Enter one or more numbers (with spaces), or an empty line to exit: \n") 
+{
+  if (!is.null(title)) {
+    cat(title, "\n", sep = "")
+  }
+  nc <- length(choices)
+  op <- paste0(format(seq_len(nc)), ": ", choices)
+  fop <- format(op)
+  cat("", fop, "", sep = "\n")
+  repeat {
+    answer <- readline(msg)
+    answer <- strsplit(answer, "[ ,]+")[[1]]
+    if (all(answer %in% seq_along(choices))) {
+      return(choices[as.integer(answer)])
+    }
+  }
+}

inst/examples/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
+    }
+  )
+}

inst/examples/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)))
+}

inst/examples/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)

inst/examples/12_counter/tests/server.R

@@ -0,0 +1,6 @@
+
+files <- list.files("./server", full.names = FALSE)
+origwd <- getwd()
+setwd("./server")
+on.exit(setwd(origwd), add=TRUE)
+lapply(files, source, local=environment())

inst/examples/12_counter/tests/server/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")
+})

inst/examples/12_counter/tests/server/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, "1 2 3 4 5 6 7 8 9 10 11 12")
+})

inst/examples/12_counter/tests/shinytest.R

@@ -0,0 +1,3 @@
+library(shinytest)
+shinytest::testApp("../")
+

inst/examples/12_counter/tests/shinytest/mytest.R

@@ -0,0 +1,7 @@
+app <- ShinyDriver$new("../../")
+app$snapshotInit("mytest")
+
+app$snapshot()
+app$setInputs(`mymodule1-button` = "click")
+app$setInputs(`mymodule1-button` = "click")
+app$snapshot()

inst/examples/12_counter/tests/testthat.R

@@ -0,0 +1,6 @@
+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", env = environment())

inst/examples/12_counter/tests/testthat/helper-load.R

@@ -0,0 +1,11 @@
+
+# The RStudio IDE offers a "Run Tests" button when it sees testthat tests but it runs
+# in its own environment/process. Which means that any helpers we've loaded into our
+# environment won't be visible. So we add this helper not because it's actually needed
+# in the typical `shiny::runTests` workflow, but to make that IDE button work.
+# Once the IDE adds proper support for this style, we'll be able to drop these files.
+#
+# Note that this may redundantly source the files in your R/ dir depending on your
+# workflow.
+library(shiny)
+shiny::loadSupport("../../", renv = globalenv())

inst/examples/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))
+})

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}.

man/shinyAppTemplate.Rd

@@ -0,0 +1,75 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/app_template.R
+\name{shinyAppTemplate}
+\alias{shinyAppTemplate}
+\title{Generate a Shiny application from a template}
+\usage{
+shinyAppTemplate(path = NULL, examples = "default")
+}
+\arguments{
+\item{path}{Path to create new shiny application template.}
+
+\item{examples}{Either one of "default", "ask", "all", or any combination of
+"app", "rdir", "module", "shinytest", "testthat", and "server". In an
+interactive session, "default" falls back to "ask"; in a non-interactive
+session, "default" falls back to "all". With "ask", this function will
+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.}
+}
+\description{
+This function populates a directory with files for a Shiny application. They
+are based off of the "12_counter" example which can be run with
+\code{runExample()}.
+}
+\details{
+In an interactive R session, this function will, by default, prompt the user
+which components to add to the application.
+
+The full example application includes the following files and directories:\preformatted{appdir/
+├── app.R
+├── R
+│   ├── my-module.R
+│   └── utils.R
+└── tests
+    ├── server.R
+    ├── server
+    │   ├── test-mymodule.R
+    │   └── test-server.R
+    ├── shinytest.R
+    ├── shinytest
+    │   └── mytest.R
+    ├── testthat.R
+    └── testthat
+        ├── helper-load.R
+        └── test-utils.R
+}
+
+Some notes about these files:
+\itemize{
+\item app.R is the main application file.
+\item All files in the R/ subdirectory are automatically sourced when the
+application is run.
+\item The R/my-module.R file is automatically sourced when the application
+is run. This file contains code for a \href{moduleServer()}{Shiny module} which
+is used in the application.
+\item The tests/ directory contains various tests for the application. You may
+choose to use or remove any of them. They can be executed by the
+\code{\link[=runTests]{runTests()}} function.
+\item tests/server.R is a test runner for test files in
+tests/server/.
+\item tests/server/test-mymodule.R is a test for the module.
+\item tests/shinytest.R is a test runner for test files in the
+tests/shinytest/ directory.
+\item tests/shinytest/mytest.R is a test that uses the
+\href{https://rstudio.github.io/shinytest/}{shinytest} package to do
+snapshot-based testing.
+\item tests/testthat.R is a test runner for test files in the
+tests/testthat/ directory.
+\item tests/testthat/helper-load.R is a helper script that is automatically
+loaded before running test-counter.R. (This is performed by the testthat
+package.)
+\item tests/testthat/test-utils.R is a set of tests that use the
+\href{https://testthat.r-lib.org/}{testthat} package for testing.
+}
+}

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)
+  })
+})