Add news item

.travis.yml

@@ -6,11 +6,7 @@ matrix:
       r_packages:
         - devtools
         - rprojroot
-      script: ./tools/documentation/checkDocsCurrent.sh
-      env:
-        # GITHUB_PAT for gh::gh calls
-        - secure: "Hk4piVNtDobLT1dQPnCOcM7sOlwNGJOU5cpvbRvOxYSgxP+Bj2MyRZMe825rdHkHbFez0h8w3tJOBf9DDBH7PC1BhhNll2+WM/WxGlkNleg8vsoH/Xopffl+2YgtWbAYZjQ2j0QYdgNn0e/TY86/ggk9qit6+gpsZ7z/HmWQuVY="
-
+      script: ./tools/checkDocsCurrent.sh
     - name: "Javascript check"
       language: node_js
       cache: yarn

DESCRIPTION

@@ -79,9 +79,7 @@ Imports:
     crayon,
     rlang (>= 0.4.0),
     fastmap (>= 1.0.0),
-    withr,
-    commonmark (>= 1.7),
-    glue (>= 1.3.2)
+    withr
 Suggests:
     datasets,
     Cairo (>= 1.5-5),
@@ -102,7 +100,6 @@ 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'
@@ -158,7 +155,6 @@ Collate:
     'priorityqueue.R'
     'progress.R'
     'react.R'
-    'reexports.R'
     'render-cached-plot.R'
     'render-plot.R'
     'render-table.R'
@@ -174,7 +170,7 @@ Collate:
     'snapshot.R'
     'tar.R'
     'test-export.R'
-    'test-server.R'
+    'test-module.R'
     'test.R'
     'update-input.R'
 RoxygenNote: 7.1.0

NAMESPACE

@@ -142,7 +142,6 @@ export(loadSupport)
 export(mainPanel)
 export(makeReactiveBinding)
 export(markRenderFunction)
-export(markdown)
 export(maskReactiveContext)
 export(memoryCache)
 export(modalButton)
@@ -230,7 +229,6 @@ export(setSerializer)
 export(shinyApp)
 export(shinyAppDir)
 export(shinyAppFile)
-export(shinyAppTemplate)
 export(shinyOptions)
 export(shinyServer)
 export(shinyUI)
@@ -265,6 +263,7 @@ export(tagHasAttribute)
 export(tagList)
 export(tagSetChildren)
 export(tags)
+export(testModule)
 export(testServer)
 export(textAreaInput)
 export(textInput)
@@ -315,44 +314,6 @@ importFrom(fastmap,is.key_missing)
 importFrom(fastmap,key_missing)
 importFrom(grDevices,dev.cur)
 importFrom(grDevices,dev.set)
-importFrom(htmltools,HTML)
-importFrom(htmltools,a)
-importFrom(htmltools,br)
-importFrom(htmltools,code)
-importFrom(htmltools,div)
-importFrom(htmltools,em)
-importFrom(htmltools,h1)
-importFrom(htmltools,h2)
-importFrom(htmltools,h3)
-importFrom(htmltools,h4)
-importFrom(htmltools,h5)
-importFrom(htmltools,h6)
-importFrom(htmltools,hr)
-importFrom(htmltools,htmlTemplate)
-importFrom(htmltools,img)
-importFrom(htmltools,includeCSS)
-importFrom(htmltools,includeHTML)
-importFrom(htmltools,includeMarkdown)
-importFrom(htmltools,includeScript)
-importFrom(htmltools,includeText)
-importFrom(htmltools,is.singleton)
-importFrom(htmltools,p)
-importFrom(htmltools,pre)
-importFrom(htmltools,singleton)
-importFrom(htmltools,span)
-importFrom(htmltools,strong)
-importFrom(htmltools,suppressDependencies)
-importFrom(htmltools,tag)
-importFrom(htmltools,tagAppendAttributes)
-importFrom(htmltools,tagAppendChild)
-importFrom(htmltools,tagAppendChildren)
-importFrom(htmltools,tagGetAttribute)
-importFrom(htmltools,tagHasAttribute)
-importFrom(htmltools,tagList)
-importFrom(htmltools,tagSetChildren)
-importFrom(htmltools,tags)
-importFrom(htmltools,validateCssUnit)
-importFrom(htmltools,withTags)
 importFrom(promises,"%...!%")
 importFrom(promises,"%...>%")
-importFrom(rlang,env_clone)
+importFrom(withr,with_options)

NEWS.md

@@ -7,14 +7,8 @@ shiny 1.4.0.9001
 
 ### New features
 
