Nothing
#' Run tests for a Shiny application
#'
#' @param appDir Path to directory containing a Shiny app (e.g. `app.R`) or
#' single interactive `.Rmd`.
#' @param testnames Test script(s) to run. The .R extension of the filename is
#' optional. For example, `"mytest"` or `c("mytest", "mytest2.R")`.
#' If `NULL` (the default), all scripts in the tests/ directory will be
#' run.
#' @param quiet Should output be suppressed? This is useful for automated
#' testing.
#' @param compareImages Should screenshots be compared? It can be useful to set
#' this to `FALSE` when the expected results were taken on a different
#' platform from the one currently being used to test the application.
#' @param interactive If there are any differences between current results and
#' expected results, provide an interactive graphical viewer that shows the
#' changes and allows the user to accept or reject the changes.
#' @param suffix An optional suffix for the expected results directory. For
#' example, if the suffix is `"mac"`, the expected directory would be
#' `mytest-expected-mac`.
#'
#' @seealso [snapshotCompare()] and [snapshotUpdate()] if
#' you want to compare or update snapshots after testing. In most cases, the
#' user is prompted to do these tasks interactively, but there are also times
#' where it is useful to call these functions from the console.
#'
#' @export
testApp <- function(
appDir = ".",
testnames = NULL,
quiet = FALSE,
compareImages = TRUE,
interactive = is_interactive(),
suffix = NULL
)
{
library(shinytest)
path <- app_path(appDir, "appDir")
testsDir <- findTestsDir(path$dir, quiet=FALSE)
found_testnames <- findTests(testsDir, testnames)
if (length(found_testnames) == 0) {
abort("No test scripts found in ", testsDir)
}
# Run all the test scripts.
if (!quiet) {
message("Running ", appendLF = FALSE)
}
lapply(found_testnames, function(testname) {
# Run in test directory, and pass the (usually relative) path as an option,
# so that the printed output can print the relative path.
withr::local_dir(testsDir)
# Some apps have different behavior if RSTUDIO is present.
withr::local_envvar(c(RSTUDIO = ""))
withr::local_options(list(shinytest.app.dir = "appdir"))
# This will kill any existing Shiny processes launched by shinytest,
# in case they're using some of the same resources.
gc()
if (!quiet) {
message(testname, " ", appendLF = FALSE)
}
env <- new.env(parent = .GlobalEnv)
source(testname, local = env)
})
gc()
if (!quiet) message("") # New line
# Compare all results
snapshotCompare(
path$dir,
testnames = sub("\\.[rR]$", "", found_testnames),
quiet = quiet,
images = compareImages,
interactive = interactive,
suffix = suffix
)
}
#' Identify in which directory the tests are contained.
#'
#' Prior to 1.3.1.9999, tests were stored directly in `tests/` rather than
#' nested in `tests/shinytest/`.
#'
#' @param mustExist If TRUE, will error if we can't find a test directory.
#' @param quiet If we see that the tests are stored in the top-level tests/ directory as we used to
#' recommend, we will note the new recommendation in a message to the user if this is FALSE.
#'
#' This function does the following:
#' 1. Check to see if `tests/shinytest/` exists. If so, use it.
#' 2. Check to see if all the top-level R files in `tests/` appear to be shinytest. If
#' some are and some aren't, throw an error.
#' 3. Assuming all top-level R files in `tests/` appear to be shinytest, return that dir.
#' @noRd
findTestsDir <- function(appDir, mustExist=TRUE, quiet=TRUE) {
if (basename(appDir) == "tests"){
# We were given a */tests/ directory. It's possible that we're in the middle of a nested tests
# directory and the application dir is actually one level up. This happens in certain versions
# of the RStudio IDE.
# https://github.com/rstudio/rstudio/issues/5677
if (!dir_exists(file.path(appDir, "tests"))){
# We're in a dir called `tests` and there's not another `tests` directory inside, so we can
# assume that the app dir is actually probably one level up.
appDir <- dirname(appDir)
}
}
testsDir <- file.path(appDir, "tests")
if (!dir_exists(testsDir) && mustExist) {
abort("tests/ directory doesn't exist")
} else if (!dir_exists(testsDir) && !mustExist) {
# Use the preferred directory if nothing exists yet.
return(file.path(testsDir, "shinytest"))
}
r_files <- list.files(testsDir, pattern = "\\.[rR]$", full.names = TRUE)
is_test <- vapply(r_files, function(f) {
isShinyTest(readLines(f, warn=FALSE))
}, logical(1))
if (dir_exists(file.path(testsDir, "shinytests"))) {
message(
"tests/shinytests/ directory found.",
" Please rename this directory to tests/shinytest/.",
" (The tests/shinytests/ directory was used only in an unreleased version of the shinytest package.)"
)
}
shinytestDir <- file.path(testsDir, "shinytest")
if (dir_exists(shinytestDir)) {
# We'll want to use this dir. But as a courtesy, let's warn if we find anything
# that appears to be a shinytest in the top-level; it's possible that someone
# using the old layout (tests at the top-level) might have just had a directory
# named shinytest. Let's leave them a clue.
if (any(is_test) && !quiet) {
warning("Assuming that the shinytests are stored in tests/shinytest, but it appears that there are some ",
"shinytests in the top-level tests/ directory. All shinytests should be placed in the tests/shinytest/ directory.")
}
return(shinytestDir)
}
if (!any(is_test) && !mustExist){
# There may be some stuff in the tests directory, but if it's not shinytest-related...
# Ignore and just use the nested dir
return(shinytestDir)
}
if (!all(is_test)) {
abort("Found R files that don't appear to be shinytests in the tests/ directory. shinytests should be placed in tests/shinytest/")
}
if (!quiet) {
message(
"Shinytest scripts found in tests/.\n",
"As of shinytest 1.4.0, shinytests should be placed in the tests/shinytest/ directory.\n",
"Please use migrateShinytestDir(), or see ?migrateShinytestDir for more information."
)
}
testsDir
}
#' 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.
#' @noRd
isShinyTest <- function(text) {
lines <- grepl("app\\s*<-\\s*ShinyDriver\\$new\\(", text, perl=TRUE)
any(lines)
}
#' Finds the relevant tests in a given directory
#' @noRd
findTests <- function(testsDir, testnames=NULL) {
found_testnames <- list.files(testsDir, pattern = "\\.[rR]$")
found_testnames_no_ext <- sub("\\.[rR]$", "", found_testnames)
if (!is.null(testnames)) {
testnames_no_ext <- sub("\\.[rR]$", "", testnames)
# Keep only specified files
idx <- match(testnames_no_ext, found_testnames_no_ext)
if (any(is.na(idx))) {
abort(c("Test scripts do not exist:", testnames[is.na(idx)]))
}
# Keep only specified files
found_testnames <- found_testnames[idx]
}
found_testnames
}
all_testnames <- function(testDir, suffixes = c("-expected", "-current")) {
# Create a regex string like "(-expected|-current)$"
pattern <- paste0(
"(",
paste0(suffixes, collapse = "|"),
")$"
)
testnames <- dir(testDir, pattern = pattern)
testnames <- sub(pattern, "", testnames)
unique(testnames)
}
validate_testname <- function(testDir, testname) {
valid_testnames <- all_testnames(testDir)
if (is.null(testname) || !(testname %in% valid_testnames)) {
abort(c(
paste0('"', testname, '" is not a valid testname for the app.'),
paste0('Valid names are: "', paste(valid_testnames, collapse = '", "'), '".')
))
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.