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