Merge branch 'master' of https://github.com/rstudio/shiny into news-patch

NEWS.md

@@ -18,6 +18,8 @@ shiny 1.5.0.9000
 
 * Fixed #2859: `renderPlot()` wasn't correctly setting `showtext::showtext_opts()`'s `dpi` setting with the correct resolution on high resolution displays; which means, if the font was rendered by showtext, font sizes would look smaller than they should on such displays. (#2941)
 
+* Fixed #1942: Calling `runApp("app.R")` no longer ignores options passed into `shinyApp()`. This makes it possible for Shiny apps to specify what port/host should be used by default. (#2969)
+
 ### Library updates
 
 * Removed html5shiv and respond.js, which were used for IE 8 and IE 9 compatibility. (#2973)

R/app.R

@@ -385,21 +385,24 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
 {
   fullpath <- file.path.ci(appDir, fileName)
 
-  # In an upcoming version of shiny, this option will go away.
-  if (getOption("shiny.autoload.r", TRUE)) {
-    # Create a child env which contains all the helpers and will be the shared parent
-    # of the ui.R and server.R load.
-    sharedEnv <- new.env(parent = globalenv())
-  } else {
-    sharedEnv <- globalenv()
-  }
-
-
   # This sources app.R and caches the content. When appObj() is called but
   # app.R hasn't changed, it won't re-source the file. But if called and
   # app.R has changed, it'll re-source the file and return the result.
   appObj <- cachedFuncWithFile(appDir, fileName, case.sensitive = FALSE,
     function(appR) {
+      wasDir <- setwd(appDir)
+      on.exit(setwd(wasDir))
+
+      # TODO: we should support hot reloading on R/*.R changes.
+      # In an upcoming version of shiny, this option will go away.
+      if (getOption("shiny.autoload.r", TRUE)) {
+        # Create a child env which contains all the helpers and will be the shared parent
+        # of the ui.R and server.R load.
+        sharedEnv <- new.env(parent = globalenv())
+        loadSupport(appDir, renv=sharedEnv, globalrenv=NULL)
+      } else {
+        sharedEnv <- globalenv()
+      }
       result <- sourceUTF8(fullpath, envir = new.env(parent = sharedEnv))
 
       if (!is.shiny.appobj(result))
@@ -443,10 +446,6 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
   onStart <- function() {
     oldwd <<- getwd()
     setwd(appDir)
-    # TODO: we should support hot reloading on R/*.R changes.
-    if (getOption("shiny.autoload.r", TRUE)) {
-      loadSupport(appDir, renv=sharedEnv, globalrenv=NULL)
-    }
     if (!is.null(appObj()$onStart)) appObj()$onStart()
     monitorHandle <<- initAutoReloadMonitor(appDir)
     invisible()
@@ -462,6 +461,8 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
     }
   }
 
+  appObjOptions <- appObj()$options
+
   structure(
     list(
       # fallbackWWWDir is _not_ listed in staticPaths, because it needs to
@@ -480,7 +481,7 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
       serverFuncSource = dynServerFuncSource,
       onStart = onStart,
       onStop = onStop,
-      options = options
+      options = joinOptions(appObjOptions, options)
     ),
     class = "shiny.appobj"
   )
@@ -530,18 +531,25 @@ is.shiny.appobj <- function(x) {
 }
 
 #' @rdname shiny.appobj
-#' @param ... Additional parameters to be passed to print.
+#' @param ... Ignored.
 #' @export
 print.shiny.appobj <- function(x, ...) {
-  opts <- x$options %OR% list()
-  opts <- opts[names(opts) %in%
-      c("port", "launch.browser", "host", "quiet",
-        "display.mode", "test.mode")]
+  runApp(x)
+}
 
-  # Quote x and put runApp in quotes so that there's a nicer stack trace (#1851)
-  args <- c(list(quote(x)), opts)
+# Joins two options objects (i.e. the `options` argument to shinyApp(),
+# shinyAppDir(), etc.). The values in `b` should take precedence over the values
+# in `a`. Given the current options available, it is safe to throw away any
+# values in `a` that are provided in `b`. But in the future, if new options are
+# introduced that need to be combined in some way instead of simply overwritten,
+# then this will be the place to do it. See the implementations of
+# print.shiny.appobj() and runApp() (for the latter, look specifically for
+# "findVal()") to determine the set of possible options.
+joinOptions <- function(a, b) {
+  stopifnot(is.null(a) || is.list(a))
+  stopifnot(is.null(b) || is.list(b))
 
-  do.call("runApp", args)
+  mergeVectors(a, b)
 }
 
 #' @rdname shiny.appobj

R/server.R

@@ -786,6 +786,15 @@ runApp <- function(appDir=getwd(),
     shinyOptions(cache = MemoryCache$new())
   }
 
+  # Invoke user-defined onStop callbacks, before the application's internal
+  # onStop callbacks.
+  on.exit({
+    .globals$onStopCallbacks$invoke()
+    .globals$onStopCallbacks <- Callbacks$new()
+  }, add = TRUE)
+
+  require(shiny)
+
   appParts <- as.shiny.appobj(appDir)
 
   # The lines below set some of the app's running options, which
@@ -899,8 +908,6 @@ runApp <- function(appDir=getwd(),
     setShowcaseDefault(1)
   }
 
-  require(shiny)
-
   # determine port if we need to
   if (is.null(port)) {
 
@@ -939,13 +946,6 @@ runApp <- function(appDir=getwd(),
     }
   }
 
-  # Invoke user-defined onStop callbacks, before the application's internal
-  # onStop callbacks.
-  on.exit({
-    .globals$onStopCallbacks$invoke()
-    .globals$onStopCallbacks <- Callbacks$new()
-  }, add = TRUE)
-
   # Extract appOptions (which is a list) and store them as shinyOptions, for
   # this app. (This is the only place we have to store settings that are
   # accessible both the UI and server portion of the app.)

man/shiny.appobj.Rd

@@ -28,7 +28,7 @@ is.shiny.appobj(x)
 \arguments{
 \item{x}{Object to convert to a Shiny app.}
 
-\item{...}{Additional parameters to be passed to print.}
+\item{...}{Ignored.}
 }
 \description{
 Internal methods for the \code{shiny.appobj} S3 class.

tests/test-helpers/app7-port/app.R

@@ -0,0 +1,14 @@
+library(shiny)
+
+ui <- fluidPage(
+)
+
+server <- function(input, output, session) {
+}
+
+opts <- list(
+  port = 3030,
+  launch.browser = FALSE
+)
+
+shinyApp(ui, server, options = opts)

tests/test-helpers/app7-port/option-broken.R

@@ -0,0 +1,6 @@
+library(shiny)
+
+op <- options(shiny.port = 7777)
+onStop(function() { options(op) })
+
+stop("boom")

tests/test-helpers/app7-port/option.R

@@ -0,0 +1,14 @@
+library(shiny)
+
+op <- options(shiny.port = 7777)
+onStop(function() { options(op) })
+
+ui <- fluidPage(
+
+)
+
+server <- function(input, output, session) {
+
+}
+
+shinyApp(ui, server)

tests/test-helpers/app7-port/wrapped.R

@@ -0,0 +1 @@
+shinyAppDir(".")

tests/test-helpers/app7-port/wrapped2.R

@@ -0,0 +1 @@
+shinyAppFile("wrapped.R", options = list(port = 3032))

tests/testthat/test-app.R

@@ -54,9 +54,8 @@ test_that("With ui/server.R, global.R is loaded before R/ helpers and into the r
   }
 
   # Temporarily opt-in to R/ file autoloading
-  orig <- getOption("shiny.autoload.r", NULL)
-  options(shiny.autoload.r=TRUE)
-  on.exit({options(shiny.autoload.r=orig)}, add=TRUE)
+  op <- options(shiny.autoload.r=TRUE)
+  on.exit(options(op), add=TRUE)
 
   # + shinyAppDir_serverR
   # +--- sourceUTF8
@@ -210,3 +209,56 @@ test_that("global.R and sources in R/ are sourced in the app directory", {
   # Set by ../test-helpers/app1-standard/R/helperCap.R
   expect_equal(normalizePath(appEnv$source_wd), normalizePath(appDir))
 })
+
+test_that("Setting options in various places works", {
+  op <- options(shiny.launch.browser = FALSE)
+  on.exit(options(op), add = TRUE)
+
+  appDir <- test_path("../test-helpers/app7-port")
+  withPort <- function(port, expr) {
+    op <- options(app7.port = port)
+    on.exit(options(op), add = TRUE)
+
+    force(expr)
+  }
+
+  expect_port <- function(expr, port) {
+    later::later(~stopApp(), 0)
+    expect_message(expr, paste0("Listening on http://127.0.0.1:", port), fixed = TRUE)
+  }
+
+  expect_port(runApp(appDir), 3030)
+
+  appObj <- source(file.path(appDir, "app.R"))$value
+  expect_port(print(appObj), 3030)
+
+  appObj <- shinyAppDir(appDir)
+  expect_port(print(appObj), 3030)
+
+  # The outermost call (shinyAppDir) has its options take precedence over the
+  # options in the inner call (shinyApp in app7-port/app.R).
+  appObj <- shinyAppDir(appDir, options = list(port = 4040))
+  expect_port(print(appObj), 4040)
+  expect_port(runApp(appObj), 4040)
+
+  # Options set directly on the runApp call take precedence over everything.
+  expect_port(runApp(appObj, port = 5050), 5050)
+
+  # wrapped.R calls shinyAppDir("app.R")
+  expect_port(runApp(file.path(appDir, "wrapped.R")), 3030)
+  # wrapped2.R calls shinyAppFile("wrapped.R", options = list(port = 3032))
+  expect_port(runApp(file.path(appDir, "wrapped2.R")), 3032)
+
+  shiny_port_orig <- getOption("shiny.port")
+  # Calls to options(shiny.port = xxx) within app.R should also work reliably
+  expect_port(runApp(file.path(appDir, "option.R")), 7777)
+  # Ensure that option was unset/restored
+  expect_identical(getOption("shiny.port"), shiny_port_orig)
+  # options(shiny.port = xxx) is overrideable
+  appObj <- shinyAppFile(file.path(appDir, "option.R"), options = list(port = 8888))
+  expect_port(print(appObj), 8888)
+
+  # onStop still works even if app.R has an error (ensure option was unset)
+  expect_error(runApp(file.path(appDir, "option-broken.R")), "^boom$")
+  expect_null(getOption("shiny.port"))
+})