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
|
#' @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. If `app` is `NULL` or
#' not supplied, the nearest enclosing directory that is a Shiny app, starting
#' with the current directory, is used.
#' @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 args Additional arguments to pass to the module function. If `app` is
#' a module, and no `id` argument is provided, one will be generated and
#' supplied automatically.
#' @param session The [`MockShinySession`] object to use as the [reactive
#' domain][shiny::domains]. The same session object is used as the domain both
#' during invocation of the server or module under test and during evaluation
#' of `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, args = list(multiplier = 2), {
#' 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.
#' })
#' @export
testServer <- function(app = NULL, expr, args = list(), session = MockShinySession$new()) {
require(shiny)
if (!is.null(getDefaultReactiveDomain()))
stop("testServer() is for use only within tests and may not indirectly call itself.")
quosure <- rlang::enquo(expr)
on.exit(if (!session$isClosed()) session$close())
withMockContext <- function(expr) {
isolate(
withReactiveDomain(session, {
withr::with_options(list(`shiny.allowoutputreads` = TRUE), {
withLocalOptions({
# Sets a cache for renderCachedPlot() with cache = "app" to use.
shinyOptions("cache" = session$appcache)
expr
})
})
})
)
}
if (isModuleServer(app)) {
if (!("id" %in% names(args)))
args[["id"]] <- session$genId()
# app is presumed to be a module, and modules may take additional arguments,
# so splice in any args.
withMockContext(rlang::exec(app, !!!args))
# If app is a module, then we must use both the module function's immediate
# environment and also its enclosing environment to construct the mask.
parent_clone <- rlang::env_clone(parent.env(session$env))
clone <- rlang::env_clone(session$env, parent_clone)
mask <- rlang::new_data_mask(clone, parent_clone)
withMockContext(rlang::eval_tidy(quosure, mask, rlang::caller_env()))
} else {
if (is.null(app)) {
app <- findEnclosingApp(".")
}
appobj <- as.shiny.appobj(app)
if (!is.null(appobj$onStart))
appobj$onStart()
# Ensure appobj$onStop() is called, and the current directory is restored,
# regardless of whether invoking the server function is successful.
tryCatch({
server <- appobj$serverFuncSource()
if (! "session" %in% names(formals(server)))
stop("Tested application server functions must declare input, output, and session arguments.")
body(server) <- rlang::expr({
session$setEnv(base::environment())
!!body(server)
})
if (length(args))
stop("Arguments were provided to a server function.")
withMockContext(server(input = session$input, output = session$output, session = session))
}, finally = {
if (!is.null(appobj$onStop))
appobj$onStop()
})
# If app is a server, we use only the server function's immediate
# environment to construct the mask.
mask <- rlang::new_data_mask(rlang::env_clone(session$env))
withMockContext(rlang::eval_tidy(quosure, mask, rlang::caller_env()))
}
invisible()
}
|
