1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
#' 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`.
#' This can also by any errors signaled when evaluating the `file`.
#'
#' @return A 1-row data frame representing a single test run. `result` and
#' is a "list column", or a column that contains list elements.
#' @noRd
result_row <- function(file, pass, result) {
stopifnot(is.list(result))
df <- data.frame(
file = file,
pass = pass,
result = I(result),
stringsAsFactors = FALSE
)
class(df) <- c("shiny_runtests", class(df))
df
}
#' Check to see if the given directory contains at least one script, and that
#' all scripts in the directory are shinytest scripts.
#' Scans for the magic string of `app <- ShinyDriver$new(` as an indicator that
#' this is a shinytest.
#' @noRd
is_legacy_shinytest_dir <- function(path){
is_shinytest_script <- function(file) {
if (!file.exists(file)) {
return(FALSE)
}
text <- readLines(file, warn = FALSE)
any(
grepl("app\\s*<-\\s*ShinyDriver\\$new\\(", text, perl=TRUE)
)
}
files <- dir(path, full.names = TRUE)
files <- files[!file.info(files)$isdir]
if (length(files) == 0) {
return(FALSE)
}
all(vapply(files, is_shinytest_script, logical(1)))
}
#' Runs the tests associated with this Shiny app
#'
#' Sources the `.R` files in the top-level of `tests/` much like `R CMD check`.
#' These files are typically simple runners for tests nested in other
#' directories under `tests/`.
#'
#' @param appDir The base directory for the application.
#' @param filter If not `NULL`, only tests with file names matching this regular
#' expression will be executed. Matching is performed on the file name
#' including the extension.
#' @param assert Logical value which determines if an error should be thrown if any error is captured.
#' @param envir Parent testing environment in which to base the individual testing environments.
#'
#' @return A data frame classed with the supplemental class `"shiny_runtests"`.
#' 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 |
#'
#' @details Historically, [shinytest](https://rstudio.github.io/shinytest/)
#' recommended placing tests at the top-level of the `tests/` directory.
#' This older folder structure is not supported by runTests.
#' Please see [shinyAppTemplate()] for more details.
#' @export
runTests <- function(
appDir = ".",
filter = NULL,
assert = TRUE,
envir = globalenv()
) {
# similar to runApp()
# Allows shiny's functions to be available in the UI, server, and test code
require(shiny)
testsDir <- file.path(appDir, "tests")
if (!dirExists(testsDir)) {
stop("No tests directory found: ", testsDir)
}
runners <- list.files(testsDir, pattern="\\.r$", ignore.case = TRUE)
if (length(runners) == 0) {
message("No test runners found in ", testsDir)
return(result_row(character(0), logical(0), list()))
}
if (!is.null(filter)) {
runners <- runners[grepl(filter, runners)]
}
if (length(runners) == 0) {
stop("No test runners matched the given filter: '", filter, "'")
}
# See the @details section of the runTests() docs above for why this branch exists.
if (is_legacy_shinytest_dir(testsDir)) {
stop(
"It appears that the .R files in ", testsDir, " are all shinytests.",
" This is not supported by `shiny::runTests()`.",
"\nPlease see `?shinytest::migrateShinytestDir` to migrate your shinytest file structure to the new format (requires shinytest 1.4.0 or above).",
"\nSee `?shiny::shinyAppTemplate` for an example of the new testing file structure."
)
}
renv <- new.env(parent = envir)
# Otherwise source all the runners -- each in their own environment.
ret <- do.call(rbind, lapply(runners, function(r) {
pass <- FALSE
result <-
tryCatch({
env <- new.env(parent = renv)
withr::with_dir(testsDir, {
ret <- sourceUTF8(r, envir = env)
})
pass <- TRUE
ret
}, error = function(err) {
message("Error in ", r, "\n", err)
err
})
result_row(file.path(testsDir, r), pass, list(result))
}))
if (isTRUE(assert)) {
if (!all(ret$pass)) {
stop("Shiny App Test Failures detected in\n", paste0("* ", runtest_pretty_file(ret$file[!ret$pass]), collapse = "\n"), call. = FALSE)
}
}
ret
}
runtest_pretty_file <- function(f) {
test_folder <- dirname(f)
app_folder <- dirname(test_folder)
file.path(
basename(app_folder),
basename(test_folder),
basename(f)
)
}
#' @export
print.shiny_runtests <- function(x, ..., reporter = "summary") {
cat("Shiny App Test Results\n")
if (any(x$pass)) {
# TODO in future... use clisymbols::symbol$tick and crayon green
cat("* Success\n")
mapply(
x$file,
x$pass,
x$result,
FUN = function(file, pass, result) {
if (!pass) return()
# print(result)
cat(" - ", runtest_pretty_file(file), "\n", sep = "")
}
)
}
if (any(!x$pass)) {
# TODO in future... use clisymbols::symbol$cross and crayon red
cat("* Failure\n")
mapply(
x$file,
x$pass,
x$result,
FUN = function(file, pass, result) {
if (pass) return()
cat(" - ", runtest_pretty_file(file), "\n", sep = "")
}
)
}
invisible(x)
}
|