-* `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))
-
-* `testServer()` and `testModule()` are two new functions for testing reactive behavior inside server functions and modules, respectively. ([#2682](https://github.com/rstudio/shiny/pull/2682), [#2764](https://github.com/rstudio/shiny/pull/2764))
-
 * The new `moduleServer` function provides a simpler interface for creating and using modules. ([#2773](https://github.com/rstudio/shiny/pull/2773))
 
-* Resolved [#2732](https://github.com/rstudio/shiny/issues/2732): `markdown()` is a new function for writing Markdown with Github extensions directly in Shiny UIs. Markdown rendering is performed by the [commonmark](https://github.com/jeroen/commonmark) package. ([#2737](https://github.com/rstudio/shiny/pull/2737))
-
 ### Minor new features and improvements
 
 * Fixed [#2042](https://github.com/rstudio/shiny/issues/2042), [#2628](https://github.com/rstudio/shiny/issues/2628): In a `dateInput` and `dateRangeInput`, disabled months and years are now a lighter gray, to make it easier to see that they are disabled. ([#2690](https://github.com/rstudio/shiny/pull/2690))
@@ -36,12 +30,6 @@ shiny 1.4.0.9001
 ### Documentation Updates
 
 
-shiny 1.4.0.2
-===========
-
-Minor patch release: fixed some timing-dependent tests failed intermittently on CRAN build machines.
-
-
 shiny 1.4.0.1
 ===========
 

R/app_template.R

@@ -1,259 +0,0 @@
-#' 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/cache-utils.R

@@ -1,3 +1,11 @@
+#' @importFrom fastmap key_missing
+#' @export
+fastmap::key_missing
+
+#' @importFrom fastmap is.key_missing
+#' @export
+fastmap::is.key_missing
+
 
 validate_key <- function(key) {
   if (!is.character(key) || length(key) != 1 || nchar(key) == 0) {
@@ -7,3 +15,4 @@ validate_key <- function(key) {
     stop("Invalid key: ", key, ". Only lowercase letters and numbers are allowed.")
   }
 }
+

R/input-action.R

@@ -16,7 +16,7 @@
 #'
 #' ui <- fluidPage(
 #'   sliderInput("obs", "Number of observations", 0, 1000, 500),
-#'   actionButton("goButton", "Go!", class = "btn-success"),
+#'   actionButton("goButton", "Go!"),
 #'   plotOutput("distPlot")
 #' )
 #'
@@ -36,10 +36,6 @@
 #'
 #' }
 #'
-#' ## Example of adding extra class values
-#' actionButton("largeButton", "Large Primary Button", class = "btn-primary btn-lg")
-#' actionLink("infoLink", "Information Link", class = "btn-info")
-#'
 #' @seealso [observeEvent()] and [eventReactive()]
 #'
 #' @section Server value:

R/mock-session.R

@@ -69,13 +69,6 @@ extract <- function(promise) {
   stop("Single-bracket indexing of mockclientdata is not allowed.")
 }
 
-#' @noRd
-mapNames <- function(func, ...) {
-  vals <- list(...)
-  names(vals) <- vapply(names(vals), func, character(1))
-  vals
-}
-
 #' Mock Shiny Session
 #'
 #' @description
@@ -90,8 +83,6 @@ MockShinySession <- R6Class(
   public = list(
     #' @field env The environment associated with the session.
     env = NULL,
-    #' @field returned The value returned by the module.
-    returned = NULL,
     #' @field singletons Hardcoded as empty. Needed for rendering HTML (i.e. renderUI)
     singletons = character(0),
     #' @field clientData Mock client data that always returns a size for plots
@@ -380,10 +371,10 @@ MockShinySession <- R6Class(
     #' @param export Not used
     #' @param format Not used
     getTestSnapshotUrl = function(input=TRUE, output=TRUE, export=TRUE, format="json") {},
-    #' @description Returns the given id prefixed by this namespace's id.
+    #' @description Returns the given id prefixed by `mock-session-`.
     #' @param id The id to modify.
     ns = function(id) {
-      NS(private$nsPrefix, id)
+      paste0("mock-session-", id) # TODO: does this need to be more complex/intelligent?
     },
     #' @description Trigger a reactive flush right now.
     flushReact = function(){
@@ -397,36 +388,8 @@ MockShinySession <- R6Class(
         self,
         input = .createReactiveValues(private$.input, readonly = TRUE, ns = ns),
         output = structure(.createOutputWriter(self, ns = ns), class = "shinyoutput"),
-        makeScope = function(namespace) self$makeScope(ns(namespace)),
-        ns = function(namespace) ns(namespace),
-        setInputs = function(...) do.call(self$setInputs, mapNames(ns, ...))
+        makeScope = function(namespace) self$makeScope(ns(namespace))
       )
-    },
-    #' @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) {
-      if (is.null(self$env)) self$env <- env
-    },
-    #' @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
-      private$flush()
-      value
-    },
-    #' @description Get the value returned by the module call.
-    getReturned = function() self$returned,
-    #' @description Return a distinct character identifier for use as a proxy
-    #'   namespace.
-    genId = function() {
-      private$idCounter <- private$idCounter + 1
-      paste0("proxy", private$idCounter)
     }
   ),
   private = list(
@@ -437,8 +400,7 @@ MockShinySession <- R6Class(
     timer = NULL,
     closed = FALSE,
     outs = list(),
-    nsPrefix = "mock-session",
-    idCounter = 0,
+    returnedVal = NULL,
 
     flush = function(){
       isolate(private$flushCBs$invoke(..stacktraceon = TRUE))
@@ -448,6 +410,18 @@ MockShinySession <- R6Class(
     }
   ),
   active = list(
+    # If assigning to `returned`, proactively flush
+    #' @field returned The value returned from the module
+    returned = function(value){
+      if(missing(value)){
+        return(private$returnedVal)
+      }
+      # When you assign to returned, that implies that you just ran
+      # the module. So we should proactively flush. We have to do this
+      # here since flush is private.
+      private$returnedVal <- value
+      private$flush()
+    },
     #' @field request An empty environment where the request should be. The request isn't meaningfully mocked currently.
     request = function(value) {
       if (!missing(value)){

R/modules.R

@@ -36,6 +36,7 @@ createSessionProxy <- function(parentSession, ...) {
 
 `[[<-.session_proxy` <- `$<-.session_proxy`
 
+
 #' Shiny modules
 #'
 #' Shiny's module feature lets you break complicated UI and server logic into
@@ -43,9 +44,8 @@ createSessionProxy <- function(parentSession, ...) {
 #' modules are easier to reuse and easier to reason about. See the article at
 #' <http://shiny.rstudio.com/articles/modules.html> to learn more.
 #'
-#' Starting in Shiny 1.5.0, we recommend using `moduleServer` instead of
-#' `callModule`, because the syntax is a little easier to understand, and
-#' modules created with `moduleServer` can be tested with [`testServer()`].
+#' Starting in Shiny 1.5.0, we recommend using `moduleFunction` instead of
+#' `callModule`, because syntax is a little easier to understand.
 #'
 #' @param module A Shiny module server function.
 #' @param id An ID string that corresponds with the ID used to call the module's
@@ -70,19 +70,16 @@ createSessionProxy <- function(parentSession, ...) {
 #'
 #' # Define the server logic for a module
 #' counterServer <- function(id) {
-#'   moduleServer(
-#'     id,
-#'     function(input, output, session) {
-#'       count <- reactiveVal(0)
-#'       observeEvent(input$button, {
-#'         count(count() + 1)
-#'       })
-#'       output$out <- renderText({
-#'         count()
-#'       })
-#'       count
-#'     }
-#'   )
+#'   moduleServer(id, function(input, output, session) {
+#'     count <- reactiveVal(0)
+#'     observeEvent(input$button, {
+#'       count(count() + 1)
+#'     })
+#'     output$out <- renderText({
+#'       count()
+#'     })
+#'     count
+#'   })
 #' }
 #'
 #' # Use the module in an app
@@ -104,19 +101,16 @@ createSessionProxy <- function(parentSession, ...) {
 #' # add them to your function. In this case `prefix` is text that will be
 #' # printed before the count.
 #' counterServer2 <- function(id, prefix = NULL) {
-#'   moduleServer(
-#'     id,
-#'     function(input, output, session) {
-#'       count <- reactiveVal(0)
-#'       observeEvent(input$button, {
-#'         count(count() + 1)
-#'       })
-#'       output$out <- renderText({
-#'         paste0(prefix, count())
-#'       })
-#'       count
-#'     }
-#'   )
+#'   moduleServer(id, function(input, output, session) {
+#'     count <- reactiveVal(0)
+#'     observeEvent(input$button, {
+#'       count(count() + 1)
+#'     })
+#'     output$out <- renderText({
+#'       paste0(prefix, count())
+#'     })
+#'     count
+#'   })
 #' }
 #'
 #' ui <- fluidPage(
@@ -131,12 +125,6 @@ createSessionProxy <- function(parentSession, ...) {
 #'
 #' @export
 moduleServer <- function(id, module, session = getDefaultReactiveDomain()) {
-  if (inherits(session, "MockShinySession")) {
-    body(module) <- rlang::expr({
-      session$setEnv(base::environment())
-      session$setReturned({ !!!body(module) })
-    })
-  }
   callModule(module, id, session = session)
 }
 

R/reexports.R

@@ -1,195 +0,0 @@
-####
-# Generated by `./tools/updateReexports.R`: do not edit by hand
-# Please call `source('tools/updateReexports.R') from the root folder to update`
-####
-
-
-# fastmap key_missing.Rd -------------------------------------------------------
-
-#' @importFrom fastmap key_missing
-#' @export
-fastmap::key_missing
-
-#' @importFrom fastmap is.key_missing
-#' @export
-fastmap::is.key_missing
-
-
-
-# htmltools builder.Rd ---------------------------------------------------------
-
-#' @importFrom htmltools tags
-#' @export
-htmltools::tags
-
-#' @importFrom htmltools p
-#' @export
-htmltools::p
-
-#' @importFrom htmltools h1
-#' @export
-htmltools::h1
-
-#' @importFrom htmltools h2
-#' @export
-htmltools::h2
-
-#' @importFrom htmltools h3
-#' @export
-htmltools::h3
-
-#' @importFrom htmltools h4
-#' @export
-htmltools::h4
-
-#' @importFrom htmltools h5
-#' @export
-htmltools::h5
-
-#' @importFrom htmltools h6
-#' @export
-htmltools::h6
-
-#' @importFrom htmltools a
-#' @export
-htmltools::a
-
-#' @importFrom htmltools br
-#' @export
-htmltools::br
-
-#' @importFrom htmltools div
-#' @export
-htmltools::div
-
-#' @importFrom htmltools span
-#' @export
-htmltools::span
-
-#' @importFrom htmltools pre
-#' @export
-htmltools::pre
-
-#' @importFrom htmltools code
-#' @export
-htmltools::code
-
-#' @importFrom htmltools img
-#' @export
-htmltools::img
-
-#' @importFrom htmltools strong
-#' @export
-htmltools::strong
-
-#' @importFrom htmltools em
-#' @export
-htmltools::em
-
-#' @importFrom htmltools hr
-#' @export
-htmltools::hr
-
-
-# htmltools tag.Rd -------------------------------------------------------------
-
-#' @importFrom htmltools tag
-#' @export
-htmltools::tag
-
-#' @importFrom htmltools tagList
-#' @export
-htmltools::tagList
-
-#' @importFrom htmltools tagAppendAttributes
-#' @export
-htmltools::tagAppendAttributes
-
-#' @importFrom htmltools tagHasAttribute
-#' @export
-htmltools::tagHasAttribute
-
-#' @importFrom htmltools tagGetAttribute
-#' @export
-htmltools::tagGetAttribute
-
-#' @importFrom htmltools tagAppendChild
-#' @export
-htmltools::tagAppendChild
-
-#' @importFrom htmltools tagAppendChildren
-#' @export
-htmltools::tagAppendChildren
-
-#' @importFrom htmltools tagSetChildren
-#' @export
-htmltools::tagSetChildren
-
-
-# htmltools HTML.Rd ------------------------------------------------------------
-
-#' @importFrom htmltools HTML
-#' @export
-htmltools::HTML
-
-
-# htmltools include.Rd ---------------------------------------------------------
-
-#' @importFrom htmltools includeHTML
-#' @export
-htmltools::includeHTML
-
-#' @importFrom htmltools includeText
-#' @export
-htmltools::includeText
-
-#' @importFrom htmltools includeMarkdown
-#' @export
-htmltools::includeMarkdown
-
-#' @importFrom htmltools includeCSS
-#' @export
-htmltools::includeCSS
-
-#' @importFrom htmltools includeScript
-#' @export
-htmltools::includeScript
-
-
-# htmltools singleton.Rd -------------------------------------------------------
-
-#' @importFrom htmltools singleton
-#' @export
-htmltools::singleton
-
-#' @importFrom htmltools is.singleton
-#' @export
-htmltools::is.singleton
-
-
-# htmltools validateCssUnit.Rd -------------------------------------------------
-
-#' @importFrom htmltools validateCssUnit
-#' @export
-htmltools::validateCssUnit
-
-
-# htmltools htmlTemplate.Rd ----------------------------------------------------
-
-#' @importFrom htmltools htmlTemplate
-#' @export
-htmltools::htmlTemplate
-
-
-# htmltools suppressDependencies.Rd --------------------------------------------
-
-#' @importFrom htmltools suppressDependencies
-#' @export
-htmltools::suppressDependencies
-
-
-# htmltools withTags.Rd --------------------------------------------------------
-
-#' @importFrom htmltools withTags
-#' @export
-htmltools::withTags

R/shiny.R

@@ -2296,56 +2296,3 @@ ShinyServerTimingRecorder <- R6Class("ShinyServerTimingRecorder",
 )
 
 missingOutput <- function(...) req(FALSE)
-
-#' Insert inline Markdown
-#'
-#' This function accepts
-#' [Markdown](https://en.wikipedia.org/wiki/Markdown)-syntax text and returns
-#' HTML that may be included in Shiny UIs.
-#'
-#' Leading whitespace is trimmed from Markdown text with [glue::trim()].
-#' Whitespace trimming ensures Markdown is processed correctly even when the
-#' call to `markdown()` is indented within surrounding R code.
-#'
-#' By default, [Github extensions][commonmark::extensions] are enabled, but this
-#' can be disabled by passing `extensions = FALSE`.
-#'
-#' Markdown rendering is performed by [commonmark::markdown_html()]. Additional
-#' arguments to `markdown()` are passed as arguments to `markdown_html()`
-#'
-#' @param mds A character vector of Markdown source to convert to HTML. If the
-#'   vector has more than one element, a single-element character vector of
-#'   concatenated HTML is returned.
-#' @param extensions Enable Github syntax extensions; defaults to `TRUE`.
-#' @param .noWS Character vector used to omit some of the whitespace that would
-#'   normally be written around generated HTML. Valid options include `before`,
-#'   `after`, and `outside` (equivalent to `before` and `end`).
-#' @param ... Additional arguments to pass to [commonmark::markdown_html()].
-#'   These arguments are _[dynamic][rlang::dyn-dots]_.
-#'
-#' @return a character vector marked as HTML.
-#' @export
-#' @examples
-#' ui <- fluidPage(
-#'   markdown("
-#'     # Markdown Example
-#'
-#'     This is a markdown paragraph, and will be contained within a `<p>` tag
-#'     in the UI.
-#'
-#'     The following is an unordered list, which will be represented in the UI as
-#'     a `<ul>` with `<li>` children:
-#'
-#'     * a bullet
-#'     * another
-#'
-#'     [Links](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a) work;
-#'     so does *emphasis*.
-#'
-#'     To see more of what's possible, check out [commonmark.org/help](https://commonmark.org/help).
-#'     ")
-#' )
-markdown <- function(mds, extensions = TRUE, .noWS = NULL, ...) {
-  html <- rlang::exec(commonmark::markdown_html, glue::trim(mds), extensions = extensions, ...)
-  htmltools::HTML(html, .noWS = .noWS)
-}

R/test-module.R

@@ -0,0 +1,169 @@
+
+
+#' Integration testing for Shiny modules or server functions
+#'
+#' Offer a way to test the reactive interactions in Shiny --- either in Shiny
+#' modules or in the server portion of a Shiny application. For more
+#' information, visit [the Shiny Dev Center article on integration
+#' testing](https://shiny.rstudio.com/articles/integration-testing.html).
+#' @param module The module to test
+#' @param expr Test code containing expectations. The test expression will run
+#'   in the module's environment, meaning that the module's parameters (e.g.
+#'   `input`, `output`, and `session`) will be available along with any other
+#'   values created inside of the module.
+#' @param ... Additional arguments to pass to the module function. These
+#'   arguments are processed with [rlang::list2()] and so are
+#'   _[dynamic][rlang::dyn-dots]_.
+#' @return The result of evaluating `expr`.
+#' @include mock-session.R
+#' @rdname testModule
+#' @examples
+#' module <- function(input, output, session, multiplier = 2, prefix = "I am ") {
+#'   myreactive <- reactive({
+#'     input$x * multiplier
+#'   })
+#'   output$txt <- renderText({
+#'     paste0(prefix, myreactive())
+#'   })
+#' }
+#'
+#' # Basic Usage
+#' # -----------
+#' testModule(module, {
+#'   session$setInputs(x = 1)
+#'   # You're also free to use third-party
+#'   # testing packages like testthat:
+#'   #   expect_equal(myreactive(), 2)
+#'   stopifnot(myreactive() == 2)
+#'   stopifnot(output$txt == "I am 2")
+#'
+#'   session$setInputs(x = 2)
+#'   stopifnot(myreactive() == 4)
+#'   stopifnot(output$txt == "I am 4")
+#'   # Any additional arguments, below, are passed along to the module.
+#' }, multiplier = 2)
+#'
+#' # Advanced Usage
+#' # --------------
+#' multiplier_arg_name = "multiplier"
+#' more_args <- list(prefix = "I am ")
+#' testModule(module, {
+#'   session$setInputs(x = 1)
+#'   stopifnot(myreactive() == 2)
+#'   stopifnot(output$txt == "I am 2")
+#'   # !!/:= and !!! from rlang are used below to splice computed arguments
+#'   # into the testModule() argument list.
+#' }, !!multiplier_arg_name := 2, !!!more_args)
+#' @export
+testModule <- function(module, expr, ...) {
+  .testModule(
+    module,
+    quosure = rlang::enquo(expr),
+    dots = rlang::list2(...),
+    env = rlang::caller_env()
+  )
+}
+
+#' @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)
+      })
+    )
+  )
+
+  # 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
+  # was saved when the module function was invoked. flush is not needed before
+  # entering the loop because the first expr executed is `{`.
+  isolate({
+    withReactiveDomain(
+      session,
+      withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
+        rlang::eval_tidy(
+          quosure,
+          data = rlang::as_data_mask(as.list(session$env)),
+          env = env
+        )
+      })
+    )
+  })
+}
+
+#' Test an app's server-side logic
+#' @param appDir The directory root of the Shiny application. If `NULL`, this function
+#'   will work up the directory hierarchy --- starting with the current directory ---
+#'   looking for a directory that contains an `app.R` or `server.R` file.
+#' @rdname testModule
+#' @export
+testServer <- function(expr, appDir=NULL) {
+  if (is.null(appDir)){
+    appDir <- findApp()
+  }
+
+  app <- shinyAppDir(appDir)
+  message("Testing application found in: ", appDir)
+  server <- app$serverFuncSource()
+
+  origwd <- getwd()
+  setwd(appDir)
+  on.exit({ setwd(origwd) }, add=TRUE)
+
+  # Add `session` argument if not present
+  fn_formals <- formals(server)
+  if (! "session" %in% names(fn_formals)) {
+    fn_formals$session <- bquote()
+    formals(server) <- fn_formals
+  }
+
+  # Test the server function almost as if it were a module. `dots` is empty
+  # because server functions never take additional arguments.
+  .testModule(
+    server,
+    quosure = rlang::enquo(expr),
+    dots = list(),
+    env = rlang::caller_env()
+  )
+}
+
+findApp <- function(startDir="."){
+  dir <- normalizePath(startDir)
+
+  # The loop will either return or stop() itself.
+  while (TRUE){
+    if(file.exists.ci(file.path(dir, "app.R")) || file.exists.ci(file.path(dir, "server.R"))){
+      return(dir)
+    }
+
+    # Move up a directory
+    origDir <- dir
+    dir <- dirname(dir)
+
+    # Testing for "root" path can be tricky. OSs differ and on Windows, network shares
+    # might have a \\ prefix. Easier to just see if we got stuck and abort.
+    if (dir == origDir){
+      # We can go no further.
+      stop("No shiny app was found in ", startDir, " or any of its parent directories")
+    }
+  }
+}

R/test-server.R

@@ -1,142 +0,0 @@
-# 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
-isModuleServer <- function(x) {
-  is.function(x) && names(formals(x))[1] == "id"
-}
-
-#' Reactive testing for Shiny server functions and modules
-#'
-#' A way to test the reactive interactions in Shiny applications. Reactive
-#' interactions are defined in the server function of applications and in
-#' modules.
-#' @param app The path to an application or module to test. In addition to
-#'   paths, applications may be represented by any object suitable for coercion
-#'   to an `appObj` by `as.shiny.appobj`. Application server functions must
-#'   include a `session` argument in order to be tested.
-#' @param expr Test code containing expectations. The test expression will run
-#'   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.
-#' @return The result of evaluating `expr`.
-#' @include mock-session.R
-#' @rdname testServer
-#' @examples
-#' server <- function(id, multiplier = 2, prefix = "I am ") {
-#'   moduleServer(id, function(input, output, session) {
-#'     myreactive <- reactive({
-#'       input$x * multiplier
-#'     })
-#'     output$txt <- renderText({
-#'       paste0(prefix, myreactive())
-#'     })
-#'   })
-#' }
-#'
-#' testServer(server, {
-#'   session$setInputs(x = 1)
-#'   # You're also free to use third-party
-#'   # testing packages like testthat:
-#'   #   expect_equal(myreactive(), 2)
-#'   stopifnot(myreactive() == 2)
-#'   stopifnot(output$txt == "I am 2")
-#'
-#'   session$setInputs(x = 2)
-#'   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, expr, ...) {
-
-  args <- rlang::list2(...)
-
-  session <- getDefaultReactiveDomain()
-
-  if (inherits(session, "MockShinySession"))
-    stop("Test expressions may not call testServer()")
-  if (inherits(session, "session_proxy")
-      && inherits(get("parent", envir = session), "MockShinySession"))
-    stop("Modules may not call testServer()")
-
-  session <- MockShinySession$new()
-  on.exit(if (!session$isClosed()) session$close())
-
-  if (isModuleServer(app)) {
-    if (!("id" %in% names(args)))
-      args[["id"]] <- session$genId()
-  } else {
-    appobj <- as.shiny.appobj(app)
-    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)
-    })
-    app <- function() {
-      session$setReturned(server(input = session$input, output = session$output, session = session))
-    }
-    if (length(args))
-      message("Discarding unused arguments to server function")
-  }
-
-  isolate(
-    withReactiveDomain(
-      session,
-      withr::with_options(list(`shiny.allowoutputreads` = TRUE), {
-        rlang::exec(app, !!!args)
-      })
-    )
-  )
-
-  stopifnot(all(c("input", "output", "session") %in% ls(session$env)))
-
-  quosure <- rlang::enquo(expr)
-
-  isolate(
-    withReactiveDomain(
-      session,
-      withr::with_options(list(`shiny.allowoutputreads` = TRUE), {
-        rlang::eval_tidy(quosure, buildMask(session$env), rlang::caller_env())
-      })
-    )
-  )
-}

R/test.R

@@ -1,28 +1,3 @@
-#' Creates and returns run result data frame.
-#'
-#' @param file Name of the test runner file, a character vector of length 1.
-#' @param pass Whether or not the test passed, a logical vector of length 1.
-#' @param result Value (wrapped in a list) obtained by evaluating `file` or `NA`
-#'   if no value was obtained, such as with `shinytest`.
-#' @param error Error, if any, (and wrapped in a list) that was signaled during
-#'   evaluation of `file`.
-#'
-#' @return A 1-row data frame representing a single test run. `result` and
-#'   `error` are "list columns", or columns that may contain list elements.
-#' @noRd
-result_row <- function(file, pass, result, error) {
-  stopifnot(is.list(result))
-  stopifnot(is.list(error))
-  df <- data.frame(
-    file = file,
-    pass = pass,
-    result = I(result),
-    error = I(error),
-    stringsAsFactors = FALSE
-  )
-  class(df) <- c("shinytestrun", class(df))
-  df
-}
 
 #' Check to see if the given text is a shinytest
 #' Scans for the magic string of `app <- ShinyDriver$new(` as an indicator that this is a shinytest.
@@ -44,16 +19,6 @@ isShinyTest <- function(text){
 #'   expression will be executed. Matching is performed on the file name
 #'   including the extension.
 #'
-#' @return A data frame classed with the supplemental class `"shinytestrun"`.
-#'   The data frame has the following columns:
-#'
-#' | **Name** | **Type** | **Meaning** |
-#' | :-- | :-- | :-- |
-#' | `file` | `character(1)` | File name of the runner script in `tests/` that was sourced. |
-#' | `pass` | `logical(1)` | Whether or not the runner script signaled an error when sourced. |
-#' | `result` | any or `NA` | The return value of the runner, or `NA` if `pass == FALSE`. |
-#' | `error` | any or `NA` | The error signaled by the runner, or `NA` if `pass == TRUE`. |
-#'
 #' @details Historically, [shinytest](https://rstudio.github.io/shinytest/)
 #'   recommended placing tests at the top-level of the `tests/` directory. In
 #'   order to support that model, `testApp` first checks to see if the `.R`
@@ -71,7 +36,7 @@ runTests <- function(appDir=".", filter=NULL){
 
   if (length(runners) == 0){
     message("No test runners found in ", testsDir)
-    return(result_row(character(0), logical(0), list(), list()))
+    return(structure(list(result=NA, files=list()), class="shinytestrun"))
   }
 
   if (!is.null(filter)){
@@ -87,7 +52,6 @@ runTests <- function(appDir=".", filter=NULL){
     isShinyTest(text)
   }, logical(1))
 
-  # See the @details section of the runTests() docs above for why this branch exists.
   if (all(isST)){
     # just call out to shinytest
     # We don't need to message/warn here since shinytest already does it.
@@ -100,10 +64,16 @@ runTests <- function(appDir=".", filter=NULL){
       warning("You've disabled `shiny.autoload.r` via an option but this is not passed through to shinytest. Consider using a _disable_autoload.R file as described at https://rstd.io/shiny-autoload")
     }
 
-    return(do.call(rbind, lapply(shinytest::testApp(appDir)[["results"]], function(r) {
-      error <- if (r[["pass"]]) NA else simpleError("Unknown shinytest error")
-      result_row(r[["name"]], r[["pass"]], list(NA), list(error))
-    })))
+    sares <- shinytest::testApp(appDir)
+    res <- list()
+    lapply(sares$results, function(r){
+      e <- NA_character_
+      if (!r$pass){
+        e <- simpleError("Unknown shinytest error")
+      }
+      res[[r$name]] <<- e
+    })
+    return(structure(list(result=all(is.na(res)), files=res), class="shinytestrun"))
   }
 
   testenv <- new.env(parent=globalenv())
@@ -125,17 +95,13 @@ runTests <- function(appDir=".", filter=NULL){
   setwd(testsDir)
 
   # Otherwise source all the runners -- each in their own environment.
-  return(do.call(rbind, lapply(runners, function(r) {
-    result <- NA
-    error <- NA
-    pass <- FALSE
-    tryCatch({
-      env <- new.env(parent = renv)
-      result <- sourceUTF8(r, envir = env)
-      pass <- TRUE
-    }, error = function(e) {
-      error <<- e
+  fileResults <- list()
+  lapply(runners, function(r){
+    env <- new.env(parent=renv)
+    tryCatch({sourceUTF8(r, envir=env); fileResults[[r]] <<- NA_character_}, error=function(e){
+      fileResults[[r]] <<- e
     })
-    result_row(r, pass, list(result), list(error))
-  })))
+  })
+
+  return(structure(list(result=all(is.na(fileResults)), files=fileResults), class="shinytestrun"))
 }

R/utils.R

@@ -316,15 +316,6 @@ 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.
@@ -1821,20 +1812,3 @@ 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/_pkgdown.yml

@@ -98,7 +98,6 @@ reference:
       - bootstrapLib
       - suppressDependencies
       - insertUI
-      - markdown
   - title: Rendering functions
     desc: Functions that you use in your application's server side code, assigning them to outputs that appear in your user interface.
     contents:
@@ -194,7 +193,7 @@ reference:
       - onStop
       - diskCache
       - memoryCache
-      - key_missing
+      - reexports
   - title: Plot interaction
     desc: Functions related to interactive plots
     contents:
@@ -218,5 +217,5 @@ reference:
     desc: Functions intended for testing of Shiny components
     contents:
       - runTests
-      - testServer
+      - testModule
       - MockShinySession

inst/examples/12_counter/R/my-module.R

@@ -1,23 +0,0 @@
-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

@@ -1,5 +0,0 @@
-# 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

@@ -1,30 +0,0 @@
-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

@@ -1,6 +0,0 @@
-
-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

@@ -1,18 +0,0 @@
-# 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

@@ -1,11 +0,0 @@
-# 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

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

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

@@ -1,7 +0,0 @@
-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

@@ -1,6 +0,0 @@
-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

@@ -1,11 +0,0 @@
-
-# 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

@@ -1,5 +0,0 @@
-# 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/HTML.Rd

@@ -0,0 +1,29 @@
+\name{HTML}
+\alias{HTML}
+\title{Mark Characters as HTML}
+\usage{
+HTML(text, ..., .noWS = NULL)
+}
+\arguments{
+\item{text}{The text value to mark with HTML}
+
+\item{...}{Any additional values to be converted to character and
+concatenated together}
+
+\item{.noWS}{Character vector used to omit some of the whitespace that would
+normally be written around this HTML. Valid options include \code{before},
+\code{after}, and \code{outside} (equivalent to \code{before} and
+\code{end}).}
+}
+\value{
+The same value, but marked as HTML.
+}
+\description{
+Marks the given text as HTML, which means the \link{tag} functions will know
+not to perform HTML escaping on it.
+}
+\examples{
+el <- div(HTML("I like <u>turtles</u>"))
+cat(as.character(el))
+
+}

man/MockShinySession.Rd

@@ -21,8 +21,6 @@ s$setInputs(x=1, y=2)
 \describe{
 \item{\code{env}}{The environment associated with the session.}
 
-\item{\code{returned}}{The value returned by the module.}
-
 \item{\code{singletons}}{Hardcoded as empty. Needed for rendering HTML (i.e. renderUI)}
 
 \item{\code{clientData}}{Mock client data that always returns a size for plots}
@@ -40,6 +38,8 @@ s$setInputs(x=1, y=2)
 \section{Active bindings}{
 \if{html}{\out{<div class="r6-active-bindings">}}
 \describe{
+\item{\code{returned}}{The value returned from the module}
+
 \item{\code{request}}{An empty environment where the request should be. The request isn't meaningfully mocked currently.}
 }
 \if{html}{\out{</div>}}
@@ -83,10 +83,6 @@ s$setInputs(x=1, y=2)
 \item \href{#method-ns}{\code{MockShinySession$ns()}}
 \item \href{#method-flushReact}{\code{MockShinySession$flushReact()}}
 \item \href{#method-makeScope}{\code{MockShinySession$makeScope()}}
-\item \href{#method-setEnv}{\code{MockShinySession$setEnv()}}
-\item \href{#method-setReturned}{\code{MockShinySession$setReturned()}}
-\item \href{#method-getReturned}{\code{MockShinySession$getReturned()}}
-\item \href{#method-genId}{\code{MockShinySession$genId()}}
 \item \href{#method-clone}{\code{MockShinySession$clone()}}
 }
 }
@@ -631,7 +627,7 @@ No-op
 \if{html}{\out{<a id="method-ns"></a>}}
 \if{latex}{\out{\hypertarget{method-ns}{}}}
 \subsection{Method \code{ns()}}{
-Returns the given id prefixed by this namespace's id.
+Returns the given id prefixed by \verb{mock-session-}.
 \subsection{Usage}{
 \if{html}{\out{<div class="r">}}\preformatted{MockShinySession$ns(id)}\if{html}{\out{</div>}}
 }
@@ -670,67 +666,6 @@ Create and return a namespace-specific session proxy.
 }
 \if{html}{\out{</div>}}
 }
-}
-\if{html}{\out{<hr>}}
-\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, 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>}}
-}
-
-\subsection{Arguments}{
-\if{html}{\out{<div class="arguments">}}
-\describe{
-\item{\code{env}}{The environment to retain.}
-}
-\if{html}{\out{</div>}}
-}
-}
-\if{html}{\out{<hr>}}
-\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. 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>}}
-}
-
-\subsection{Arguments}{
-\if{html}{\out{<div class="arguments">}}
-\describe{
-\item{\code{value}}{The value returned from the module}
-}
-\if{html}{\out{</div>}}
-}
-}
-\if{html}{\out{<hr>}}
-\if{html}{\out{<a id="method-getReturned"></a>}}
-\if{latex}{\out{\hypertarget{method-getReturned}{}}}
-\subsection{Method \code{getReturned()}}{
-Get the value returned by the module call.
-\subsection{Usage}{
-\if{html}{\out{<div class="r">}}\preformatted{MockShinySession$getReturned()}\if{html}{\out{</div>}}
-}
-
-}
-\if{html}{\out{<hr>}}
-\if{html}{\out{<a id="method-genId"></a>}}
-\if{latex}{\out{\hypertarget{method-genId}{}}}
-\subsection{Method \code{genId()}}{
-Return a distinct character identifier for use as a proxy
-namespace.
-\subsection{Usage}{
-\if{html}{\out{<div class="r">}}\preformatted{MockShinySession$genId()}\if{html}{\out{</div>}}
-}
-
 }
 \if{html}{\out{<hr>}}
 \if{html}{\out{<a id="method-clone"></a>}}

man/actionButton.Rd

@@ -43,7 +43,7 @@ if (interactive()) {
 
 ui <- fluidPage(
   sliderInput("obs", "Number of observations", 0, 1000, 500),
-  actionButton("goButton", "Go!", class = "btn-success"),
+  actionButton("goButton", "Go!"),
   plotOutput("distPlot")
 )
 
@@ -63,10 +63,6 @@ shinyApp(ui, server)
 
 }
 
-## Example of adding extra class values
-actionButton("largeButton", "Large Primary Button", class = "btn-primary btn-lg")
-actionLink("infoLink", "Information Link", class = "btn-info")
-
 }
 \seealso{
 \code{\link[=observeEvent]{observeEvent()}} and \code{\link[=eventReactive]{eventReactive()}}

man/builder.Rd

@@ -0,0 +1,124 @@
+\name{builder}
+\alias{builder}
+\alias{tags}
+\alias{p}
+\alias{h1}
+\alias{h2}
+\alias{h3}
+\alias{h4}
+\alias{h5}
+\alias{h6}
+\alias{a}
+\alias{br}
+\alias{div}
+\alias{span}
+\alias{pre}
+\alias{code}
+\alias{img}
+\alias{strong}
+\alias{em}
+\alias{hr}
+\title{HTML Builder Functions}
+\usage{
+tags
+
+p(..., .noWS = NULL)
+
+h1(..., .noWS = NULL)
+
+h2(..., .noWS = NULL)
+
+h3(..., .noWS = NULL)
+
+h4(..., .noWS = NULL)
+
+h5(..., .noWS = NULL)
+
+h6(..., .noWS = NULL)
+
+a(..., .noWS = NULL)
+
+br(..., .noWS = NULL)
+
+div(..., .noWS = NULL)
+
+span(..., .noWS = NULL)
+
+pre(..., .noWS = NULL)
+
+code(..., .noWS = NULL)
+
+img(..., .noWS = NULL)
+
+strong(..., .noWS = NULL)
+
+em(..., .noWS = NULL)
+
+hr(..., .noWS = NULL)
+}
+\arguments{
+\item{...}{Attributes and children of the element. Named arguments become
+attributes, and positional arguments become children. Valid children are
+tags, single-character character vectors (which become text nodes), raw
+HTML (see \code{\link{HTML}}), and \code{html_dependency} objects. You can
+also pass lists that contain tags, text nodes, or HTML. To use boolean
+attributes, use a named argument with a \code{NA} value. (see example)}
+
+\item{.noWS}{A character vector used to omit some of the whitespace that
+would normally be written around this tag. Valid options include
+\code{before}, \code{after}, \code{outside}, \code{after-begin}, and
+\code{before-end}. Any number of these options can be specified.}
+}
+\description{
+Simple functions for constructing HTML documents.
+}
+\details{
+The \code{tags} environment contains convenience functions for all valid
+HTML5 tags. To generate tags that are not part of the HTML5 specification,
+you can use the \code{\link{tag}()} function.
+
+Dedicated functions are available for the most common HTML tags that do not
+conflict with common R functions.
+
+The result from these functions is a tag object, which can be converted using
+\code{\link{as.character}()}.
+}
+\examples{
+doc <- tags$html(
+  tags$head(
+    tags$title('My first page')
+  ),
+  tags$body(
+    h1('My first heading'),
+    p('My first paragraph, with some ',
+      strong('bold'),
+      ' text.'),
+    div(id='myDiv', class='simpleDiv',
+        'Here is a div with some attributes.')
+  )
+)
+cat(as.character(doc))
+
+# create an html5 audio tag with controls.
+# controls is a boolean attributes
+audio_tag <- tags$audio(
+  controls = NA,
+  tags$source(
+    src = "myfile.wav",
+    type = "audio/wav"
+  )
+)
+cat(as.character(audio_tag))
+
+# suppress the whitespace between tags
+oneline <- tags$span(
+  tags$strong("I'm strong", .noWS="outside")
+)
+cat(as.character(oneline))
+}
+\references{
+\itemize{
+   \item W3C html specification about boolean attributes
+   \url{https://www.w3.org/TR/html5/infrastructure.html#sec-boolean-attributes}
+ }
+}

man/htmlTemplate.Rd

@@ -0,0 +1,29 @@
+\name{htmlTemplate}
+\alias{htmlTemplate}
+\title{Process an HTML template}
+\usage{
+htmlTemplate(filename = NULL, ..., text_ = NULL, document_ = "auto")
+}
+\arguments{
+\item{filename}{Path to an HTML template file. Incompatible with
+\code{text_}.}
+
+\item{...}{Variable values to use when processing the template.}
+
+\item{text_}{A string to use as the template, instead of a file. Incompatible
+with \code{filename}.}
+
+\item{document_}{Is this template a complete HTML document (\code{TRUE}), or
+a fragment of HTML that is to be inserted into an HTML document
+(\code{FALSE})? With \code{"auto"} (the default), auto-detect by searching
+for the string \code{"<HTML>"} within the template.}
+}
+\description{
+Process an HTML template and return a tagList object. If the template is a
+complete HTML document, then the returned object will also have class
+\code{html_document}, and can be passed to the function
+\code{\link{renderDocument}} to get the final HTML text.
+}
+\seealso{
+\code{\link{renderDocument}}
+}

man/include.Rd

@@ -0,0 +1,44 @@
+\name{include}
+\alias{include}
+\alias{includeHTML}
+\alias{includeText}
+\alias{includeMarkdown}
+\alias{includeCSS}
+\alias{includeScript}
+\title{Include Content From a File}
+\usage{
+includeHTML(path)
+
+includeText(path)
+
+includeMarkdown(path)
+
+includeCSS(path, ...)
+
+includeScript(path, ...)
+}
+\arguments{
+\item{path}{The path of the file to be included. It is highly recommended to
+use a relative path (the base path being the Shiny application directory),
+not an absolute path.}
+
+\item{...}{Any additional attributes to be applied to the generated tag.}
+}
+\description{
+Load HTML, text, or rendered Markdown from a file and turn into HTML.
+}
+\details{
+These functions provide a convenient way to include an extensive amount of
+HTML, textual, Markdown, CSS, or JavaScript content, rather than using a
+large literal R string.
+}
+\note{
+\code{includeText} escapes its contents, but does no other processing.
+  This means that hard breaks and multiple spaces will be rendered as they
+  usually are in HTML: as a single space character. If you are looking for
+  preformatted text, wrap the call with \code{\link{pre}}, or consider using
+  \code{includeMarkdown} instead.
+
+The \code{includeMarkdown} function requires the \code{markdown}
+  package.
+}

man/markdown.Rd

@@ -1,62 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/shiny.R
-\name{markdown}
-\alias{markdown}
-\title{Insert inline Markdown}
-\usage{
-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, a single-element character vector of
-concatenated HTML is returned.}
-
-\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{
-a character vector marked as HTML.
-}
-\description{
-This function accepts
-\href{https://en.wikipedia.org/wiki/Markdown}{Markdown}-syntax text and returns
-HTML that may be included in Shiny UIs.
-}
-\details{
-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}.
-
-Markdown rendering is performed by \code{\link[commonmark:markdown_html]{commonmark::markdown_html()}}. Additional
-arguments to \code{markdown()} are passed as arguments to \code{markdown_html()}
-}
-\examples{
-ui <- fluidPage(
-  markdown("
-    # Markdown Example
-
-    This is a markdown paragraph, and will be contained within a `<p>` tag
-    in the UI.
-
-    The following is an unordered list, which will be represented in the UI as
-    a `<ul>` with `<li>` children:
-
-    * a bullet
-    * another
-
-    [Links](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a) work;
-    so does *emphasis*.
-
-    To see more of what's possible, check out [commonmark.org/help](https://commonmark.org/help).
-    ")
-)
-}

man/moduleServer.Rd

@@ -31,9 +31,8 @@ modules are easier to reuse and easier to reason about. See the article at
 \url{http://shiny.rstudio.com/articles/modules.html} to learn more.
 }
 \details{
-Starting in Shiny 1.5.0, we recommend using \code{moduleServer} instead of
-\code{callModule}, because the syntax is a little easier to understand, and
-modules created with \code{moduleServer} can be tested with \code{\link[=testServer]{testServer()}}.
+Starting in Shiny 1.5.0, we recommend using \code{moduleFunction} instead of
+\code{callModule}, because syntax is a little easier to understand.
 }
 \examples{
 # Define the UI for a module
@@ -47,19 +46,16 @@ counterUI <- function(id, label = "Counter") {
 
 # Define the server logic for a module
 counterServer <- function(id) {
-  moduleServer(
-    id,
-    function(input, output, session) {
-      count <- reactiveVal(0)
-      observeEvent(input$button, {
-        count(count() + 1)
-      })
-      output$out <- renderText({
-        count()
-      })
-      count
-    }
-  )
+  moduleServer(id, function(input, output, session) {
+    count <- reactiveVal(0)
+    observeEvent(input$button, {
+      count(count() + 1)
+    })
+    output$out <- renderText({
+      count()
+    })
+    count
+  })
 }
 
 # Use the module in an app
@@ -81,19 +77,16 @@ if (interactive()) {
 # add them to your function. In this case `prefix` is text that will be
 # printed before the count.
 counterServer2 <- function(id, prefix = NULL) {
-  moduleServer(
-    id,
-    function(input, output, session) {
-      count <- reactiveVal(0)
-      observeEvent(input$button, {
-        count(count() + 1)
-      })
-      output$out <- renderText({
-        paste0(prefix, count())
-      })
-      count
-    }
-  )
+  moduleServer(id, function(input, output, session) {
+    count <- reactiveVal(0)
+    observeEvent(input$button, {
+      count(count() + 1)
+    })
+    output$out <- renderText({
+      paste0(prefix, count())
+    })
+    count
+  })
 }
 
 ui <- fluidPage(

man/reexports.Rd

@@ -1,48 +1,10 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/reexports.R
+% Please edit documentation in R/cache-utils.R
 \docType{import}
 \name{reexports}
 \alias{reexports}
 \alias{key_missing}
 \alias{is.key_missing}
-\alias{tags}
-\alias{p}
-\alias{h1}
-\alias{h2}
-\alias{h3}
-\alias{h4}
-\alias{h5}
-\alias{h6}
-\alias{a}
-\alias{br}
-\alias{div}
-\alias{span}
-\alias{pre}
-\alias{code}
-\alias{img}
-\alias{strong}
-\alias{em}
-\alias{hr}
-\alias{tag}
-\alias{tagList}
-\alias{tagAppendAttributes}
-\alias{tagHasAttribute}
-\alias{tagGetAttribute}
-\alias{tagAppendChild}
-\alias{tagAppendChildren}
-\alias{tagSetChildren}
-\alias{HTML}
-\alias{includeHTML}
-\alias{includeText}
-\alias{includeMarkdown}
-\alias{includeCSS}
-\alias{includeScript}
-\alias{singleton}
-\alias{is.singleton}
-\alias{validateCssUnit}
-\alias{htmlTemplate}
-\alias{suppressDependencies}
-\alias{withTags}
 \title{Objects exported from other packages}
 \keyword{internal}
 \description{
@@ -51,7 +13,5 @@ below to see their documentation.
 
 \describe{
   \item{fastmap}{\code{\link[fastmap]{is.key_missing}}, \code{\link[fastmap]{key_missing}}}
-
-  \item{htmltools}{\code{\link[htmltools]{a}}, \code{\link[htmltools]{br}}, \code{\link[htmltools]{code}}, \code{\link[htmltools]{div}}, \code{\link[htmltools]{em}}, \code{\link[htmltools]{h1}}, \code{\link[htmltools]{h2}}, \code{\link[htmltools]{h3}}, \code{\link[htmltools]{h4}}, \code{\link[htmltools]{h5}}, \code{\link[htmltools]{h6}}, \code{\link[htmltools]{hr}}, \code{\link[htmltools]{HTML}}, \code{\link[htmltools]{htmlTemplate}}, \code{\link[htmltools]{img}}, \code{\link[htmltools]{includeCSS}}, \code{\link[htmltools]{includeHTML}}, \code{\link[htmltools]{includeMarkdown}}, \code{\link[htmltools]{includeScript}}, \code{\link[htmltools]{includeText}}, \code{\link[htmltools]{is.singleton}}, \code{\link[htmltools]{p}}, \code{\link[htmltools]{pre}}, \code{\link[htmltools]{singleton}}, \code{\link[htmltools]{span}}, \code{\link[htmltools]{strong}}, \code{\link[htmltools]{suppressDependencies}}, \code{\link[htmltools]{tag}}, \code{\link[htmltools]{tagAppendAttributes}}, \code{\link[htmltools]{tagAppendChild}}, \code{\link[htmltools]{tagAppendChildren}}, \code{\link[htmltools]{tagGetAttribute}}, \code{\link[htmltools]{tagHasAttribute}}, \code{\link[htmltools]{tagList}}, \code{\link[htmltools]{tags}}, \code{\link[htmltools]{tagSetChildren}}, \code{\link[htmltools]{validateCssUnit}}, \code{\link[htmltools]{withTags}}}
 }}
 

man/runTests.Rd

@@ -13,16 +13,6 @@ runTests(appDir = ".", filter = NULL)
 expression will be executed. Matching is performed on the file name
 including the extension.}
 }
-\value{
-A data frame classed with the supplemental class \code{"shinytestrun"}.
-The data frame has the following columns:\tabular{lll}{
-   \strong{Name} \tab \strong{Type} \tab \strong{Meaning} \cr
-   \code{file} \tab \code{character(1)} \tab File name of the runner script in \verb{tests/} that was sourced. \cr
-   \code{pass} \tab \code{logical(1)} \tab Whether or not the runner script signaled an error when sourced. \cr
-   \code{result} \tab any or \code{NA} \tab The return value of the runner, or \code{NA} if \code{pass == FALSE}. \cr
-   \code{error} \tab any or \code{NA} \tab The error signaled by the runner, or \code{NA} if \code{pass == TRUE}. \cr
-}
-}
 \description{
 Sources the \code{.R} files in the top-level of \verb{tests/} much like \verb{R CMD check}.
 These files are typically simple runners for tests nested in other

man/shinyAppTemplate.Rd

@@ -1,75 +0,0 @@
-% 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.
-}
-}

man/singleton.Rd

@@ -0,0 +1,20 @@
+\name{singleton}
+\alias{singleton}
+\alias{is.singleton}
+\title{Include content only once}
+\usage{
+singleton(x, value = TRUE)
+
+is.singleton(x)
+}
+\arguments{
+\item{x}{A \code{\link{tag}}, text, \code{\link{HTML}}, or list.}
+
+\item{value}{Whether the object should be a singleton.}
+}
+\description{
+Use \code{singleton} to wrap contents (tag, text, HTML, or lists) that should
+be included in the generated document only once, yet may appear in the
+document-generating code more than once. Only the first appearance of the
+content (in document order) will be used.
+}

man/suppressDependencies.Rd

@@ -0,0 +1,21 @@
+\name{suppressDependencies}
+\alias{suppressDependencies}
+\title{Suppress web dependencies}
+\usage{
+suppressDependencies(...)
+}
+\arguments{
+\item{...}{Names of the dependencies to suppress. For example,
+\code{"jquery"} or \code{"bootstrap"}.}
+}
+\description{
+This suppresses one or more web dependencies. It is meant to be used when a
+dependency (like a JavaScript or CSS file) is declared in raw HTML, in an
+HTML template.
+}
+\seealso{
+\code{\link{htmlTemplate}} for more information about using HTML
+  templates.
+
+\code{\link[htmltools]{htmlDependency}}
+}

man/tag.Rd

@@ -0,0 +1,82 @@
+\name{tag}
+\alias{tag}
+\alias{tagList}
+\alias{tagAppendAttributes}
+\alias{tagHasAttribute}
+\alias{tagGetAttribute}
+\alias{tagAppendChild}
+\alias{tagAppendChildren}
+\alias{tagSetChildren}
+\title{HTML Tag Object}
+\usage{
+tagList(...)
+
+tagAppendAttributes(tag, ...)
+
+tagHasAttribute(tag, attr)
+
+tagGetAttribute(tag, attr)
+
+tagAppendChild(tag, child)
+
+tagAppendChildren(tag, ..., list = NULL)
+
+tagSetChildren(tag, ..., list = NULL)
+
+tag(`_tag_name`, varArgs, .noWS = NULL)
+}
+\arguments{
+\item{...}{Unnamed items that comprise this list of tags.}
+
+\item{tag}{A tag to append child elements to.}
+
+\item{attr}{The name of an attribute.}
+
+\item{child}{A child element to append to a parent tag.}
+
+\item{list}{An optional list of elements. Can be used with or instead of the
+\code{...} items.}
+
+\item{_tag_name}{HTML tag name}
+
+\item{varArgs}{List of attributes and children of the element. Named list
+items become attributes, and unnamed list items become children. Valid
+children are tags, single-character character vectors (which become text
+nodes), and raw HTML (see \code{\link{HTML}}). You can also pass lists that
+contain tags, text nodes, and HTML.}
+
+\item{.noWS}{Character vector used to omit some of the whitespace that would
+normally be written around this tag. Valid options include \code{before},
+\code{after}, \code{outside}, \code{after-begin}, and \code{before-end}.
+Any number of these options can be specified.}
+}
+\value{
+An HTML tag object that can be rendered as HTML using
+  \code{\link{as.character}()}.
+}
+\description{
+\code{tag()} creates an HTML tag definition. Note that all of the valid HTML5
+tags are already defined in the \code{\link{tags}} environment so these
+functions should only be used to generate additional tags.
+\code{tagAppendChild()} and \code{tagList()} are for supporting package
+authors who wish to create their own sets of tags; see the contents of
+bootstrap.R for examples.
+}
+\examples{
+tagList(tags$h1("Title"),
+        tags$h2("Header text"),
+        tags$p("Text here"))
+
+# Can also convert a regular list to a tagList (internal data structure isn't
+# exactly the same, but when rendered to HTML, the output is the same).
+x <- list(tags$h1("Title"),
+          tags$h2("Header text"),
+          tags$p("Text here"))
+tagList(x)
+
+# suppress the whitespace between tags
+oneline <- tag("span",
+  tag("strong", "Super strong", .noWS="outside")
+)
+cat(as.character(oneline))
+}

man/testModule.Rd

@@ -0,0 +1,73 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/test-module.R
+\name{testModule}
+\alias{testModule}
+\alias{testServer}
+\title{Integration testing for Shiny modules or server functions}
+\usage{
+testModule(module, expr, ...)
+
+testServer(expr, appDir = NULL)
+}
+\arguments{
+\item{module}{The module to test}
+
+\item{expr}{Test code containing expectations. The test expression will run
+in the module's environment, meaning that the module's parameters (e.g.
+\code{input}, \code{output}, and \code{session}) will be available along with any other
+values created inside of the module.}
+
+\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}}.}
+
+\item{appDir}{The directory root of the Shiny application. If \code{NULL}, this function
+will work up the directory hierarchy --- starting with the current directory ---
+looking for a directory that contains an \code{app.R} or \code{server.R} file.}
+}
+\value{
+The result of evaluating \code{expr}.
+}
+\description{
+Offer a way to test the reactive interactions in Shiny --- either in Shiny
+modules or in the server portion of a Shiny application. For more
+information, visit \href{https://shiny.rstudio.com/articles/integration-testing.html}{the Shiny Dev Center article on integration testing}.
+}
+\examples{
+module <- function(input, output, session, multiplier = 2, prefix = "I am ") {
+  myreactive <- reactive({
+    input$x * multiplier
+  })
+  output$txt <- renderText({
+    paste0(prefix, myreactive())
+  })
+}
+
+# Basic Usage
+# -----------
+testModule(module, {
+  session$setInputs(x = 1)
+  # You're also free to use third-party
+  # testing packages like testthat:
+  #   expect_equal(myreactive(), 2)
+  stopifnot(myreactive() == 2)
+  stopifnot(output$txt == "I am 2")
+
+  session$setInputs(x = 2)
+  stopifnot(myreactive() == 4)
+  stopifnot(output$txt == "I am 4")
+  # Any additional arguments, below, are passed along to the module.
+}, multiplier = 2)
+
+# Advanced Usage
+# --------------
+multiplier_arg_name = "multiplier"
+more_args <- list(prefix = "I am ")
+testModule(module, {
+  session$setInputs(x = 1)
+  stopifnot(myreactive() == 2)
+  stopifnot(output$txt == "I am 2")
+  # !!/:= and !!! from rlang are used below to splice computed arguments
+  # into the testModule() argument list.
+}, !!multiplier_arg_name := 2, !!!more_args)
+}

man/testServer.Rd

@@ -1,58 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/test-server.R
-\name{testServer}
-\alias{testServer}
-\title{Reactive testing for Shiny server functions and modules}
-\usage{
-testServer(app, expr, ...)
-}
-\arguments{
-\item{app}{The path to an application or module to test. In addition to
-paths, applications may be represented by any object suitable for coercion
-to an \code{appObj} by \code{as.shiny.appobj}. Application server functions must
-include a \code{session} argument in order to be tested.}
-
-\item{expr}{Test code containing expectations. The test expression will run
-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.}
-}
-\value{
-The result of evaluating \code{expr}.
-}
-\description{
-A way to test the reactive interactions in Shiny applications. Reactive
-interactions are defined in the server function of applications and in
-modules.
-}
-\examples{
-server <- function(id, multiplier = 2, prefix = "I am ") {
-  moduleServer(id, function(input, output, session) {
-    myreactive <- reactive({
-      input$x * multiplier
-    })
-    output$txt <- renderText({
-      paste0(prefix, myreactive())
-    })
-  })
-}
-
-testServer(server, {
-  session$setInputs(x = 1)
-  # You're also free to use third-party
-  # testing packages like testthat:
-  #   expect_equal(myreactive(), 2)
-  stopifnot(myreactive() == 2)
-  stopifnot(output$txt == "I am 2")
-
-  session$setInputs(x = 2)
-  stopifnot(myreactive() == 4)
-  stopifnot(output$txt == "I am 4")
-  # Any additional arguments, below, are passed along to the module.
-}, multiplier = 2)
-}

man/validateCssUnit.Rd

@@ -0,0 +1,38 @@
+\name{validateCssUnit}
+\alias{validateCssUnit}
+\title{Validate proper CSS formatting of a unit}
+\usage{
+validateCssUnit(x)
+}
+\arguments{
+\item{x}{The unit to validate. Will be treated as a number of pixels if a
+unit is not specified.}
+}
+\value{
+A properly formatted CSS unit of length, if possible. Otherwise, will
+  throw an error.
+}
+\description{
+Checks that the argument is valid for use as a CSS unit of length.
+}
+\details{
+\code{NULL} and \code{NA} are returned unchanged.
+
+Single element numeric vectors are returned as a character vector with the
+number plus a suffix of \code{"px"}.
+
+Single element character vectors must be \code{"auto"} or \code{"inherit"},
+a number, or a length calculated by the \code{"calc"} CSS function.
+If the number has a suffix, it must be valid: \code{px},
+\code{\%}, \code{ch}, \code{em}, \code{rem}, \code{pt}, \code{in}, \code{cm},
+\code{mm}, \code{ex}, \code{pc}, \code{vh}, \code{vw}, \code{vmin}, or
+\code{vmax}.
+If the number has no suffix, the suffix \code{"px"} is appended.
+
+
+Any other value will cause an error to be thrown.
+}
+\examples{
+validateCssUnit("10\%")
+validateCssUnit(400)  #treated as '400px'
+}

man/withTags.Rd

@@ -0,0 +1,39 @@
+\name{withTags}
+\alias{withTags}
+\title{Evaluate an expression using \code{tags}}
+\usage{
+withTags(code)
+}
+\arguments{
+\item{code}{A set of tags.}
+}
+\description{
+This function makes it simpler to write HTML-generating code. Instead of
+needing to specify \code{tags} each time a tag function is used, as in
+\code{tags$div()} and \code{tags$p()}, code inside \code{withTags} is
+evaluated with \code{tags} searched first, so you can simply use
+\code{div()} and \code{p()}.
+}
+\details{
+If your code uses an object which happens to have the same name as an
+HTML tag function, such as \code{source()} or \code{summary()}, it will call
+the tag function. To call the intended (non-tags function), specify the
+namespace, as in \code{base::source()} or \code{base::summary()}.
+}
+\examples{
+# Using tags$ each time
+tags$div(class = "myclass",
+  tags$h3("header"),
+  tags$p("text")
+)
+
+# Equivalent to above, but using withTags
+withTags(
+  div(class = "myclass",
+    h3("header"),
+    p("text")
+  )
+)
+
+
+}

revdep/.gitignore

@@ -1,3 +0,0 @@
-*.noindex*
-data.sqlite
-failures.md

revdep/README.md

@@ -1,23 +0,0 @@
-# Platform
-
-|field    |value                        |
-|:--------|:----------------------------|
-|version  |R version 3.6.1 (2019-07-05) |
-|os       |macOS Catalina 10.15.3       |
-|system   |x86_64, darwin15.6.0         |
-|ui       |X11                          |
-|language |(EN)                         |
-|collate  |en_US.UTF-8                  |
-|ctype    |en_US.UTF-8                  |
-|tz       |America/New_York             |
-|date     |2020-03-05                   |
-
-# Dependencies
-
-|package |old   |new     |Δ  |
-|:-------|:-----|:-------|:--|
-|shiny   |1.4.0 |1.4.0.1 |*  |
-|rlang   |NA    |0.4.5   |*  |
-
-# Revdeps
-

revdep/problems.md

@@ -1 +0,0 @@
-*Wow, no problems at all. :)*

revdep/revdep-cran-comments.md

@@ -1,6 +0,0 @@
-## revdepcheck results
-
-We checked 836 reverse dependencies (719 from CRAN + 117 from BioConductor), comparing R CMD check results across CRAN and dev versions of this package.
-
- * We saw 0 new problems
- * We failed to check 0 packages

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

@@ -1,12 +1,13 @@
 
 b <- 2
 
-if (!identical(helper1, 123)){
+
+if (!identical(helper1, "abc")){
   stop("Missing helper1")
 }
-if (!identical(helper2, "abc")){
+if (!identical(helper2, 123)){
   stop("Missing helper2")
 }
-if (exists("A")){
+if (exists("a")){
   stop("a exists -- are we leaking in between test environments?")
 }

tests/test-modules/06_tabsets/app.R

@@ -48,7 +48,7 @@ ui <- fluidPage(
 )
 
 # Define server logic for random distribution app ----
-server <- function(input, output, session) {
+server <- function(input, output) {
 
   # Reactive expression to generate the requested distribution ----
   # This is called whenever the inputs change. The output functions

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

@@ -1,23 +0,0 @@
-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

@@ -1,5 +0,0 @@
-# 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

@@ -1,30 +0,0 @@
-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

@@ -1,11 +0,0 @@
-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

@@ -1,18 +0,0 @@
-# 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

@@ -1,11 +0,0 @@
-# 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

@@ -1,5 +0,0 @@
-# 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/test-modules/server_r/server.R

@@ -1,7 +1,7 @@
 library(shiny)
 
 # Define server logic for random distribution app ----
-function(input, output, session) {
+function(input, output) {
 
   # Reactive expression to generate the requested distribution ----
   # This is called whenever the inputs change. The output functions

tests/testthat/test-actionButton.R

@@ -1,59 +0,0 @@
-context("actionButton")
-
-test_that("Action button accepts class arguments", {
-  make_button <- function(class) {
-    if (missing(class)) {
-      actionButton("id", "label")
-    } else {
-      actionButton("id", "label", class = class)
-    }
-  }
-  act <- make_button()
-  get_class <- function(act) {
-    act_html <- format(act)
-    regmatches(act_html, regexec("class=\"[^\"]\"", act_html))[[1]]
-  }
-  act_class <- get_class(act)
-  expect_equal(
-    get_class(make_button(NULL)), act_class
-  )
-  expect_equal(
-    get_class(make_button(NA)), act_class
-  )
-  expect_equal(
-    get_class(make_button("extra")), sub("\"$", " extra\"", act_class)
-  )
-  expect_equal(
-    get_class(make_button("extra extra2")), sub("\"$", " extra extra2\"", act_class)
-  )
-})
-
-
-
-test_that("Action link accepts class arguments", {
-  make_link <- function(class) {
-    if (missing(class)) {
-      actionLink("id", "label")
-    } else {
-      actionLink("id", "label", class = class)
-    }
-  }
-  act <- make_link()
-  get_class <- function(act) {
-    act_html <- format(act)
-    regmatches(act_html, regexec("class=\"[^\"]\"", act_html))[[1]]
-  }
-  act_class <- get_class(act)
-  expect_equal(
-    get_class(make_link(NULL)), act_class
-  )
-  expect_equal(
-    get_class(make_link(NA)), act_class
-  )
-  expect_equal(
-    get_class(make_link("extra")), sub("\"$", " extra\"", act_class)
-  )
-  expect_equal(
-    get_class(make_link("extra extra2")), sub("\"$", " extra extra2\"", act_class)
-  )
-})

tests/testthat/test-inline-markdown.R

@@ -1,69 +0,0 @@
-context("inline-markdown")
-
-test_that("Markdown without newlines translates", {
-  expect_equivalent(markdown("# a top level"), HTML("<h1>a top level</h1>\n"))
-  expect_equivalent(markdown("## a subheading"), HTML("<h2>a subheading</h2>\n"))
-  expect_equivalent(markdown("[rstudio](https://rstudio.com)"), HTML("<p><a href=\"https://rstudio.com\">rstudio</a></p>\n"))
-})
-
-test_that("HTML has correct attributes", {
-  html <- markdown("a paragraph", .noWS = "outside")
-  expect_is(html, "html")
-  expect_equal(attr(html, "noWS"), "outside")
-})
-
-test_that("Github extensions are on by default", {
-  html <- markdown("a ~paragraph~ with a link: https://example.com")
-  expect_equivalent(html, HTML("<p>a <del>paragraph</del> with a link: <a href=\"https://example.com\">https://example.com</a></p>\n"))
-})
-
-test_that("Github extensions can be disabled", {
-  html <- markdown("a ~paragraph~", extensions = FALSE)
-  expect_equivalent(html, HTML("<p>a ~paragraph~</p>\n"))
-})
-
-test_that("Additional options are respected", {
-  html <- markdown("a ~paragraph~", extensions = FALSE, sourcepos = TRUE)
-  expect_equivalent(html, HTML("<p data-sourcepos=\"1:1-1:13\">a ~paragraph~</p>\n"))
-})
-
-test_that("Multiline markdown works properly", {
-  essay <- "
-   # The [Louisiana Purchase](https://en.wikipedia.org/wiki/Louisiana_Purchase)
-   
-   Larry Sellers
-   Mrs. Jamtoss
-   History Period 4
-
-   ## Introduction
-
-   The most important purchase in history is the Lousiana
-   Purchase. It was also the most important evente. It
-   happened in President Jeffersons 1st administration.
-   Its when the United States bought 827,987 square miles
-   of lande from the French guys.
-
-   The end."
-
-  # Ensure markdown string contains leading whitespace, which might be removed
-  # by some editors. We care about it here to ensure blank are ignored in the
-  # conversion to markdown. The line being tested here is the one after the one
-  # that starts with "   # The [Louis...". It should contain three spaces.
-  expect_equal(strsplit(essay, "\n")[[1]][[3]], "   ")
-
-  expected <- HTML(paste0(c(
-    "<h1>The <a href=\"https://en.wikipedia.org/wiki/Louisiana_Purchase\">Louisiana Purchase</a></h1>",
-    "<p>Larry Sellers",
-    "Mrs. Jamtoss",
-    "History Period 4</p>",
-    "<h2>Introduction</h2>",
-    "<p>The most important purchase in history is the Lousiana",
-    "Purchase. It was also the most important evente. It",
-    "happened in President Jeffersons 1st administration.",
-    "Its when the United States bought 827,987 square miles",
-    "of lande from the French guys.</p>",
-    "<p>The end.</p>",
-    ""
-  ), collapse = "\n"))
-  expect_equivalent(markdown(essay), expected)
-})

tests/testthat/test-pkgdown.R

@@ -1,17 +1,40 @@
-
 context("pkgdown")
 
-
-test_that("pkgdown works", {
-  skip_on_cran()
-
-  # only test pkgdown from within `devtools::test()`
-  ## `./tools` will not exist when shiny is installed
-  pkgdown_file <- "../../tools/documentation/checkPkgdown.R"
-  if (file.exists(pkgdown_file)) {
-    source(pkgdown_file)
+get_exported <- function() {
+  if (all(file.exists(c('../../inst/_pkgdown.yml', '../../man')))) {
+    # We're running tests on a source tree, likely by devtools::test()
+    sub("\\.Rd", "", list.files("../../man", pattern = "*.Rd"))
+  } else {
+    # We're testing an installed package, possibly for R CMD check
+    unique(unname(readRDS("../../shiny/help/aliases.rds")))
   }
+}
 
-  expect_true(TRUE)
+get_indexed <- function(f = system.file('_pkgdown.yml', package = 'shiny')) {
+  unlist(lapply(yaml::yaml.load_file(f)$reference, function(x) x$contents))
+}
 
+test_that("All man pages have an entry in _pkgdown.yml", {
+  skip_on_cran()
+  indexed_topics <- get_indexed()
+  all_topics     <- get_exported()
+
+  ## Known not to be indexed
+  known_unindexed <- c("shiny-package", "stacktrace", "knitr_methods",
+                       "pageWithSidebar", "headerPanel", "shiny.appobj",
+                       "deprecatedReactives")
+
+  ## This test ensures that every documented topic is included in
+  ## staticdocs/index.r, unless explicitly waived by specifying it
+  ## in the known_unindexed variable above.
+  missing <- setdiff(all_topics, c(known_unindexed, indexed_topics))
+  unknown <- setdiff(c(known_unindexed, indexed_topics), all_topics)
+  expect_equal(length(missing), 0,
+    info = paste("Functions missing from _pkgdown.yml:\n",
+      paste("  ", missing, sep = "", collapse = "\n"),
+      sep = ""))
+  expect_equal(length(unknown), 0,
+    info = paste("Unrecognized functions in _pkgdown.yml:\n",
+      paste("  ", unknown, sep = "", collapse = "\n"),
+      sep = ""))
 })

tests/testthat/test-test-module.R

@@ -0,0 +1,738 @@
+context("testModule")
+
+library(promises)
+library(future)
+plan(multisession)
+
+test_that("testModule passes dots", {
+  module <- function(input, output, session, someArg) {
+    expect_false(missing(someArg))
+    expect_equal(someArg, 123)
+  }
+  testModule(module, {}, someArg = 123)
+})
+
+test_that("testModule passes dynamic dots", {
+  module <- function(input, output, session, someArg) {
+    expect_false(missing(someArg))
+    expect_equal(someArg, 123)
+  }
+
+  # Test with !!! to splice in a whole named list constructed with base::list()
+  moreArgs <- list(someArg = 123)
+  testModule(module, {}, !!!moreArgs)
+
+  # Test with !!/:= to splice in an argument name
+  argName <- "someArg"
+  testModule(module, {}, !!argName := 123)
+})
+
+test_that("testModule handles observers", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0, y = 0)
+    observe({
+      rv$x <- input$x * 2
+    })
+    observe({
+      rv$y <- rv$x
+    })
+    output$txt <- renderText({
+      paste0("Value: ", rv$x)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(x=1)
+    expect_equal(rv$y, 2)
+    expect_equal(rv$x, 2)
+    expect_equal(output$txt, "Value: 2")
+
+    session$setInputs(x=2)
+    expect_equal(rv$x, 4)
+    expect_equal(rv$y, 4)
+    expect_equal(output$txt, "Value: 4")
+  })
+})
+
+test_that("inputs aren't directly assignable", {
+  module <- function(input, output, session) {
+  }
+
+  testModule(module, {
+    session$setInputs(x = 0)
+    expect_error({ input$x <- 1 }, "Attempted to assign value to a read-only")
+    expect_error({ input$y <- 1 }, "Attempted to assign value to a read-only")
+  })
+})
+
+test_that("testModule handles more complex expressions", {
+  module <- function(input, output, session){
+    output$txt <- renderText({
+      input$x
+    })
+  }
+
+  testModule(module, {
+    for (i in 1:5){
+      session$setInputs(x=i)
+      expect_equal(output$txt, as.character(i))
+    }
+    expect_equal(output$txt, "5")
+
+    if(TRUE){
+      session$setInputs(x="abc")
+      expect_equal(output$txt, "abc")
+    }
+  })
+})
+
+test_that("testModule handles reactiveVal", {
+  module <- function(input, output, session) {
+    x <- reactiveVal(0)
+    observe({
+      x(input$y + input$z)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(y=1, z=2)
+
+    expect_equal(x(), 3)
+
+    session$setInputs(z=3)
+    expect_equal(x(), 4)
+
+    session$setInputs(y=5)
+    expect_equal(x(), 8)
+  })
+})
+
+test_that("testModule handles reactives with complex dependency tree", {
+  module <- function(input, output, session) {
+    x <- reactiveValues(x=1)
+    r <- reactive({
+      x$x + input$a + input$b
+    })
+    r2 <- reactive({
+      r() + input$c
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(a=1, b=2, c=3)
+    expect_equal(r(), 4)
+    expect_equal(r2(), 7)
+
+    session$setInputs(a=2)
+    expect_equal(r(), 5)
+    expect_equal(r2(), 8)
+
+    session$setInputs(b=0)
+    expect_equal(r2(), 6)
+    expect_equal(r(), 3)
+
+    session$setInputs(c=4)
+    expect_equal(r(), 3)
+    expect_equal(r2(), 7)
+  })
+})
+
+test_that("testModule handles reactivePoll", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0)
+    rp <- reactivePoll(50, session, function(){ rnorm(1) }, function(){
+      isolate(rv$x <- rv$x + 1)
+      rnorm(1)
+    })
+
+    observe({rp()})
+  }
+
+  testModule(module, {
+    expect_equal(rv$x, 1)
+
+    for (i in 1:4){
+      session$elapse(50)
+    }
+
+    expect_equal(rv$x, 5)
+  })
+})
+
+test_that("testModule handles reactiveTimer", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0)
+
+    rp <- reactiveTimer(50)
+    observe({
+      rp()
+      isolate(rv$x <- rv$x + 1)
+    })
+  }
+
+  testModule(module, {
+    expect_equal(rv$x, 1)
+
+    session$elapse(200)
+
+    expect_equal(rv$x, 5)
+  })
+})
+
+test_that("testModule handles debounce/throttle", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(t = 0, d = 0)
+    react <- reactive({
+      input$y
+    })
+    rt <- throttle(react, 100)
+    rd <- debounce(react, 100)
+
+    observe({
+      rt() # Invalidate this block on the timer
+      isolate(rv$t <- rv$t + 1)
+    })
+
+    observe({
+      rd()
+      isolate(rv$d <- rv$d + 1)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(y = TRUE)
+    expect_equal(rv$d, 1)
+    for (i in 2:5){
+      session$setInputs(y = FALSE)
+      session$elapse(51)
+      session$setInputs(y = TRUE)
+      expect_equal(rv$t, i-1)
+      session$elapse(51) # TODO: we usually don't have to pad by a ms, but here we do. Investigate.
+      expect_equal(rv$t, i)
+    }
+    # Never sufficient time to debounce. Not incremented
+    expect_equal(rv$d, 1)
+    session$elapse(50)
+
+    # Now that 100ms has passed since the last update, debounce should have triggered
+    expect_equal(rv$d, 2)
+  })
+})
+
+test_that("testModule wraps output in an observer", {
+  testthat::skip("I'm not sure of a great way to test this without timers.")
+  # And honestly it's so foundational in what we're doing now that it might not be necessary to test?
+
+
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x=0)
+    rp <- reactiveTimer(50)
+    output$txt <- renderText({
+      rp()
+      isolate(rv$x <- rv$x + 1)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(x=1)
+    # Timers only tick if they're being observed. If the output weren't being
+    # wrapped in an observer, we'd see the value of rv$x initialize to zero and
+    # only increment when we evaluated the output. e.g.:
+    #
+    # expect_equal(rv$x, 0)
+    # Sys.sleep(1)
+    # expect_equal(rv$x, 0)
+    # output$txt()
+    # expect_equal(rv$x, 1)
+
+    expect_equal(rv$x, 1)
+    expect_equal(output$txt, "1")
+    Sys.sleep(.05)
+    Sys.sleep(.05)
+    expect_gt(rv$x, 1)
+    expect_equal(output$txt, as.character(rv$x))
+  })
+
+  # FIXME:
+  #  - Do we want the output to be accessible natively, or some $get() on the output? If we do a get() we could
+  #    do more helpful spy-type things around exec count.
+  #  - plots and such?
+})
+
+test_that("testModule works with async", {
+  module <- function(input, output, session) {
+    output$txt <- renderText({
+      val <- input$x
+      future({ val })
+    })
+
+    output$error <- renderText({
+      future({ stop("error here") })
+    })
+
+    output$sync <- renderText({
+      # No promises here
+      "abc"
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(x=1)
+    expect_equal(output$txt, "1")
+    expect_equal(output$sync, "abc")
+
+    # Error gets thrown repeatedly
+    expect_error(output$error, "error here")
+    expect_error(output$error, "error here")
+
+    # Responds reactively
+    session$setInputs(x=2)
+    expect_equal(output$txt, "2")
+    # Error still thrown
+    expect_error(output$error, "error here")
+  })
+})
+
+test_that("testModule works with multiple promises in parallel", {
+  module <- function(input, output, session) {
+    output$txt1 <- renderText({
+      future({
+        Sys.sleep(1)
+        1
+      })
+    })
+
+    output$txt2 <- renderText({
+      future({
+        Sys.sleep(1)
+        2
+      })
+    })
+  }
+
+  testModule(module, {
+    # As we enter this test code, the promises will still be running in the background.
+    # We'll need to give them ~2s (plus overhead) to complete
+    startMS <- as.numeric(Sys.time()) * 1000
+    expect_equal(output$txt1, "1") # This first call will block waiting for the promise to return
+    expect_equal(output$txt2, "2")
+    expect_equal(output$txt2, "2") # Now that we have the values, access should not incur a 1s delay.
+    expect_equal(output$txt1, "1")
+    expect_equal(output$txt1, "1")
+    expect_equal(output$txt2, "2")
+    endMS <- as.numeric(Sys.time()) * 1000
+
+    # We'll pad quite a bit because promises can introduce some lag. But the point we're trying
+    # to prove is that we're not hitting a 1s delay for each output access, which = 6000ms. If we're
+    # under that, then things are likely working.
+    expect_lt(endMS - startMS, 4000)
+  })
+})
+
+test_that("testModule handles async errors", {
+  module <- function(input, output, session, arg1, arg2){
+    output$err <- renderText({
+      future({ "my error"}) %...>%
+        stop() %...>%
+        print() # Extra steps after the error
+    })
+
+    output$safe <- renderText({
+      future({ safeError("my safe error") }) %...>%
+        stop()
+    })
+  }
+
+  testModule(module, {
+    expect_error(output$err, "my error")
+    # TODO: helper for safe errors so users don't have to learn "shiny.custom.error"?
+    expect_error(output$safe, "my safe error", class="shiny.custom.error")
+  })
+})
+
+test_that("testModule handles modules with additional arguments", {
+  module <- function(input, output, session, arg1, arg2){
+    output$txt1 <- renderText({
+      arg1
+    })
+
+    output$txt2 <- renderText({
+      arg2
+    })
+
+    output$inp <- renderText({
+      input$x
+    })
+  }
+
+  testModule(module, {
+    expect_equal(output$txt1, "val1")
+    expect_equal(output$txt2, "val2")
+  }, arg1="val1", arg2="val2")
+})
+
+test_that("testModule captures htmlwidgets", {
+  # TODO: use a simple built-in htmlwidget instead of something complex like dygraph
+  if (!requireNamespace("dygraphs")){
+    testthat::skip("dygraphs not available to test htmlwidgets")
+  }
+
+  if (!requireNamespace("jsonlite")){
+    testthat::skip("jsonlite not available to test htmlwidgets")
+  }
+
+  module <- function(input, output, session){
+    output$dy <- dygraphs::renderDygraph({
+      dygraphs::dygraph(data.frame(outcome=0:5, year=2000:2005))
+    })
+  }
+
+  testModule(module, {
+    # Really, this test should be specific to each htmlwidget. Here, we don't want to bind ourselves
+    # to the current JSON structure of dygraphs, so we'll just check one element to see that the raw
+    # JSON was exposed and is accessible in tests.
+    d <- jsonlite::fromJSON(output$dy)$x$data
+    expect_equal(d[1,], 0:5)
+    expect_equal(d[2,], 2000:2005)
+  })
+})
+
+test_that("testModule captures renderUI", {
+  module <- function(input, output, session){
+    output$ui <- renderUI({
+      tags$a(href="https://rstudio.com", "hello!")
+    })
+  }
+
+  testModule(module, {
+    expect_equal(output$ui$deps, list())
+    expect_equal(as.character(output$ui$html), "<a href=\"https://rstudio.com\">hello!</a>")
+  })
+})
+
+test_that("testModule captures base graphics outputs", {
+  module <- function(input, output, session){
+    output$fixed <- renderPlot({
+      plot(1,1)
+    }, width=300, height=350)
+
+    output$dynamic <- renderPlot({
+      plot(1,1)
+    })
+  }
+
+  testModule(module, {
+    # We aren't yet able to create reproducible graphics, so this test is intentionally pretty
+    # limited.
+    expect_equal(output$fixed$width, 300)
+    expect_equal(output$fixed$height, 350)
+    expect_match(output$fixed$src, "^data:image/png;base64,")
+
+    # Ensure that the plot defaults to a reasonable size.
+    expect_equal(output$dynamic$width, 600)
+    expect_equal(output$dynamic$height, 400)
+    expect_match(output$dynamic$src, "^data:image/png;base64,")
+
+    # TODO: how do you customize automatically inferred plot sizes?
+    # session$setPlotMeta("dynamic", width=600, height=300) ?
+  })
+})
+
+test_that("testModule captures ggplot2 outputs", {
+  if (!requireNamespace("ggplot2")){
+    testthat::skip("ggplot2 not available")
+  }
+
+  module <- function(input, output, session){
+    output$fixed <- renderPlot({
+      ggplot2::qplot(iris$Sepal.Length, iris$Sepal.Width)
+    }, width=300, height=350)
+
+    output$dynamic <- renderPlot({
+      ggplot2::qplot(iris$Sepal.Length, iris$Sepal.Width)
+    })
+  }
+
+  testModule(module, {
+    expect_equal(output$fixed$width, 300)
+    expect_equal(output$fixed$height, 350)
+    expect_match(output$fixed$src, "^data:image/png;base64,")
+
+    # Ensure that the plot defaults to a reasonable size.
+    expect_equal(output$dynamic$width, 600)
+    expect_equal(output$dynamic$height, 400)
+    expect_match(output$dynamic$src, "^data:image/png;base64,")
+  })
+})
+
+test_that("testModule exposes the returned value from the module", {
+  module <- function(input, output, session){
+    reactive({
+      return(input$a + input$b)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(a=1, b=2)
+    expect_equal(session$returned(), 3)
+
+    # And retains reactivity
+    session$setInputs(a=2)
+    expect_equal(session$returned(), 4)
+  })
+})
+
+test_that("testModule handles synchronous errors", {
+  module <- function(input, output, session, arg1, arg2){
+    output$err <- renderText({
+      stop("my error")
+    })
+
+    output$safe <- renderText({
+      stop(safeError("my safe error"))
+    })
+  }
+
+  testModule(module, {
+    expect_error(output$err, "my error")
+    # TODO: helper for safe errors so users don't have to learn "shiny.custom.error"?
+    expect_error(output$safe, "my safe error", class="shiny.custom.error")
+  })
+})
+
+test_that("accessing a non-existant output gives an informative message", {
+  module <- function(input, output, session){}
+
+  testModule(module, {
+    expect_error(output$dontexist, "hasn't been defined yet: output\\$dontexist")
+  })
+})
+
+test_that("testModule works with nested modules", {
+  outerModule <- function(input, output, session) {
+    r1 <- reactive({ input$x + 1})
+    r2 <- callModule(innerModule, "innerModule", r1)
+    output$someVar <- renderText(r2())
+  }
+
+  innerModule <- function(input, output, session, r) {
+    reactive(paste("a value:", r()))
+  }
+
+  testModule(outerModule, {
+    session$setInputs(x = 1)
+    expect_equal(output$someVar, "a value: 2")
+  })
+})
+
+test_that("testModule calls can be nested", {
+  outerModule <- function(input, output, session) {
+    doubled <- reactive({ input$x * 2 })
+    innerModule <- function(input, output, session) {
+      quadrupled <- reactive({ doubled() * 2 })
+    }
+  }
+
+  testModule(outerModule, {
+    session$setInputs(x = 1)
+    expect_equal(doubled(), 2)
+    testModule(innerModule, {
+      expect_equal(quadrupled(), 4)
+    })
+  })
+})
+
+test_that("testModule returns a meaningful result", {
+  result <- testModule(function(input, output, session) {
+    reactive({ input$x * 2 })
+  }, {
+    session$setInputs(x = 2)
+    session$returned()
+  })
+  expect_equal(result, 4)
+})
+
+test_that("assigning an output in a module function with a non-function errors", {
+  module <- function(input, output, session) {
+    output$someVar <- 123
+  }
+
+  expect_error(testModule(module, {}), "^Unexpected")
+})
+
+test_that("testServer works", {
+  # app.R
+  testServer({
+    session$setInputs(dist="norm", n=5)
+    expect_length(d(), 5)
+
+    session$setInputs(dist="unif", n=6)
+    expect_length(d(), 6)
+  }, appDir=test_path("..", "test-modules", "06_tabsets"))
+
+  # server.R
+  testServer({
+    session$setInputs(dist="norm", n=5)
+    expect_length(d(), 5)
+
+    session$setInputs(dist="unif", n=6)
+    expect_length(d(), 6)
+  }, appDir=test_path("..", "test-modules", "server_r"))
+})
+
+test_that("testServer works when referencing external globals", {
+  # If global is defined at the top of app.R outside of the server function.
+  testServer({
+    expect_equal(get("global", session$env), 123)
+  }, appDir=test_path("..", "test-modules", "06_tabsets"))
+})
+
+test_that("testModule allows lexical environment access through session$env", {
+  m <- local({
+    a_var <- 123
+    function(input, output, session) {
+      b_var <- 321
+    }
+  })
+  expect_false(exists("a_var", inherits = FALSE))
+  testModule(m, {
+    expect_equal(b_var, 321)
+    expect_equal(get("a_var", session$env), 123)
+  })
+})
+
+test_that("Module shadowing can be mitigated with unquote", {
+  i <- 0
+  inc <- function() i <<- i+1
+
+  m <- local({
+    function(input, output, session) {
+      inc <- function() stop("I should never be called")
+    }
+  })
+
+  testModule(m, {
+    expect_is(inc, "function")
+    expect_false(identical(inc, !!inc))
+    !!inc()
+  })
+
+  expect_equal(i, 1)
+})
+
+test_that("testModule handles invalidateLater", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0)
+    observe({
+      isolate(rv$x <- rv$x + 1)
+      # We're only testing one invalidation
+      if (isolate(rv$x) <= 1){
+        invalidateLater(50)
+      }
+    })
+  }
+
+  testModule(module, {
+    # Should have run once
+    expect_equal(rv$x, 1)
+
+    session$elapse(49)
+    expect_equal(rv$x, 1)
+
+    session$elapse(1)
+    # Should have been incremented now
+    expect_equal(rv$x, 2)
+  })
+})
+
+test_that("session ended handlers work", {
+  module <- function(input, output, session){}
+
+  testModule(module, {
+    rv <- reactiveValues(closed = FALSE)
+    session$onEnded(function(){
+      rv$closed <- TRUE
+    })
+
+    expect_equal(session$isEnded(), FALSE)
+    expect_equal(session$isClosed(), FALSE)
+    expect_false(rv$closed, FALSE)
+
+    session$close()
+
+    expect_equal(session$isEnded(), TRUE)
+    expect_equal(session$isClosed(), TRUE)
+    expect_false(rv$closed, TRUE)
+  })
+})
+
+test_that("session flush handlers work", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0, flushCounter = 0, flushedCounter = 0,
+                         flushOnceCounter = 0, flushedOnceCounter = 0)
+
+    onFlush(function(){rv$flushCounter <- rv$flushCounter + 1}, once=FALSE)
+    onFlushed(function(){rv$flushedCounter <- rv$flushedCounter + 1}, once=FALSE)
+    onFlushed(function(){rv$flushOnceCounter <- rv$flushOnceCounter + 1}, once=TRUE)
+    onFlushed(function(){rv$flushedOnceCounter <- rv$flushedOnceCounter + 1}, once=TRUE)
+
+    observe({
+      rv$x <- input$x * 2
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(x=1)
+    expect_equal(rv$x, 2)
+    # We're not concerned with the exact values here -- only that they increase
+    fc <- rv$flushCounter
+    fdc <- rv$flushedCounter
+
+    session$setInputs(x=2)
+    expect_gt(rv$flushCounter, fc)
+    expect_gt(rv$flushedCounter, fdc)
+
+    # These should have only run once
+    expect_equal(rv$flushOnceCounter, 1)
+    expect_equal(rv$flushedOnceCounter, 1)
+
+  })
+})
+
+test_that("findApp errors with no app", {
+  calls <- 0
+  nothingExists <- function(path){
+    calls <<- calls + 1
+    FALSE
+  }
+  fa <- rewire(findApp, file.exists.ci=nothingExists)
+  expect_error(
+    expect_warning(fa("/some/path/here"), "No such file or directory"), # since we just made up a path
+    "No shiny app was found in ")
+  expect_equal(calls, 4 * 2) # Checks here, path, some, and / -- looking for app.R and server.R for each
+})
+
+test_that("findApp works with app in current or parent dir", {
+  calls <- 0
+  cd <- normalizePath(".")
+  mockExists <- function(path){
+    # Only TRUE if looking for server.R or app.R in current Dir
+    calls <<- calls + 1
+
+    path <- normalizePath(path, mustWork = FALSE)
+
+    appPath <- normalizePath(file.path(cd, "app.R"), mustWork = FALSE)
+    serverPath <- normalizePath(file.path(cd, "server.R"), mustWork = FALSE)
+    return(path %in% c(appPath, serverPath))
+  }
+  fa <- rewire(findApp, file.exists.ci=mockExists)
+  expect_equal(fa(), cd)
+  expect_equal(calls, 1) # Should get a hit on the first call and stop
+
+  # Reset and point to the parent dir
+  calls <- 0
+  cd <- normalizePath("..") # TODO: won't work if running tests in the root dir.
+  f <- fa()
+  expect_equal(normalizePath(f, mustWork = FALSE), cd)
+  expect_equal(calls, 3) # Two for current dir and hit on the first in the parent
+})

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

@@ -1,83 +0,0 @@
-context("testServer app")
-
-library(shiny)
-library(testthat)
-
-test_that("testServer works with dir app", {
-  # app.R
-  testServer(test_path("..", "test-modules", "06_tabsets"), {
-    session$setInputs(dist="norm", n=5)
-    expect_length(d(), 5)
-
-    session$setInputs(dist="unif", n=6)
-    expect_length(d(), 6)
-  })
-
-  # server.R
-  testServer(test_path("..", "test-modules", "server_r"), {
-    session$setInputs(dist="norm", n=5)
-    expect_length(d(), 5)
-
-    session$setInputs(dist="unif", n=6)
-    expect_length(d(), 6)
-  })
-})
-
-test_that("testServer works when referencing external globals", {
-  # If global is defined at the top of app.R outside of the server function.
-  testServer(test_path("..", "test-modules", "06_tabsets"), {
-    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)
-  })
-})

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

@@ -1,89 +0,0 @@
-context("testServer nesting")
-
-library(shiny)
-library(testthat)
-
-test_that("Nested modules", {
-  child <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      output$txt <- renderText("bar")
-    })
-  }
-
-  parent <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      output$txt <- renderText("foo")
-      child("child-id")
-    })
-  }
-
-  testServer(parent, {
-    expect_equal(output$txt, "foo")
-  }, id = "parent-id")
-
-})
-
-test_that("Lack of ID", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      output$txt <- renderText(session$ns("x"))
-    })
-  }
-
-  testServer(module, {
-    expect_equal(output$txt, "foo-x")
-  }, id = "foo")
-})
-
-test_that("testServer works with nested module servers", {
-  outerModule <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      r1 <- reactive({ input$x + 1})
-      r2 <- innerModule("inner", r1)
-      output$someVar <- renderText(r2())
-    })
-  }
-
-  innerModule <- function(id, r) {
-    moduleServer(id, function(input, output, session) {
-      reactive(paste("a value:", r()))
-    })
-  }
-
-  testServer(outerModule, {
-    session$setInputs(x = 1)
-    expect_equal(output$someVar, "a value: 2")
-  }, id = "foo")
-})
-
-test_that("testServer calls do not nest in module functions", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      x <- 1
-      testServer(function(id) {
-        moduleServer(id, function(input, output, session) {
-          y <- x + 1
-        })
-      })
-    })
-  }
-
-  expect_error(testServer(module, {}), regexp = "Modules may not call testServer()")
-})
-
-test_that("testServer calls do not nest in test exprs", {
-  module <- function(id) {
-    x <- 1
-    moduleServer(id, function(input, output, session) {
-      inner <- function(id) {
-        moduleServer(id, function(input, output, session) {
-          y <- x + 1
-        })
-      }
-    })
-  }
-
-  expect_error(testServer(module, {
-    testServer(inner, {})
-  }), regexp = "Test expressions may not call testServer()")
-})

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

@@ -1,82 +0,0 @@
-context("testServer scope")
-
-library(shiny)
-library(testthat)
-
-test_that("Variables outside of the module are inaccessible", {
-  module <- local({
-    outside <- 123
-    function(id, x) {
-      y <- x+1
-      moduleServer(id, function(input, output, session) {
-        z <- y+1
-      })
-    }
-  }, envir = new.env(parent = globalenv()))
-
-  testServer(module, {
-    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", {
-  module <- local({
-    function(id, x) {
-      moduleServer(id, function(input, output, session) {
-        y <- 1
-      })
-    }
-  }, envir = new.env(parent = globalenv()))
-
-  x <- 99
-  z <- 123
-
-  testServer(module, {
-    expect_equal(x, 0)
-    expect_equal(y, 1)
-    expect_equal(z, 123)
-  }, x = 0)
-})
-
-test_that("testServer allows lexical environment access through session$env", {
-  module <- local({
-    a_var <- 123
-    function(id) {
-      moduleServer(id, function(input, output, session) {
-        b_var <- 321
-      })
-    }
-  })
-
-  expect_false(exists("a_var", inherits = FALSE))
-
-  testServer(module, {
-    expect_equal(b_var, 321)
-    expect_equal(get("a_var", session$env, inherits = TRUE), 123)
-    expect_false(exists("a_var", inherits = FALSE))
-  })
-})
-
-test_that("Shadowing can be mitigated with unquote", {
-  i <- 0
-  inc <- function() i <<- i+1
-
-  module <- local({
-    function(id) {
-      moduleServer(id, function(input, output, session) {
-        inc <- function() stop("I should never be called")
-      })
-    }
-  }, envir = globalenv())
-
-  testServer(module, {
-    expect_is(inc, "function")
-    expect_false(identical(inc, !!inc))
-    !!inc()
-  })
-
-  expect_equal(i, 1)
-})

tests/testthat/test-test-server.R

@@ -1,664 +0,0 @@
-context("testServer")
-
-library(shiny)
-library(testthat)
-library(future)
-
-test_that("testServer passes dots", {
-  module <- function(id, someArg) {
-    expect_false(missing(someArg))
-    moduleServer(id, function(input, output, session) {
-      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)
-})
-
-test_that("testServer handles observers", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      rv <- reactiveValues(x = 0, y = 0)
-      observe({
-        rv$x <- input$x * 2
-      })
-      observe({
-        rv$y <- rv$x
-      })
-      output$txt <- renderText({
-        paste0("Value: ", rv$x)
-      })
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(x=1)
-    expect_equal(rv$y, 2)
-    expect_equal(rv$x, 2)
-    expect_equal(output$txt, "Value: 2")
-
-    session$setInputs(x=2)
-    expect_equal(rv$x, 4)
-    expect_equal(rv$y, 4)
-    expect_equal(output$txt, "Value: 4")
-  })
-})
-
-test_that("inputs aren't directly assignable", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(x = 0)
-    expect_error({ input$x <- 1 })
-    expect_error({ input$y <- 1 })
-  })
-})
-
-test_that("testServer handles more complex expressions", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session){
-      output$txt <- renderText({
-        input$x
-      })
-    })
-  }
-
-  testServer(module, {
-    for (i in 1:5){
-      session$setInputs(x=i)
-      expect_equal(output$txt, as.character(i))
-    }
-    expect_equal(output$txt, "5")
-
-    if(TRUE){
-      session$setInputs(x="abc")
-      expect_equal(output$txt, "abc")
-    }
-  })
-})
-
-test_that("testServer handles reactiveVal", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      x <- reactiveVal(0)
-      observe({
-        x(input$y + input$z)
-      })
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(y=1, z=2)
-
-    expect_equal(x(), 3)
-
-    session$setInputs(z=3)
-    expect_equal(x(), 4)
-
-    session$setInputs(y=5)
-    expect_equal(x(), 8)
-  })
-})
-
-test_that("testServer handles reactives with complex dependency tree", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      x <- reactiveValues(x=1)
-      r <- reactive({
-        x$x + input$a + input$b
-      })
-      r2 <- reactive({
-        r() + input$c
-      })
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(a=1, b=2, c=3)
-    expect_equal(r(), 4)
-    expect_equal(r2(), 7)
-
-    session$setInputs(a=2)
-    expect_equal(r(), 5)
-    expect_equal(r2(), 8)
-
-    session$setInputs(b=0)
-    expect_equal(r2(), 6)
-    expect_equal(r(), 3)
-
-    session$setInputs(c=4)
-    expect_equal(r(), 3)
-    expect_equal(r2(), 7)
-  })
-})
-
-test_that("testServer handles reactivePoll", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      rv <- reactiveValues(x = 0)
-      rp <- reactivePoll(50, session, function(){ rnorm(1) }, function(){
-        isolate(rv$x <- rv$x + 1)
-        rnorm(1)
-      })
-
-      observe({rp()})
-    })
-  }
-
-  testServer(module, {
-    expect_equal(rv$x, 1)
-
-    for (i in 1:4){
-      session$elapse(50)
-    }
-
-    expect_equal(rv$x, 5)
-  })
-})
-
-test_that("testServer handles reactiveTimer", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      rv <- reactiveValues(x = 0)
-
-      rp <- reactiveTimer(50)
-      observe({
-        rp()
-        isolate(rv$x <- rv$x + 1)
-      })
-    })
-  }
-
-  testServer(module, {
-    expect_equal(rv$x, 1)
-
-    session$elapse(200)
-
-    expect_equal(rv$x, 5)
-  })
-})
-
-test_that("testServer handles debounce/throttle", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      rv <- reactiveValues(t = 0, d = 0)
-      react <- reactive({
-        input$y
-      })
-      rt <- throttle(react, 100)
-      rd <- debounce(react, 100)
-
-      observe({
-        rt() # Invalidate this block on the timer
-        isolate(rv$t <- rv$t + 1)
-      })
-
-      observe({
-        rd()
-        isolate(rv$d <- rv$d + 1)
-      })
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(y = TRUE)
-    expect_equal(rv$d, 1)
-    for (i in 2:5){
-      session$setInputs(y = FALSE)
-      session$elapse(51)
-      session$setInputs(y = TRUE)
-      expect_equal(rv$t, i-1)
-      session$elapse(51) # TODO: we usually don't have to pad by a ms, but here we do. Investigate.
-      expect_equal(rv$t, i)
-    }
-    # Never sufficient time to debounce. Not incremented
-    expect_equal(rv$d, 1)
-    session$elapse(50)
-
-    # Now that 100ms has passed since the last update, debounce should have triggered
-    expect_equal(rv$d, 2)
-  })
-})
-
-test_that("testServer wraps output in an observer", {
-  testthat::skip("I'm not sure of a great way to test this without timers.")
-  # And honestly it's so foundational in what we're doing now that it might not be necessary to test?
-
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      rv <- reactiveValues(x=0)
-      rp <- reactiveTimer(50)
-      output$txt <- renderText({
-        rp()
-        isolate(rv$x <- rv$x + 1)
-      })
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(x=1)
-    # Timers only tick if they're being observed. If the output weren't being
-    # wrapped in an observer, we'd see the value of rv$x initialize to zero and
-    # only increment when we evaluated the output. e.g.:
-    #
-    # expect_equal(rv$x, 0)
-    # Sys.sleep(1)
-    # expect_equal(rv$x, 0)
-    # output$txt()
-    # expect_equal(rv$x, 1)
-
-    expect_equal(rv$x, 1)
-    expect_equal(output$txt, "1")
-    Sys.sleep(.05)
-    Sys.sleep(.05)
-    expect_gt(rv$x, 1)
-    expect_equal(output$txt, as.character(rv$x))
-  })
-
-  # FIXME:
-  #  - Do we want the output to be accessible natively, or some $get() on the output? If we do a get() we could
-  #    do more helpful spy-type things around exec count.
-  #  - plots and such?
-})
-
-test_that("testServer works with async", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      output$txt <- renderText({
-        val <- input$x
-        future({ val })
-      })
-
-      output$error <- renderText({
-        future({ stop("error here") })
-      })
-
-      output$sync <- renderText({
-        # No promises here
-        "abc"
-      })
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(x=1)
-    expect_equal(output$txt, "1")
-    expect_equal(output$sync, "abc")
-
-    # Error gets thrown repeatedly
-    expect_error(output$error, "error here")
-    expect_error(output$error, "error here")
-
-    # Responds reactively
-    session$setInputs(x=2)
-    expect_equal(output$txt, "2")
-    # Error still thrown
-    expect_error(output$error, "error here")
-  })
-})
-
-test_that("testModule works with multiple promises in parallel", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      output$txt1 <- renderText({
-        future({
-          Sys.sleep(1)
-          1
-        })
-      })
-
-      output$txt2 <- renderText({
-        future({
-          Sys.sleep(1)
-          2
-        })
-      })
-    })
-  }
-
-  testServer(module, {
-    # As we enter this test code, the promises will still be running in the background.
-    # We'll need to give them ~2s (plus overhead) to complete
-    startMS <- as.numeric(Sys.time()) * 1000
-    expect_equal(output$txt1, "1") # This first call will block waiting for the promise to return
-    expect_equal(output$txt2, "2")
-    expect_equal(output$txt2, "2") # Now that we have the values, access should not incur a 1s delay.
-    expect_equal(output$txt1, "1")
-    expect_equal(output$txt1, "1")
-    expect_equal(output$txt2, "2")
-    endMS <- as.numeric(Sys.time()) * 1000
-
-    # We'll pad quite a bit because promises can introduce some lag. But the point we're trying
-    # to prove is that we're not hitting a 1s delay for each output access, which = 6000ms. If we're
-    # under that, then things are likely working.
-    expect_lt(endMS - startMS, 4000)
-  })
-})
-
-test_that("testModule handles async errors", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session, arg1, arg2){
-      output$err <- renderText({
-        future({ "my error"}) %...>%
-          stop() %...>%
-          print() # Extra steps after the error
-      })
-
-      output$safe <- renderText({
-        future({ safeError("my safe error") }) %...>%
-          stop()
-      })
-    })
-  }
-
-  testServer(module, {
-    expect_error(output$err, "my error")
-    # TODO: helper for safe errors so users don't have to learn "shiny.custom.error"?
-    expect_error(output$safe, "my safe error", class="shiny.custom.error")
-  })
-})
-
-test_that("testServer handles modules with additional arguments", {
-  module <- function(id, arg1, arg2) {
-    moduleServer(id, function(input, output, session){
-      output$txt1 <- renderText({
-        arg1
-      })
-
-      output$txt2 <- renderText({
-        arg2
-      })
-
-      output$inp <- renderText({
-        input$x
-      })
-    })
-  }
-
-  testServer(module, {
-    expect_equal(output$txt1, "val1")
-    expect_equal(output$txt2, "val2")
-  }, arg1="val1", arg2="val2")
-})
-
-test_that("testServer captures htmlwidgets", {
-  # TODO: use a simple built-in htmlwidget instead of something complex like dygraph
-  if (!requireNamespace("dygraphs")){
-    testthat::skip("dygraphs not available to test htmlwidgets")
-  }
-
-  if (!requireNamespace("jsonlite")){
-    testthat::skip("jsonlite not available to test htmlwidgets")
-  }
-
-  module <- function(id) {
-    moduleServer(id, function(input, output, session){
-      output$dy <- dygraphs::renderDygraph({
-        dygraphs::dygraph(data.frame(outcome=0:5, year=2000:2005))
-      })
-    })
-  }
-
-  testServer(module, {
-    # Really, this test should be specific to each htmlwidget. Here, we don't want to bind ourselves
-    # to the current JSON structure of dygraphs, so we'll just check one element to see that the raw
-    # JSON was exposed and is accessible in tests.
-    d <- jsonlite::fromJSON(output$dy)$x$data
-    expect_equal(d[1,], 0:5)
-    expect_equal(d[2,], 2000:2005)
-  })
-})
-
-test_that("testServer captures renderUI", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session){
-      output$ui <- renderUI({
-        tags$a(href="https://rstudio.com", "hello!")
-      })
-    })
-  }
-
-  testServer(module, {
-    expect_equal(output$ui$deps, list())
-    expect_equal(as.character(output$ui$html), "<a href=\"https://rstudio.com\">hello!</a>")
-  })
-})
-
-test_that("testServer captures base graphics outputs", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session){
-      output$fixed <- renderPlot({
-        plot(1,1)
-      }, width=300, height=350)
-
-      output$dynamic <- renderPlot({
-        plot(1,1)
-      })
-    })
-  }
-
-  testServer(module, {
-    # We aren't yet able to create reproducible graphics, so this test is intentionally pretty
-    # limited.
-    expect_equal(output$fixed$width, 300)
-    expect_equal(output$fixed$height, 350)
-    expect_match(output$fixed$src, "^data:image/png;base64,")
-
-    # Ensure that the plot defaults to a reasonable size.
-    expect_equal(output$dynamic$width, 600)
-    expect_equal(output$dynamic$height, 400)
-    expect_match(output$dynamic$src, "^data:image/png;base64,")
-
-    # TODO: how do you customize automatically inferred plot sizes?
-    # session$setPlotMeta("dynamic", width=600, height=300) ?
-  })
-})
-
-test_that("testServer captures ggplot2 outputs", {
-  if (!requireNamespace("ggplot2")){
-    testthat::skip("ggplot2 not available")
-  }
-
-  module <- function(id) {
-    moduleServer(id, function(input, output, session){
-      output$fixed <- renderPlot({
-        ggplot2::qplot(iris$Sepal.Length, iris$Sepal.Width)
-      }, width=300, height=350)
-
-      output$dynamic <- renderPlot({
-        ggplot2::qplot(iris$Sepal.Length, iris$Sepal.Width)
-      })
-    })
-  }
-
-  testServer(module, {
-    expect_equal(output$fixed$width, 300)
-    expect_equal(output$fixed$height, 350)
-    expect_match(output$fixed$src, "^data:image/png;base64,")
-
-    # Ensure that the plot defaults to a reasonable size.
-    expect_equal(output$dynamic$width, 600)
-    expect_equal(output$dynamic$height, 400)
-    expect_match(output$dynamic$src, "^data:image/png;base64,")
-  })
-})
-
-test_that("testServer exposes the returned value from the module", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session){
-      reactive({
-        return(input$a + input$b)
-      })
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(a=1, b=2)
-    expect_equal(session$getReturned()(), 3)
-
-    # And retains reactivity
-    session$setInputs(a=2)
-    expect_equal(session$getReturned()(), 4)
-  })
-})
-
-test_that("testServer handles synchronous errors", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session, arg1, arg2){
-      output$err <- renderText({
-        stop("my error")
-      })
-
-      output$safe <- renderText({
-        stop(safeError("my safe error"))
-      })
-    })
-  }
-
-  testServer(module, {
-    expect_error(output$err, "my error")
-    # TODO: helper for safe errors so users don't have to learn "shiny.custom.error"?
-    expect_error(output$safe, "my safe error", class="shiny.custom.error")
-  })
-})
-
-test_that("accessing a non-existent output gives an informative message", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session){})
-  }
-
-  testServer(module, {
-    expect_error(output$dontexist, "hasn't been defined yet: output\\$server1-dontexist")
-  }, 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) {
-      output$someVar <- 123
-
-    })
-  }
-
-  expect_error(testServer(module, {}), "^Unexpected")
-})
-
-test_that("testServer handles invalidateLater", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      rv <- reactiveValues(x = 0)
-      observe({
-        isolate(rv$x <- rv$x + 1)
-        # We're only testing one invalidation
-        if (isolate(rv$x) <= 1){
-          invalidateLater(50)
-        }
-      })
-    })
-  }
-
-  testServer(module, {
-    # Should have run once
-    expect_equal(rv$x, 1)
-
-    session$elapse(49)
-    expect_equal(rv$x, 1)
-
-    session$elapse(1)
-    # Should have been incremented now
-    expect_equal(rv$x, 2)
-  })
-})
-
-test_that("session ended handlers work", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session){})
-  }
-
-  testServer(module, {
-    rv <- reactiveValues(closed = FALSE)
-    session$onEnded(function(){
-      rv$closed <- TRUE
-    })
-
-    expect_equal(session$isEnded(), FALSE)
-    expect_equal(session$isClosed(), FALSE)
-    expect_false(rv$closed, FALSE)
-
-    session$close()
-
-    expect_equal(session$isEnded(), TRUE)
-    expect_equal(session$isClosed(), TRUE)
-    expect_false(rv$closed, TRUE)
-  })
-})
-
-test_that("session flush handlers work", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-      rv <- reactiveValues(x = 0, flushCounter = 0, flushedCounter = 0,
-                           flushOnceCounter = 0, flushedOnceCounter = 0)
-
-      onFlush(function(){rv$flushCounter <- rv$flushCounter + 1}, once=FALSE)
-      onFlushed(function(){rv$flushedCounter <- rv$flushedCounter + 1}, once=FALSE)
-      onFlushed(function(){rv$flushOnceCounter <- rv$flushOnceCounter + 1}, once=TRUE)
-      onFlushed(function(){rv$flushedOnceCounter <- rv$flushedOnceCounter + 1}, once=TRUE)
-
-      observe({
-        rv$x <- input$x * 2
-      })
-    })
-  }
-
-  testServer(module, {
-    session$setInputs(x=1)
-    expect_equal(rv$x, 2)
-    # We're not concerned with the exact values here -- only that they increase
-    fc <- rv$flushCounter
-    fdc <- rv$flushedCounter
-
-    session$setInputs(x=2)
-    expect_gt(rv$flushCounter, fc)
-    expect_gt(rv$flushedCounter, fdc)
-
-    # These should have only run once
-    expect_equal(rv$flushOnceCounter, 1)
-    expect_equal(rv$flushedOnceCounter, 1)
-
-  })
-})

tests/testthat/test-test.R

@@ -52,10 +52,10 @@ test_that("runTests works", {
     file.path(test_path("../test-helpers/app1-standard"), "tests")))
 
   # Check the results
-  expect_equal(all(res$pass), FALSE)
-  expect_length(res$file, 2)
-  expect_equal(res$file[1], "runner1.R")
-  expect_equal(res[2,]$error[[1]]$message, "I was told to throw an error")
+  expect_equal(res$result, FALSE)
+  expect_length(res$files, 2)
+  expect_equal(res$files[1], list(`runner1.R` = NA_character_))
+  expect_equal(res$files[[2]]$message, "I was told to throw an error")
   expect_s3_class(res, "shinytestrun")
 
   # Check that supporting files were loaded
@@ -70,8 +70,8 @@ test_that("runTests works", {
   filesToError <- character(0)
 
   res <- runTestsSpy(test_path("../test-helpers/app1-standard"))
-  expect_equal(all(res$pass), TRUE)
-  expect_equal(res$file, c("runner1.R", "runner2.R"))
+  expect_equal(res$result, TRUE)
+  expect_equal(res$files, list(`runner1.R` = NA_character_, `runner2.R` = NA_character_))
 
   # If autoload is false, it should still load global.R. Because this load happens in the top-level of the function,
   # our spy will catch it.
@@ -115,15 +115,15 @@ test_that("calls out to shinytest when appropriate", {
 
   # Run shinytest with a failure
   res2 <- runTestsSpy(test_path("../test-helpers/app1-standard"))
-  expect_false(all(res2$pass))
-  expect_equivalent(res2$error, list(NA, simpleError("Unknown shinytest error")))
+  expect_false(res2$result)
+  expect_equal(res2$files, list(test1=NA_character_, test2=simpleError("Unknown shinytest error")))
   expect_s3_class(res2, "shinytestrun")
 
   # Run shinytest with all passing
   sares[[2]]$pass <- TRUE
   res2 <- runTestsSpy(test_path("../test-helpers/app1-standard"))
-  expect_true(all(res2$pass))
-  expect_equivalent(res2$file, c("test1", "test2"))
+  expect_true(res2$result)
+  expect_equal(res2$files, list(test1=NA_character_, test2=NA_character_))
   expect_s3_class(res2, "shinytestrun")
 
   # Not shinytests
@@ -157,21 +157,7 @@ test_that("runTests filters", {
 test_that("runTests handles the absence of tests", {
   expect_error(runTests(test_path("../test-helpers/app2-nested")), "No tests directory found")
   expect_message(res <- runTests(test_path("../test-helpers/app6-empty-tests")), "No test runners found in")
-  expect_equal(res$file, character(0))
-  expect_equal(res$pass, logical(0))
-  expect_equivalent(res$result, list())
-  expect_equivalent(res$error, list())
+  expect_equal(res$result, NA)
+  expect_equal(res$files, list())
   expect_s3_class(res, "shinytestrun")
 })
-
-test_that("runTests runs as expected without rewiring", {
-  df <- runTests(appDir = "../test-helpers/app1-standard")
-  expect_equivalent(df, data.frame(
-    file = c("runner1.R", "runner2.R"),
-    pass = c(TRUE, TRUE),
-    result = I(list(1, NULL)),
-    error = I(list(NA, NA)),
-    stringsAsFactors = FALSE
-  ))
-  expect_s3_class(df, "shinytestrun")
-})

tools/Gruntfile.js

@@ -15,82 +15,75 @@ module.exports = function(grunt) {
         instdir + "www/shared/shiny.min.js.map",
         "./temp_concat/shiny.js",
         "./temp_concat/shiny.js.map",
-        instdir + "www/shared/datepicker/js/bootstrap-datepicker.min.js",
-        instdir + "www/shared/ionrangeslider/js/ion.rangeSlider.min.js"
+        instdir + 'www/shared/datepicker/js/bootstrap-datepicker.min.js',
+        instdir + 'www/shared/ionrangeslider/js/ion.rangeSlider.min.js'
       ]
     },
 
     concat: {
       options: {
         process: function(src, filepath) {
-          return (
-            "//---------------------------------------------------------------------\n" +
-            "// Source file: " +
-            filepath +
-            "\n\n" +
-            src
-          );
+          return '//---------------------------------------------------------------------\n' +
+            '// Source file: ' + filepath + '\n\n' + src;
         },
         sourceMap: true
       },
       shiny: {
         src: [
-          js_srcdir + "_start.js",
-          js_srcdir + "utils.js",
-          js_srcdir + "browser.js",
-          js_srcdir + "input_rate.js",
-          js_srcdir + "shinyapp.js",
-          js_srcdir + "notifications.js",
-          js_srcdir + "modal.js",
-          js_srcdir + "file_processor.js",
-          js_srcdir + "binding_registry.js",
-          js_srcdir + "output_binding.js",
-          js_srcdir + "output_binding_text.js",
-          js_srcdir + "output_binding_image.js",
-          js_srcdir + "output_binding_html.js",
-          js_srcdir + "output_binding_downloadlink.js",
-          js_srcdir + "output_binding_datatable.js",
-          js_srcdir + "output_binding_adapter.js",
-          js_srcdir + "input_binding.js",
-          js_srcdir + "input_binding_text.js",
-          js_srcdir + "input_binding_textarea.js",
-          js_srcdir + "input_binding_password.js",
-          js_srcdir + "input_binding_number.js",
-          js_srcdir + "input_binding_checkbox.js",
-          js_srcdir + "input_binding_slider.js",
-          js_srcdir + "input_binding_date.js",
-          js_srcdir + "input_binding_daterange.js",
-          js_srcdir + "input_binding_select.js",
-          js_srcdir + "input_binding_radio.js",
-          js_srcdir + "input_binding_checkboxgroup.js",
-          js_srcdir + "input_binding_actionbutton.js",
-          js_srcdir + "input_binding_tabinput.js",
-          js_srcdir + "input_binding_fileinput.js",
-          js_srcdir + "init_shiny.js",
-          js_srcdir + "reactlog.js",
-          js_srcdir + "_end.js"
+          js_srcdir + '_start.js',
+          js_srcdir + 'utils.js',
+          js_srcdir + 'browser.js',
+          js_srcdir + 'input_rate.js',
+          js_srcdir + 'shinyapp.js',
+          js_srcdir + 'notifications.js',
+          js_srcdir + 'modal.js',
+          js_srcdir + 'file_processor.js',
+          js_srcdir + 'binding_registry.js',
+          js_srcdir + 'output_binding.js',
+          js_srcdir + 'output_binding_text.js',
+          js_srcdir + 'output_binding_image.js',
+          js_srcdir + 'output_binding_html.js',
+          js_srcdir + 'output_binding_downloadlink.js',
+          js_srcdir + 'output_binding_datatable.js',
+          js_srcdir + 'output_binding_adapter.js',
+          js_srcdir + 'input_binding.js',
+          js_srcdir + 'input_binding_text.js',
+          js_srcdir + 'input_binding_textarea.js',
+          js_srcdir + 'input_binding_password.js',
+          js_srcdir + 'input_binding_number.js',
+          js_srcdir + 'input_binding_checkbox.js',
+          js_srcdir + 'input_binding_slider.js',
+          js_srcdir + 'input_binding_date.js',
+          js_srcdir + 'input_binding_daterange.js',
+          js_srcdir + 'input_binding_select.js',
+          js_srcdir + 'input_binding_radio.js',
+          js_srcdir + 'input_binding_checkboxgroup.js',
+          js_srcdir + 'input_binding_actionbutton.js',
+          js_srcdir + 'input_binding_tabinput.js',
+          js_srcdir + 'input_binding_fileinput.js',
+          js_srcdir + 'init_shiny.js',
+          js_srcdir + 'reactlog.js',
+          js_srcdir + '_end.js'
         ],
         // The temp_concat/ directory would have gone under /srcjs/, but the
         // Babel Grunt plugin has trouble finding presets if it operates on a
         // file that's not under the current directory. So we'll put it under
         // ./
-        dest: "./temp_concat/shiny.js",
+        dest: './temp_concat/shiny.js',
         nonull: true
-      }
+      },
     },
 
     "string-replace": {
       version: {
         files: {
-          "./temp_concat/shiny.js": "./temp_concat/shiny.js"
+          './temp_concat/shiny.js': './temp_concat/shiny.js'
         },
         options: {
-          replacements: [
-            {
-              pattern: /{{\s*VERSION\s*}}/g,
-              replacement: pkgInfo().version
-            }
-          ]
+          replacements: [{
+            pattern: /{{\s*VERSION\s*}}/g,
+            replacement: pkgInfo().version
+          }]
         }
       }
     },
@@ -99,83 +92,80 @@ module.exports = function(grunt) {
       options: {
         sourceMap: true,
         compact: false,
-        presets: ["@babel/preset-env"]
+        presets: ['es2015']
       },
       shiny: {
-        src: "./temp_concat/shiny.js",
-        dest: instdir + "/www/shared/shiny.js"
+        src: './temp_concat/shiny.js',
+        dest: instdir + '/www/shared/shiny.js'
       }
     },
 
     eslint: {
       options: {
-        parser: "babel-eslint",
-        format: require("eslint-stylish-mapped"),
-        extends: "eslint:recommended",
+        parser: 'babel-eslint',
+        format: require('eslint-stylish-mapped'),
+        extends: 'eslint:recommended',
         rules: {
           "consistent-return": 1,
           "dot-location": [1, "property"],
-          eqeqeq: 1,
+          "eqeqeq": 1,
           // "no-shadow": 1,
           "no-implicit-globals": 1,
-          "no-restricted-globals": [
-            "error",
-            "name",
-            "length",
-            "top",
-            "location",
-            "parent",
-            "status"
-          ],
+          "no-restricted-globals": ["error", "name", "length", "top", "location", "parent", "status"],
           "no-global-assign": 1,
           "no-undef": 1,
-          "no-unused-vars": [1, { args: "none" }],
+          "no-unused-vars": [1, {"args": "none"}],
           "guard-for-in": 1,
           // "no-use-before-define": [1, {"functions": false}],
-          semi: [1, "always"]
+          "semi": [1, "always"]
         },
-        envs: ["es6", "browser", "jquery"],
+        envs: [
+          "es6",
+          "browser",
+          "jquery"
+        ],
         globals: ["strftime"]
       },
-      shiny: ["./temp_concat/shiny.js"]
+      shiny: ['./temp_concat/shiny.js']
     },
 
     uglify: {
       shiny: {
         options: {
-          banner:
-            "/*! <%= pkg.name %> <%= pkg.version %> | " +
-            '(c) 2012-<%= grunt.template.today("yyyy") %> RStudio, Inc. | ' +
-            "License: <%= pkg.license %> */\n",
+          banner: '/*! <%= pkg.name %> <%= pkg.version %> | ' +
+                  '(c) 2012-<%= grunt.template.today("yyyy") %> RStudio, Inc. | ' +
+                  'License: <%= pkg.license %> */\n',
           sourceMap: true,
           // Base the .min.js sourcemap off of the .js sourcemap created by concat
-          sourceMapIn: instdir + "www/shared/shiny.js.map",
+          sourceMapIn: instdir + 'www/shared/shiny.js.map',
           sourceMapIncludeSources: true
         },
-        src: instdir + "www/shared/shiny.js",
-        dest: instdir + "www/shared/shiny.min.js"
+        src: instdir + 'www/shared/shiny.js',
+        dest: instdir + 'www/shared/shiny.min.js'
       },
       datepicker: {
         src: [
-          instdir + "www/shared/datepicker/js/bootstrap-datepicker.js",
-          instdir + "www/shared/datepicker/js/locales/bootstrap-datepicker.*.js"
+          instdir + 'www/shared/datepicker/js/bootstrap-datepicker.js',
+          instdir + 'www/shared/datepicker/js/locales/bootstrap-datepicker.*.js'
         ],
-        dest: instdir + "www/shared/datepicker/js/bootstrap-datepicker.min.js"
+        dest: instdir + 'www/shared/datepicker/js/bootstrap-datepicker.min.js'
       },
       ionrangeslider: {
-        src: instdir + "www/shared/ionrangeslider/js/ion.rangeSlider.js",
-        dest: instdir + "www/shared/ionrangeslider/js/ion.rangeSlider.min.js"
+        src: instdir + 'www/shared/ionrangeslider/js/ion.rangeSlider.js',
+        dest: instdir + 'www/shared/ionrangeslider/js/ion.rangeSlider.min.js'
       }
     },
 
     watch: {
       shiny: {
-        files: ["<%= concat.shiny.src %>", "../DESCRIPTION"],
-        tasks: ["default"]
+        files: ['<%= concat.shiny.src %>', '../DESCRIPTION'],
+        tasks: [
+          'default'
+        ]
       },
       datepicker: {
-        files: "<%= uglify.datepicker.src %>",
-        tasks: ["uglify:datepicker"]
+        files: '<%= uglify.datepicker.src %>',
+        tasks: ['newer:uglify:datepicker']
       }
     },
 
@@ -184,11 +174,12 @@ module.exports = function(grunt) {
         override: function(detail, include) {
           // If DESCRIPTION is updated, we'll also need to re-minify shiny.js
           // because the min.js file embeds the version number.
-          if (detail.task === "uglify" && detail.target === "shiny") {
-            include(isNewer("../DESCRIPTION", detail.time));
+          if (detail.task === 'uglify' && detail.target === 'shiny') {
+            include(isNewer('../DESCRIPTION', detail.time));
           } else {
             include(false);
           }
+
         }
       }
     }
@@ -224,13 +215,13 @@ module.exports = function(grunt) {
   grunt.initConfig(gruntConfig);
 
   grunt.registerTask('default', [
-    'concat',
-    'string-replace',
+    'newer:concat',
+    'newer:string-replace',
     'validateStringReplace',
-    'eslint',
+    'newer:eslint',
     'configureBabel',
-    'babel',
-    'uglify'
+    'newer:babel',
+    'newer:uglify'
   ]);
 
 

tools/checkDocsCurrent.sh

@@ -3,7 +3,6 @@
 set -e
 
 # Generate package docs in the working directory
-echo "Document..."
 Rscript -e "devtools::document(roclets=c('rd', 'collate', 'namespace'))"
 
 if [ -n "$(git status --porcelain)" ]
@@ -18,17 +17,14 @@ fi
 
 
 # Update htmltools docs
-echo "Update Reexports..."
-Rscript './tools/documentation/updateReexports.R'
-echo "Check pkgdown..."
-Rscript './tools/documentation/checkPkgdown.R'
+Rscript './tools/updateHtmltoolsMan.R'
 
 if [ -n "$(git status --porcelain)" ]
 then
   git status --porcelain
-  >&2 echo "Please generate the reexports documentation and commit the updates."
-  >&2 echo "The above files changed when we generated the reexports documentation by calling './tools/documentation/updateReexports.R'. This most often occurs when the documentation re-exported by shiny does not match the latest tagged package exports."
+  >&2 echo "Please generate the htmltools documentation and commit the updates."
+  >&2 echo "The above files changed when we generated the htmltools documentation. This most often occurs when the documentation re-exported by shiny does not match the htmltools documentation."
   exit 1
 else
-  echo "No difference detected; re-exported docs are current."
+  echo "No difference detected; re-exported htmltools docs are current."
 fi

tools/documentation/checkPkgdown.R

@@ -1,52 +0,0 @@
-local({
-
-  reexports_file <- rprojroot::find_package_root_file("tools/documentation/reexports.json")
-  pkgdown_file <- rprojroot::find_package_root_file("tools/documentation/pkgdown.yml")
-
-  get_exported <- function() {
-    # We're running tests on a source tree, likely by devtools::test()
-    sub("\\.Rd", "", list.files(rprojroot::find_package_root_file("man"), pattern = "*.Rd"))
-
-    # # We're testing an installed package, possibly for R CMD check
-    # unique(unname(readRDS("../../shiny/help/aliases.rds")))
-  }
-
-  get_indexed <- function(pkgdown_file) {
-    unlist(lapply(yaml::yaml.load_file(pkgdown_file)$reference, function(x) x$contents))
-  }
-
-
-  indexed_topics <- get_indexed(pkgdown_file)
-  all_topics     <- get_exported()
-
-  ## Known not to be indexed
-  reexports_man_info <- jsonlite::fromJSON(reexports_file, simplifyDataFrame = FALSE)
-  reexports_man_file_names <- unlist(
-    recursive = TRUE,
-    lapply(reexports_man_info, function(alias_pkg_info) {
-      lapply(alias_pkg_info$exports, function(man_item) {
-        sub(".Rd", "", man_item$file, fixed = TRUE)
-      })
-    })
-  )
-  known_unindexed <- c("shiny-package", "stacktrace", "knitr_methods",
-                       "pageWithSidebar", "headerPanel", "shiny.appobj",
-                       "deprecatedReactives", "reexports")
-
-  ## This test ensures that every documented topic is included in
-  ## staticdocs/index.r, unless explicitly waived by specifying it
-  ## in the known_unindexed variable above.
-  missing <- setdiff(all_topics, c(known_unindexed, indexed_topics))
-  ## Explicitly add reexports man files as they will be added at shiny-dev-center documentation build time
-  unknown <- setdiff(c(known_unindexed, indexed_topics), c(all_topics, reexports_man_file_names))
-
-  testthat::expect_equal(length(missing), 0,
-    info = paste("Functions missing from _pkgdown.yml:\n",
-      paste("  ", missing, sep = "", collapse = "\n"),
-      sep = ""))
-  testthat::expect_equal(length(unknown), 0,
-    info = paste("Unrecognized functions in _pkgdown.yml:\n",
-      paste("  ", unknown, sep = "", collapse = "\n"),
-      sep = ""))
-  invisible(TRUE)
-})

tools/documentation/reexports.json

@@ -1,24 +0,0 @@
-{
-  "fastmap": {
-    "name": "fastmap",
-    "repo": "r-lib/fastmap",
-    "exports": [
-      { "file": "key_missing.Rd" }
-    ]
-  },
-  "htmltools": {
-    "name": "htmltools",
-    "repo": "rstudio/htmltools",
-    "exports": [
-      { "file": "builder.Rd", "ignore": "builder" },
-      { "file": "tag.Rd" },
-      { "file": "HTML.Rd" },
-      { "file": "include.Rd", "ignore": "include" },
-      { "file": "singleton.Rd" },
-      { "file": "validateCssUnit.Rd" },
-      { "file": "htmlTemplate.Rd" },
-      { "file": "suppressDependencies.Rd" },
-      { "file": "withTags.Rd" }
-    ]
-  }
-}

tools/documentation/updateReexports.R

@@ -1,149 +0,0 @@
-# source("tools/documentation/updateReexports.R")
-# Will add all functions aliased in `./tools/documentation/reexports.yml`
-# Will save all reexports to `./R/reexports.R` and document to enforce all re-exports
-# This script needs information from `./tools/documentation/reexports.yml` to allow pkgdown to be on the same page
-# Information from `./tools/documentation/reexports.yml` will be used in `shiny-dev-center`
-
-
-local({
-
-  # make sure packages are installed
-  for (pkg in c("gh", "rprojroot", "devtools", "memoise", "magrittr", "jsonlite")) {
-    if (!requireNamespace(pkg, quietly = TRUE)) {
-      install.packages(pkg)
-    }
-  }
-
-  `%>%` <- magrittr::`%>%`
-
-  # pre document
-  devtools::document()
-
-  pre_namespace_lines <- readLines(rprojroot::find_package_root_file("NAMESPACE"))
-
-  alias_info <- jsonlite::fromJSON(rprojroot::find_package_root_file("tools/documentation/reexports.json"), simplifyDataFrame = FALSE)
-  local_man_folder <- rprojroot::find_package_root_file("man")
-  local_reexports_r_file <- rprojroot::find_package_root_file("R/reexports.R")
-
-  latest_tag <- memoise::memoise(function(repo) {
-    # requires a GITHUB_PAT token
-    gh::gh(paste0("GET /repos/", repo, "/tags"))[[1]]$name
-  })
-
-  vapply(
-    FUN.VALUE = character(1), USE.NAMES = FALSE,
-    alias_info,
-    function(alias_pkg_info) {
-      message("Starting: ", alias_pkg_info$repo)
-
-      # tags are returned from newest to oldest. (Newest being first)
-      latest_tag_name <- latest_tag(alias_pkg_info$repo)
-      github_man_location <- paste0("https://raw.githubusercontent.com/", alias_pkg_info$repo, "/", latest_tag_name, "/man/")
-
-      vapply(
-        FUN.VALUE = character(1), USE.NAMES = FALSE,
-        alias_pkg_info$exports,
-        function(alias_item) {
-
-          message("Gathering: ", alias_pkg_info$name, " ", alias_item$file)
-
-          lines <- paste0(github_man_location, alias_item$file) %>%
-            readLines() %>%
-            { .[-(1:2)] } # remove first two roxygen2 comments
-
-          funcs <-
-            lines[grepl("\\alias{", lines, fixed = TRUE)] %>%
-            sub("\\alias{", "", ., fixed = TRUE) %>%
-            sub("}$", "", .) %>%
-            setdiff(alias_item$ignore)
-
-          beginning <- paste0("# ", alias_pkg_info$name, " ")
-          paste0(
-            "\n",
-            beginning, alias_item$file, " ", paste0(rep("-", 80 - nchar(beginning) - nchar(alias_item$file) - 1), collapse = ""), "\n",
-            ### https://github.com/tidyverse/dplyr/blob/713849e31b1f7b217154586d30aa169749075481/R/reexport-tibble.r
-            # #' @importFrom tibble data_frame
-            # #' @export
-            # tibble::data_frame
-            ###
-            paste0(collapse = "\n",
-              "\n",
-              "#' @importFrom ", alias_pkg_info$name, " ", funcs, "\n",
-              "#' @export\n",
-              alias_pkg_info$name, "::", funcs
-            )
-          )
-        }
-      ) %>%
-        # combine package items
-        paste0(collapse = "\n\n")
-    }
-
-  ) %>%
-    # combine packages
-    paste0(collapse = "\n\n\n") %>%
-    paste0(
-      "####\n",
-      "# Generated by `./tools/updateReexports.R`: do not edit by hand\n",
-      "# Please call `source('tools/updateReexports.R') from the root folder to update`\n",
-      "####\n",
-      "\n",
-      .
-    ) %>%
-    writeLines(local_reexports_r_file)
-  message("Updated: ", local_reexports_r_file)
-
-  # document new functions
-  devtools::document()
-  post_namespace_lines <- readLines(rprojroot::find_package_root_file("NAMESPACE"))
-
-  pkg_names <-
-    vapply(alias_info, `[[`, character(1), "name") %>%
-    paste0("`", ., "`", collapse = ", ")
-  imports_txt <-
-    vapply(alias_info, FUN.VALUE = character(1), function(alias_pkg_info) {
-      conn <- paste0(
-        "https://raw.githubusercontent.com/", alias_pkg_info$repo, "/", latest_tag(alias_pkg_info$repo), "/DESCRIPTION"
-      ) %>%
-        url()
-      on.exit({close(conn)})
-
-      conn %>%
-        read.dcf() %>%
-        as.data.frame() %>%
-        {.$Version[1]} %>%
-        as.character() %>%
-        paste0("    ", alias_pkg_info$name, " (>= ", ., ")")
-    }) %>%
-    paste0(collapse = "\n")
-
-  docs_have_changed <- identical(pre_namespace_lines, post_namespace_lines)
-  message(
-    "\n",
-    "The NAMESPACE exports ", if (docs_have_changed) { "did NOT change"} else { "CHANGED"},
-    " by copying in the ", pkg_names, " files\n",
-    "\n",
-    if (docs_have_changed) "Possible ", pkg_names, " version requirement to add to DESCRIPTION file:\n",
-    "Imports:\n",
-    imports_txt
-  )
-
-
-  # validate that all man files are autogenerated
-  first_man_file_line <-
-    dir("man", full.names = TRUE) %>%
-    setNames(., .) %>%
-    lapply(readLines) %>%
-    lapply(head, 1)
-  is_all_roxygen <-
-    first_man_file_line %>%
-    unique() %>%
-    length() %>%
-    magrittr::equals(1)
-
-  if (!is_all_roxygen) {
-    str(first_man_file_line[vapply(first_man_file_line, function(txt) !grepl("Generated by roxygen2:", txt, fixed = TRUE), logical(1))])
-    stop("Not every file is auto generated by roxygen.  Fix this!")
-  }
-
-})

tools/importdocs.sh

@@ -0,0 +1,15 @@
+#!/usr/bin/env bash
+
+set -e
+
+# Grabs relevant man pages from htmltools and strips roxygen signature
+
+HTMLTOOLS_PATH="$HOME/Development/htmltools"
+
+sed '/% Generated by roxygen2 /d' "$HTMLTOOLS_PATH/man/HTML.Rd" > ../man/HTML.Rd
+sed '/% Generated by roxygen2 /d' "$HTMLTOOLS_PATH/man/builder.Rd" > ../man/builder.Rd
+sed '/% Generated by roxygen2 /d' "$HTMLTOOLS_PATH/man/include.Rd" > ../man/include.Rd
+sed '/% Generated by roxygen2 /d' "$HTMLTOOLS_PATH/man/singleton.Rd" > ../man/singleton.Rd
+sed '/% Generated by roxygen2 /d' "$HTMLTOOLS_PATH/man/tag.Rd" > ../man/tag.Rd
+sed '/% Generated by roxygen2 /d' "$HTMLTOOLS_PATH/man/validateCssUnit.Rd" > ../man/validateCssUnit.Rd
+sed '/% Generated by roxygen2 /d' "$HTMLTOOLS_PATH/man/withTags.Rd" > ../man/withTags.Rd

tools/package.json

@@ -6,19 +6,17 @@
     "watch": "grunt default watch"
   },
   "devDependencies": {
-    "@babel/core": "^7.9.0",
-    "@babel/preset-env": "^7.9.0",
     "babel-eslint": "^10.0.1",
-    "eslint": "^6.8.0",
+    "babel-preset-es2015": "^6.6.0",
     "eslint-stylish-mapped": "^1.0.0",
     "grunt": "^1.0.3",
-    "grunt-babel": "^8.0.0",
-    "grunt-contrib-clean": "^2.0.0",
+    "grunt-babel": "^6.0.0",
+    "grunt-contrib-clean": "^1.0.0",
     "grunt-contrib-concat": "^1.0.0",
     "grunt-contrib-copy": "^1.0.0",
-    "grunt-contrib-uglify": "^4.0.1",
+    "grunt-contrib-uglify": "1.0.1",
     "grunt-contrib-watch": "^1.0.0",
-    "grunt-eslint": "^22.0.0",
+    "grunt-eslint": "^21.1.0",
     "grunt-newer": "^1.1.2",
     "grunt-string-replace": "^1.3.1"
   }

tools/revdep.R

@@ -1,9 +0,0 @@
-
-# revdepcheck::revdep_reset()
-
-# maximize output width
-options(width = as.numeric(system2("tput", "cols", stdout = TRUE)) - 10)
-revdepcheck::revdep_check(pkgload::pkg_path("."), num_workers = detectCores() - 2, bioc = TRUE, timeout = as.difftime(30, units = "mins"))
-
-# save cran comments to a file
-cat(file = file.path(pkgload::pkg_path("."), "revdep", "revdep-cran-comments.md"), paste0(collapse = "\n", capture.output({revdepcheck::revdep_report_cran()})))

tools/updateHtmltoolsMan.R

@@ -0,0 +1,88 @@
+# source("tools/updateHtmltoolsMan.R")
+# Will update all man files that are re-exported from htmltools
+# Will save all aliases to `./R/htmltools.R` and document to enforce all re-exports
+
+
+local({
+
+  `%>%` <- magrittr::`%>%`
+
+  # pre document
+  devtools::document()
+
+  namespace_line_count <- length(readLines(rprojroot::find_package_root_file("NAMESPACE")))
+
+
+  htmltools_github_man_location <- "https://raw.githubusercontent.com/rstudio/htmltools/master/man/"
+
+  local_man_folder <- rprojroot::find_package_root_file("man")
+  local_htmltools_r_file <- rprojroot::find_package_root_file("R/htmltools.R")
+
+  alias_list <- list()
+
+  update_htmltools_man_file <- function(man_file, ignore = NULL) {
+    lines <- paste0(htmltools_github_man_location, man_file) %>%
+      readLines() %>%
+      { .[-(1:2)] } # remove first two roxygen2 comments
+
+    man_file_path <- file.path(local_man_folder, man_file)
+    lines %>%
+      paste0(collapse = "\n") %>%
+      writeLines(man_file_path)
+    message("Updated: ", man_file_path)
+
+    alias_list[[man_file]] <<-
+      lines[grepl("\\alias{", lines, fixed = TRUE)] %>%
+      sub("\\alias{", "", ., fixed = TRUE) %>%
+      sub("}$", "", .) %>%
+      setdiff(ignore)
+  }
+
+  update_htmltools_man_file("builder.Rd", "builder")
+  update_htmltools_man_file("tag.Rd")
+  update_htmltools_man_file("HTML.Rd")
+  update_htmltools_man_file("include.Rd", "include")
+  update_htmltools_man_file("singleton.Rd")
+  update_htmltools_man_file("validateCssUnit.Rd")
+  update_htmltools_man_file("htmlTemplate.Rd")
+  update_htmltools_man_file("suppressDependencies.Rd")
+  update_htmltools_man_file("withTags.Rd")
+
+
+  alias_list %>%
+    vapply(paste0, collapse = " ", character(1), USE.NAMES = FALSE) %>%
+    paste0("#' @export ", .) %>%
+    paste0(collapse = "\n") %>%
+    paste0("#' @import htmltools\n", ., "\nNULL") %>%
+    writeLines(local_htmltools_r_file)
+  message("Updated: ", local_htmltools_r_file)
+
+  # document new functions
+  devtools::document()
+  namespace_line_count_new <- length(readLines(rprojroot::find_package_root_file("NAMESPACE")))
+
+  new_version <-
+    "https://raw.githubusercontent.com/rstudio/htmltools/master/DESCRIPTION" %>%
+    url() %>%
+    read.dcf() %>%
+    as.data.frame() %>%
+    {.$Version[1]} %>%
+    as.character()
+
+  message("\n")
+  if (namespace_line_count_new == namespace_line_count) {
+    message("The NAMESPACE exports did NOT change by copying in the `htmltools` man files")
+    message()
+    message("Possible `htmltools` version requirement to add to DESCRIPTION file:\nImports:\n    htmltools (>= ", new_version, ")")
+  } else {
+    message("The NAMESPACE exports CHANGED by copying in the `htmltools` man files")
+    message()
+    message("`htmltools` version requirement to add to DESCRIPTION file:\nImports:\n    htmltools (>= ", new_version, ")")
+    message()
+    message("Possible remote to add to the DESCRIPTION file:\nRemotes:\n    rstudio/htmltools")
+  }
+
+
+
+
+})