1test_that("files are loaded into the right env", {
2  renv <- new.env(parent=environment())
3  genv <- new.env(parent=environment())
4
5  loadSupport(test_path("../test-helpers/app1-standard"), renv=renv, globalrenv=genv)
6  expect_equal(get("helper1", renv, inherits=FALSE), 123)
7  expect_equal(get("helper2", renv, inherits=FALSE), "abc")
8
9  expect_equal(get("global", genv, inherits=FALSE), "ABC")
10})
11
12test_that("Can suppress sourcing global.R", {
13  # Confirm that things blow up if we source global.R
14  expect_error(loadSupport(test_path("../test-helpers/app3-badglobal")))
15
16  # Shouldn't see an error now that we're suppressing global sourcing.
17  renv <- loadSupport(test_path("../test-helpers/app3-badglobal"), globalrenv=NULL)
18
19  # But other helpers are still sourced
20  expect_true(exists("helper1", envir=renv))
21})
22
23test_that("nested helpers are not loaded", {
24  loadSupport(test_path("../test-helpers/app2-nested"), renv=environment(), globalrenv=NULL)
25  expect_equal(helper1, 456)
26  expect_false(exists("helper2"))
27})
28
29test_that("app with both r/ and R/ prefers R/", {
30  ## App 4 already has a lower-case r/ directory. Try to create an upper.
31  dir <- test_path("../test-helpers/app4-both/R")
32  tryCatch({
33    dir.create(dir)
34    teardown(unlink(dir, recursive = TRUE))
35  }, warning = function(w) {
36    testthat::skip("File system is not case-sensitive")
37  })
38  writeLines("upperHelper <- 'abc'", file.path(dir, "upper.R"))
39
40  renv <- loadSupport(test_path("../test-helpers/app4-both"))
41
42  expect_false(exists("lowerHelper", envir=renv))
43  expect_equal(get("upperHelper", envir=renv), "abc")
44})
45
46test_that("With ui/server.R, global.R is loaded before R/ helpers and into the right envs", {
47  calls <- list()
48  sourceStub <- function(...){
49    calls[[length(calls)+1]] <<- list(...)
50    NULL
51  }
52
53  # Temporarily opt-in to R/ file autoloading
54  withr::local_options(list(shiny.autoload.r=TRUE))
55
56  # + shinyAppDir_serverR
57  # +--- sourceUTF8
58  # +--+ loadSupport
59  # |  +--- sourceUTF8
60  loadSpy <- rewire(loadSupport, sourceUTF8 = sourceStub)
61  sad <- rewire(shinyAppDir_serverR, sourceUTF8 = sourceStub, loadSupport = loadSpy)
62
63  sa <- sad(normalizePath(test_path("../test-helpers/app1-standard")))
64  sa$onStart()
65  sa$onStop() # Close down to free up resources
66
67  # Should have seen three calls -- first to global then to the helpers
68  expect_length(calls, 3)
69  expect_match(calls[[1]][[1]], "global\\.R$", perl=TRUE)
70  expect_match(calls[[2]][[1]], "helperCap\\.R$", perl=TRUE)
71  expect_match(calls[[3]][[1]], "helperLower\\.r$", perl=TRUE)
72
73  # Check environments
74  # global.R loaded into the global env
75  gEnv <- calls[[1]]$envir
76  expect_identical(gEnv, globalenv())
77
78  # helpers are loaded into a child of the global env
79  helperEnv1 <- calls[[2]]$envir
80  helperEnv2 <- calls[[3]]$envir
81  expect_identical(helperEnv1, helperEnv2)
82  expect_identical(parent.env(helperEnv1), globalenv())
83
84  calls <- NULL
85  # Source the server
86  sa$serverFuncSource()
87  expect_length(calls, 1)
88  # server.R is sourced into a child environment of the helpers
89  expect_match(calls[[1]][[1]], "/server\\.R$")
90  expect_identical(parent.env(calls[[1]]$envir), helperEnv1)
91
92  calls <- NULL
93  # Invoke the UI by simulating a request
94  sa$httpHandler(list())
95  expect_length(calls, 1)
96  # ui.R is sourced into a child environment of the helpers
97  expect_match(calls[[1]][[1]], "ui\\.R$")
98  expect_identical(parent.env(calls[[1]]$envir), helperEnv1)
99})
100
101
102test_that("Loading supporting R files is opt-out", {
103  calls <- list()
104  sourceStub <- function(...){
105    calls[[length(calls)+1]] <<- list(...)
106    NULL
107  }
108
109  # Temporarily unset autoloading option
110  withr::local_options(list(shiny.autoload.r = NULL))
111
112  # + shinyAppDir_serverR
113  # +--- sourceUTF8
114  # +--+ loadSupport
115  # |  +--- sourceUTF8
116  loadSpy <- rewire(loadSupport, sourceUTF8 = sourceStub)
117  sad <- rewire(shinyAppDir_serverR, sourceUTF8 = sourceStub, loadSupport = loadSpy)
118
119  sa <- sad(normalizePath(test_path("../test-helpers/app1-standard")))
120  sa$onStart()
121  sa$onStop() # Close down to free up resources
122
123  # Should have seen three calls from global.R -- helpers are enabled
124  expect_length(calls, 3)
125  expect_match(calls[[1]][[1]], "global\\.R$", perl=TRUE)
126})
127
128
129test_that("Disabling supporting R files works", {
130  calls <- list()
131  sourceStub <- function(...){
132    calls[[length(calls)+1]] <<- list(...)
133    NULL
134  }
135
136  # Temporarily unset autoloading option
137  withr::local_options(list(shiny.autoload.r = FALSE))
138
139  # + shinyAppDir_serverR
140  # +--- sourceUTF8
141  # +--+ loadSupport
142  # |  +--- sourceUTF8
143  loadSpy <- rewire(loadSupport, sourceUTF8 = sourceStub)
144  sad <- rewire(shinyAppDir_serverR, sourceUTF8 = sourceStub, loadSupport = loadSpy)
145
146  sa <- sad(normalizePath(test_path("../test-helpers/app1-standard")))
147  sa$onStart()
148  sa$onStop() # Close down to free up resources
149
150  # Should have seen one calls from global.R -- helpers are disabled
151  expect_length(calls, 1)
152  expect_match(calls[[1]][[1]], "global\\.R$", perl=TRUE)
153})
154
155test_that("app.R is loaded after R/ helpers and into the right envs", {
156  calls <- list()
157  sourceSpy <- function(...){
158    calls[[length(calls)+1]] <<- list(...)
159    do.call(sourceUTF8, list(...))
160  }
161
162  # Temporarily opt-in to R/ file autoloading
163  withr::local_options(list(shiny.autoload.r = TRUE))
164
165  # + shinyAppDir_serverR
166  # +--- sourceUTF8
167  # +--+ loadSupport
168  # |  +--- sourceUTF8
169  loadSpy <- rewire(loadSupport, sourceUTF8 = sourceSpy)
170  sad <- rewire(shinyAppDir_appR, sourceUTF8 = sourceSpy, loadSupport = loadSpy)
171
172  sa <- sad("app.R", normalizePath(test_path("../test-helpers/app2-nested")))
173  sa$onStart()
174  sa$onStop() # Close down to free up resources
175
176  # Should have seen three calls -- first to two helpers then to app.R
177  expect_length(calls, 2)
178  expect_match(calls[[1]][[1]], "helper\\.R$", perl=TRUE)
179  expect_match(calls[[2]][[1]], "app\\.R$", perl=TRUE)
180
181  # Check environments
182  # helpers are loaded into a child of the global env
183  helperEnv1 <- calls[[1]]$envir
184  expect_identical(parent.env(helperEnv1), globalenv())
185
186  # app.R is sourced into a child environment of the helpers
187  expect_identical(parent.env(calls[[2]]$envir), helperEnv1)
188})
189
190test_that("global.R and sources in R/ are sourced in the app directory", {
191  appDir <- test_path("../test-helpers/app1-standard")
192  appGlobalEnv <- new.env(parent = globalenv())
193  appEnv <- new.env(parent = appGlobalEnv)
194  loadSupport(appDir, renv = appEnv, globalrenv = appGlobalEnv)
195
196  # Set by ../test-helpers/app1-standard/global.R
197  expect_equal(normalizePath(appGlobalEnv$global_wd), normalizePath(appDir))
198
199  # Set by ../test-helpers/app1-standard/R/helperCap.R
200  expect_equal(normalizePath(appEnv$source_wd), normalizePath(appDir))
201})
202
203test_that("Setting options in various places works", {
204  withr::local_options(list(shiny.launch.browser = FALSE))
205
206  # Use random ports to avoid errors while running revdepcheck in parallel
207  # https://github.com/rstudio/shiny/pull/3488
208  # Try up to 100 times to find a unique port
209  for (i in 1:100) {
210    test_app_port      <- httpuv::randomPort()
211    test_wrapped2_port <- httpuv::randomPort()
212    test_option_port   <- httpuv::randomPort()
213    # If all ports are unique, move on
214    if (length(unique(
215      c(test_app_port, test_wrapped2_port, test_option_port)
216    )) == 3) {
217      break
218    }
219  }
220  # Use system envvars to pass values into the tests
221  withr::local_envvar(
222    list(
223      SHINY_TESTTHAT_PORT_APP      = as.character(test_app_port),
224      SHINY_TESTTHAT_PORT_WRAPPED2 = as.character(test_wrapped2_port),
225      SHINY_TESTTHAT_PORT_OPTION   = as.character(test_option_port)
226    )
227  )
228
229  appDir <- test_path("../test-helpers/app7-port")
230  withPort <- function(port, expr) {
231    withr::local_options(list(app7.port = port))
232
233    force(expr)
234  }
235
236  expect_port <- function(expr, port) {
237    later::later(~stopApp(), 0)
238    testthat::expect_message(expr, paste0("Listening on http://127.0.0.1:", port), fixed = TRUE)
239  }
240
241  expect_port(runApp(appDir), test_app_port)
242
243  appObj <- source(file.path(appDir, "app.R"))$value
244  expect_port(print(appObj), test_app_port)
245
246  appObj <- shinyAppDir(appDir)
247  expect_port(print(appObj), test_app_port)
248
249  # The outermost call (shinyAppDir) has its options take precedence over the
250  # options in the inner call (shinyApp in app7-port/app.R).
251  options_port <- httpuv::randomPort()
252  appObj <- shinyAppDir(appDir, options = list(port = options_port))
253  expect_port(print(appObj), options_port)
254  expect_port(runApp(appObj), options_port)
255
256  # Options set directly on the runApp call take precedence over everything.
257  provided_port <- httpuv::randomPort()
258  expect_port(runApp(appObj, port = provided_port), provided_port)
259
260  # wrapped.R calls shinyAppDir("app.R")
261  expect_port(runApp(file.path(appDir, "wrapped.R")), test_app_port)
262  # wrapped2.R calls shinyAppFile("wrapped.R", options = list(port = 3032))
263  expect_port(runApp(file.path(appDir, "wrapped2.R")), test_wrapped2_port)
264
265  shiny_port_orig <- getOption("shiny.port")
266  # Calls to options(shiny.port = xxx) within app.R should also work reliably
267  expect_port(runApp(file.path(appDir, "option.R")), test_option_port)
268  # Ensure that option was unset/restored
269  expect_identical(getOption("shiny.port"), shiny_port_orig)
270  # options(shiny.port = xxx) is overrideable
271  override_port <- httpuv::randomPort()
272  appObj <- shinyAppFile(file.path(appDir, "option.R"), options = list(port = override_port))
273  expect_port(print(appObj), override_port)
274
275  # onStop still works even if app.R has an error (ensure option was unset)
276  expect_error(runApp(file.path(appDir, "option-broken.R")), "^boom$")
277  expect_null(getOption("shiny.port"))
278
279
280})
281