Disable reactlog from reactives.R

DESCRIPTION

@@ -77,17 +77,20 @@ Imports:
     promises (>= 1.0.1),
     tools,
     crayon,
-    rlang
+    rlang,
+    fastmap
 Suggests:
     datasets,
     Cairo (>= 1.5-5),
-    testthat,
+    testthat (>= 2.2.1),
     knitr (>= 1.6),
     markdown,
     rmarkdown,
     ggplot2,
     reactlog (>= 1.0.0),
     magrittr
+Remotes:
+    wch/fastmap
 URL: http://shiny.rstudio.com
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:

NAMESPACE

@@ -301,5 +301,6 @@ import(httpuv)
 import(methods)
 import(mime)
 import(xtable)
+importFrom(fastmap,fastmap)
 importFrom(grDevices,dev.cur)
 importFrom(grDevices,dev.set)

R/cache-memory.R

@@ -179,7 +179,7 @@ MemoryCache <- R6Class("MemoryCache",
       if (!is.numeric(max_size)) stop("max_size must be a number. Use `Inf` for no limit.")
       if (!is.numeric(max_age))  stop("max_age must be a number. Use `Inf` for no limit.")
       if (!is.numeric(max_n))    stop("max_n must be a number. Use `Inf` for no limit.")
-      private$cache        <- new.env(parent = emptyenv())
+      private$cache        <- fastmap()
       private$max_size     <- max_size
       private$max_age      <- max_age
       private$max_n        <- max_n
@@ -208,7 +208,7 @@ MemoryCache <- R6Class("MemoryCache",
       }
 
       private$log(paste0('get: key "', key, '" found'))
-      value <- private$cache[[key]]$value
+      value <- private$cache$get(key)$value
       value
     },
 
@@ -226,37 +226,36 @@ MemoryCache <- R6Class("MemoryCache",
         size <- NULL
       }
 
-      private$cache[[key]] <- list(
+      private$cache$set(key, list(
         key = key,
         value = value,
         size = size,
         mtime = time,
         atime = time
-      )
+      ))
       self$prune()
       invisible(self)
     },
 
     exists = function(key) {
       validate_key(key)
-      # Faster than `exists(key, envir = private$cache, inherits = FALSE)
-      !is.null(private$cache[[key]])
+      private$cache$exists(key)
     },
 
     keys = function() {
-      ls(private$cache, sorted = FALSE)  # Faster with sorted=FALSE
+      private$cache$keys()
     },
 
     remove = function(key) {
       private$log(paste0('remove: key "', key, '"'))
       validate_key(key)
-      rm(list = key, envir = private$cache)
+      private$cache$remove(key)
       invisible(self)
     },
 
     reset = function() {
       private$log(paste0('reset'))
-      rm(list = self$keys(), envir = private$cache)
+      private$cache$reset()
       invisible(self)
     },
 
@@ -271,7 +270,7 @@ MemoryCache <- R6Class("MemoryCache",
         rm_idx <- timediff > private$max_age
         if (any(rm_idx)) {
           private$log(paste0("prune max_age: Removing ", paste(info$key[rm_idx], collapse = ", ")))
-          rm(list = info$key[rm_idx], envir = private$cache)
+          private$cache$remove(info$key[rm_idx])
           info <- info[!rm_idx, ]
         }
       }
@@ -298,7 +297,7 @@ MemoryCache <- R6Class("MemoryCache",
         ensure_info_is_sorted()
         rm_idx <- seq_len(nrow(info)) > private$max_n
         private$log(paste0("prune max_n: Removing ", paste(info$key[rm_idx], collapse = ", ")))
-        rm(list = info$key[rm_idx], envir = private$cache)
+        private$cache$remove(info$key[rm_idx])
         info <- info[!rm_idx, ]
       }
 
@@ -308,7 +307,7 @@ MemoryCache <- R6Class("MemoryCache",
         cum_size <- cumsum(info$size)
         rm_idx <- cum_size > private$max_size
         private$log(paste0("prune max_size: Removing ", paste(info$key[rm_idx], collapse = ", ")))
-        rm(list = info$key[rm_idx], envir = private$cache)
+        private$cache$remove(info$key[rm_idx])
         info <- info[!rm_idx, ]
       }
 
@@ -335,23 +334,23 @@ MemoryCache <- R6Class("MemoryCache",
     maybe_prune_single = function(key) {
       if (!is.finite(private$max_age)) return()
 
-      obj <- private$cache[[key]]
+      obj <- private$cache$get(key)
       if (is.null(obj)) return()
 
       timediff <- as.numeric(Sys.time()) - obj$mtime
       if (timediff > private$max_age) {
         private$log(paste0("pruning single object exceeding max_age: Removing ", key))
-        rm(list = key, envir = private$cache)
+        private$cache$remove(key)
       }
     },
 
     object_info = function() {
-      keys <- ls(private$cache, sorted = FALSE)
+      keys <- private$cache$keys()
       data.frame(
         key   = keys,
-        size  = vapply(keys, function(key) private$cache[[key]]$size,  0),
-        mtime = vapply(keys, function(key) private$cache[[key]]$mtime, 0),
-        atime = vapply(keys, function(key) private$cache[[key]]$atime, 0),
+        size  = vapply(keys, function(key) private$cache$get(key)$size,  0),
+        mtime = vapply(keys, function(key) private$cache$get(key)$mtime, 0),
+        atime = vapply(keys, function(key) private$cache$get(key)$atime, 0),
         stringsAsFactors = FALSE
       )
     },

R/globals.R

@@ -6,6 +6,12 @@
   # package itself, making our PRNG completely deterministic. This line resets
   # the private seed during load.
   withPrivateSeed(set.seed(NULL))
+
+  appsByToken <<- Map$new()
+  appsNeedingFlush <<- Map$new()
+  timerCallbacks <<- TimerCallbacks$new()
+  initializeInputHandlers()
+  .globals$onStopCallbacks <<- Callbacks$new()
 }
 
 .onAttach <- function(libname, pkgname) {

R/map.R

@@ -9,63 +9,58 @@
 # Remove of unknown key does nothing
 # Setting a key twice always results in last-one-wins
 # /TESTS
+
+# Note that Map objects can't be saved in one R session and restored in
+# another, because they are based on fastmap, which uses an external pointer,
+# and external pointers can't be saved and restored in another session.
+#' @importFrom fastmap fastmap
 Map <- R6Class(
   'Map',
   portable = FALSE,
   public = list(
     initialize = function() {
-      private$env <- new.env(parent=emptyenv())
+      private$map <<- fastmap()
     },
     get = function(key) {
-      env[[key]]
+      map$get(key)
     },
     set = function(key, value) {
-      env[[key]] <- value
+      map$set(key, value)
       value
     },
     mget = function(keys) {
-      base::mget(keys, env)
+      map$mget(keys)
     },
     mset = function(...) {
-      args <- list(...)
-      if (length(args) == 0)
-        return()
-
-      arg_names <- names(args)
-      if (is.null(arg_names) || any(!nzchar(arg_names)))
-        stop("All elements must be named")
-
-      list2env(args, envir = env)
+      map$mset(...)
     },
     remove = function(key) {
-      if (!self$containsKey(key))
+      if (!map$exists(key))
         return(NULL)
 
-      result <- env[[key]]
-      rm(list=key, envir=env, inherits=FALSE)
+      result <- map$get(key)
+      map$remove(key)
       result
     },
     containsKey = function(key) {
-      exists(key, envir=env, inherits=FALSE)
+      map$exists(key)
     },
     keys = function() {
-      # Sadly, this is much faster than ls(), because it doesn't sort the keys.
-      names(as.list(env, all.names=TRUE))
+      map$keys()
     },
     values = function() {
-      as.list(env, all.names=TRUE)
+      map$as_list()
     },
     clear = function() {
-      private$env <- new.env(parent=emptyenv())
-      invisible(NULL)
+      map$reset()
     },
     size = function() {
-      length(env)
+      map$size()
     }
   ),
 
   private = list(
-    env = 'environment'
+    map = NULL
   )
 )
 

R/reactives.R

@@ -21,28 +21,28 @@ Dependents <- R6Class(
         # must wrap in if statement as ctx react id could be NULL
         #   if options(shiny.suppressMissingContextError = TRUE)
         if (is.character(.reactId) && is.character(ctx$.reactId)) {
-          rLog$dependsOn(ctx$.reactId, .reactId, ctx$id, ctx$.domain)
+          # rLog$dependsOn(ctx$.reactId, .reactId, ctx$id, ctx$.domain)
         }
 
         .dependents$set(ctx$id, ctx)
 
         ctx$onInvalidate(function() {
-          rLog$dependsOnRemove(ctx$.reactId, .reactId, ctx$id, ctx$.domain)
+          # rLog$dependsOnRemove(ctx$.reactId, .reactId, ctx$id, ctx$.domain)
           .dependents$remove(ctx$id)
         })
       }
     },
     # at times, the context is run in a ctx$onInvalidate(...) which has no runtime context
     invalidate = function(log = TRUE) {
-      if (isTRUE(log)) {
+      # if (isTRUE(log)) {
 
-        domain <- getDefaultReactiveDomain()
-        rLog$invalidateStart(.reactId, NULL, "other", domain)
-        on.exit(
-          rLog$invalidateEnd(.reactId, NULL, "other", domain),
-          add = TRUE
-        )
-      }
+        # domain <- getDefaultReactiveDomain()
+        # rLog$invalidateStart(.reactId, NULL, "other", domain)
+        # on.exit(
+          # rLog$invalidateEnd(.reactId, NULL, "other", domain),
+          # add = TRUE
+        # )
+      # }
       lapply(
         .dependents$values(),
         function(ctx) {
@@ -74,7 +74,7 @@ ReactiveVal <- R6Class(
       private$value <- value
       private$label <- label
       private$dependents <- Dependents$new(reactId = private$reactId)
-      rLog$define(private$reactId, value, private$label, type = "reactiveVal", getDefaultReactiveDomain())
+      # rLog$define(private$reactId, value, private$label, type = "reactiveVal", getDefaultReactiveDomain())
     },
     get = function() {
       private$dependents$register()
@@ -88,7 +88,7 @@ ReactiveVal <- R6Class(
       if (identical(private$value, value)) {
         return(invisible(FALSE))
       }
-      rLog$valueChange(private$reactId, value, getDefaultReactiveDomain())
+      # rLog$valueChange(private$reactId, value, getDefaultReactiveDomain())
       private$value <- value
       private$dependents$invalidate()
       invisible(TRUE)
@@ -97,14 +97,14 @@ ReactiveVal <- R6Class(
       if (is.null(session)) {
         stop("Can't freeze a reactiveVal without a reactive domain")
       }
-      rLog$freezeReactiveVal(private$reactId, session)
+      # rLog$freezeReactiveVal(private$reactId, session)
       session$onFlushed(function() {
         self$thaw(session)
       })
       private$frozen <- TRUE
     },
     thaw = function(session = getDefaultReactiveDomain()) {
-      rLog$thawReactiveVal(private$reactId, session)
+      # rLog$thawReactiveVal(private$reactId, session)
       private$frozen <- FALSE
     },
     isFrozen = function() {
@@ -292,9 +292,9 @@ ReactiveValues <- R6Class(
     # For debug purposes
     .reactId = character(0),
     .label = character(0),
-    .values = 'environment',
-    .metadata = 'environment',
-    .dependents = 'environment',
+    .values = 'Map',
+    .metadata = 'Map',
+    .dependents = 'Map',
     # Dependents for the list of all names, including hidden
     .namesDeps = 'Dependents',
     # Dependents for all values, including hidden
@@ -312,9 +312,9 @@ ReactiveValues <- R6Class(
     ) {
       .reactId <<- nextGlobalReactId()
       .label <<- label
-      .values <<- new.env(parent=emptyenv())
-      .metadata <<- new.env(parent=emptyenv())
-      .dependents <<- new.env(parent=emptyenv())
+      .values <<- Map$new()
+      .metadata <<- Map$new()
+      .dependents <<- Map$new()
       .hasRetrieved <<- list(names = FALSE, asListAll = FALSE, asList = FALSE, keys = list())
       .namesDeps <<- Dependents$new(reactId = rLog$namesIdStr(.reactId))
       .allValuesDeps <<- Dependents$new(reactId = rLog$asListAllIdStr(.reactId))
@@ -324,27 +324,24 @@ ReactiveValues <- R6Class(
 
     get = function(key) {
       # get value right away to use for logging
-      if (!exists(key, envir=.values, inherits=FALSE))
-        keyValue <- NULL
-      else
-        keyValue <- .values[[key]]
+      keyValue <- .values$get(key)
 
       # Register the "downstream" reactive which is accessing this value, so
       # that we know to invalidate them when this value changes.
       ctx <- getCurrentContext()
       dep.key <- paste(key, ':', ctx$id, sep='')
-      if (!exists(dep.key, envir=.dependents, inherits=FALSE)) {
-        reactKeyId <- rLog$keyIdStr(.reactId, key)
+      if (!.dependents$containsKey(dep.key)) {
+        # reactKeyId <- rLog$keyIdStr(.reactId, key)
 
         if (!isTRUE(.hasRetrieved$keys[[key]])) {
-          rLog$defineKey(.reactId, keyValue, key, .label, ctx$.domain)
+          # rLog$defineKey(.reactId, keyValue, key, .label, ctx$.domain)
           .hasRetrieved$keys[[key]] <<- TRUE
         }
-        rLog$dependsOnKey(ctx$.reactId, .reactId, key, ctx$id, ctx$.domain)
-        .dependents[[dep.key]] <- ctx
+        # rLog$dependsOnKey(ctx$.reactId, .reactId, key, ctx$id, ctx$.domain)
+        .dependents$set(dep.key, ctx)
         ctx$onInvalidate(function() {
-          rLog$dependsOnKeyRemove(ctx$.reactId, .reactId, key, ctx$id, ctx$.domain)
-          rm(list=dep.key, envir=.dependents, inherits=FALSE)
+          # rLog$dependsOnKeyRemove(ctx$.reactId, .reactId, key, ctx$id, ctx$.domain)
+          .dependents$remove(dep.key)
         })
       }
 
@@ -384,54 +381,53 @@ ReactiveValues <- R6Class(
       domain <- getDefaultReactiveDomain()
       hidden <- substr(key, 1, 1) == "."
 
-      key_exists <- exists(key, envir=.values, inherits=FALSE)
+      key_exists <- .values$containsKey(key)
 
       if (key_exists) {
-        if (.dedupe && identical(.values[[key]], value)) {
+        if (.dedupe && identical(.values$get(key), value)) {
           return(invisible())
         }
       }
 
       # set the value for better logging
-      .values[[key]] <- value
+      .values$set(key, value)
 
       # key has been depended upon
-      if (isTRUE(.hasRetrieved$keys[[key]])) {
-        rLog$valueChangeKey(.reactId, key, value, domain)
-        keyReactId <- rLog$keyIdStr(.reactId, key)
-        rLog$invalidateStart(keyReactId, NULL, "other", domain)
-        on.exit(
-          rLog$invalidateEnd(keyReactId, NULL, "other", domain),
-          add = TRUE
-        )
-      }
+      # if (isTRUE(.hasRetrieved$keys[[key]])) {
+        # rLog$valueChangeKey(.reactId, key, value, domain)
+        # keyReactId <- rLog$keyIdStr(.reactId, key)
+        # rLog$invalidateStart(keyReactId, NULL, "other", domain)
+        # on.exit(
+          # rLog$invalidateEnd(keyReactId, NULL, "other", domain),
+          # add = TRUE
+        # )
+      # }
 
       # only invalidate if there are deps
       if (!key_exists && isTRUE(.hasRetrieved$names)) {
-        rLog$valueChangeNames(.reactId, ls(.values, all.names = TRUE), domain)
+        # rLog$valueChangeNames(.reactId, .values$keys(), domain)
         .namesDeps$invalidate()
       }
 
       if (hidden) {
         if (isTRUE(.hasRetrieved$asListAll)) {
-          rLog$valueChangeAsListAll(.reactId, as.list(.values, all.names = TRUE), domain)
+          # rLog$valueChangeAsListAll(.reactId, .values$values(), domain)
           .allValuesDeps$invalidate()
         }
       } else {
         if (isTRUE(.hasRetrieved$asList)) {
+          react_vals <- .values$values()
+          react_vals <- react_vals[!grepl("^\\.", base::names(react_vals))]
           # leave as is. both object would be registered to the listening object
-          rLog$valueChangeAsList(.reactId, as.list(.values, all.names = FALSE), domain)
+          # rLog$valueChangeAsList(.reactId, react_vals, domain)
           .valuesDeps$invalidate()
         }
       }
 
-      dep.keys <- objects(
-        envir=.dependents,
-        pattern=paste('^\\Q', key, ':', '\\E', '\\d+$', sep=''),
-        all.names=TRUE
-      )
+      dep.keys <- .dependents$keys()
+      dep.keys <- dep.keys[grepl(paste('^\\Q', key, ':', '\\E', '\\d+$', sep=''), dep.keys)]
       lapply(
-        mget(dep.keys, envir=.dependents),
+        .dependents$mget(dep.keys),
         function(ctx) {
           ctx$invalidate()
           NULL
@@ -448,10 +444,10 @@ ReactiveValues <- R6Class(
     },
 
     names = function() {
-      nameValues <- ls(.values, all.names=TRUE)
+      nameValues <- .values$keys()
       if (!isTRUE(.hasRetrieved$names)) {
         domain <- getDefaultReactiveDomain()
-        rLog$defineNames(.reactId, nameValues, .label, domain)
+        # rLog$defineNames(.reactId, nameValues, .label, domain)
         .hasRetrieved$names <<- TRUE
       }
       .namesDeps$register()
@@ -462,7 +458,7 @@ ReactiveValues <- R6Class(
     getMeta = function(key, metaKey) {
       # Make sure to use named (not numeric) indexing into list.
       metaKey <- as.character(metaKey)
-      .metadata[[key]][[metaKey]]
+      .metadata$get("key")[[metaKey]]
     },
 
     # Set a metadata value. Does not trigger reactivity.
@@ -470,24 +466,26 @@ ReactiveValues <- R6Class(
       # Make sure to use named (not numeric) indexing into list.
       metaKey <- as.character(metaKey)
 
-      if (!exists(key, envir = .metadata, inherits = FALSE)) {
-        .metadata[[key]] <<- list()
+      if (!.metadata$containsKey(key)) {
+        .metadata$set(key, list())
       }
 
-      .metadata[[key]][[metaKey]] <<- value
+      m <- .metadata$get(key)
+      m[[metaKey]] <- value
+      .metadata$set(key, m)
     },
 
     # Mark a value as frozen If accessed while frozen, a shiny.silent.error will
     # be thrown.
     freeze = function(key) {
       domain <- getDefaultReactiveDomain()
-      rLog$freezeReactiveKey(.reactId, key, domain)
+      # rLog$freezeReactiveKey(.reactId, key, domain)
       setMeta(key, "frozen", TRUE)
     },
 
     thaw = function(key) {
       domain <- getDefaultReactiveDomain()
-      rLog$thawReactiveKey(.reactId, key, domain)
+      # rLog$thawReactiveKey(.reactId, key, domain)
       setMeta(key, "frozen", NULL)
     },
 
@@ -496,11 +494,14 @@ ReactiveValues <- R6Class(
     },
 
     toList = function(all.names=FALSE) {
-      listValue <- as.list(.values, all.names=all.names)
+      listValue <- .values$values()
+      if (!all.names) {
+        listValue <- listValue[!grepl("^\\.", base::names(listValue))]
+      }
       if (all.names) {
         if (!isTRUE(.hasRetrieved$asListAll)) {
           domain <- getDefaultReactiveDomain()
-          rLog$defineAsListAll(.reactId, listValue, .label, domain)
+          # rLog$defineAsListAll(.reactId, listValue, .label, domain)
           .hasRetrieved$asListAll <<- TRUE
         }
         .allValuesDeps$register()
@@ -509,7 +510,7 @@ ReactiveValues <- R6Class(
       if (!isTRUE(.hasRetrieved$asList)) {
         domain <- getDefaultReactiveDomain()
         # making sure the value being recorded is with `all.names = FALSE`
-        rLog$defineAsList(.reactId, as.list(.values, all.names=FALSE), .label, domain)
+        # rLog$defineAsList(.reactId, listValue[!grepl("^\\.", base::names(listValue))], .label, domain)
         .hasRetrieved$asList <<- TRUE
       }
       .valuesDeps$register()
@@ -829,7 +830,7 @@ Observable <- R6Class(
       .running <<- FALSE
       .execCount <<- 0L
       .mostRecentCtxId <<- ""
-      rLog$define(.reactId, .value, .label, type = "observable", .domain)
+      # rLog$define(.reactId, .value, .label, type = "observable", .domain)
     },
     getValue = function() {
       .dependents$register()
@@ -1079,7 +1080,7 @@ Observer <- R6Class(
       setAutoDestroy(autoDestroy)
 
       .reactId <<- nextGlobalReactId()
-      rLog$defineObserver(.reactId, .label, .domain)
+      # rLog$defineObserver(.reactId, .label, .domain)
 
       # Defer the first running of this until flushReact is called
       .createContext()$invalidate()
@@ -1604,7 +1605,7 @@ invalidateLater <- function(millis, session = getDefaultReactiveDomain()) {
   force(session)
 
   ctx <- getCurrentContext()
-  rLog$invalidateLater(ctx$.reactId, ctx$id, millis, session)
+  # rLog$invalidateLater(ctx$.reactId, ctx$id, millis, session)
 
   timerHandle <- scheduleTask(millis, function() {
     if (is.null(session)) {

R/server-input-handlers.R

@@ -1,5 +1,6 @@
-# Create a map for input handlers and register the defaults.
-inputHandlers <- Map$new()
+# Create a map for input handlers and register the defaults. The Map object is
+# initialized in initializeInputHandlers, which is called from .onLoad().
+inputHandlers <- NULL
 
 #' Register an Input Handler
 #'
@@ -128,114 +129,118 @@ applyInputHandlers <- function(inputs, shinysession = getDefaultReactiveDomain()
 }
 
 
-# Takes a list-of-lists and returns a matrix. The lists
-# must all be the same length. NULL is replaced by NA.
-registerInputHandler("shiny.matrix", function(data, ...) {
-  if (length(data) == 0)
-    return(matrix(nrow=0, ncol=0))
+initializeInputHandlers <- function() {
+  inputHandlers <<- Map$new()
 
-  m <- matrix(unlist(lapply(data, function(x) {
-    sapply(x, function(y) {
-      ifelse(is.null(y), NA, y)
-    })
-  })), nrow = length(data[[1]]), ncol = length(data))
-  return(m)
-})
+  # Takes a list-of-lists and returns a matrix. The lists
+  # must all be the same length. NULL is replaced by NA.
+  registerInputHandler("shiny.matrix", function(data, ...) {
+    if (length(data) == 0)
+      return(matrix(nrow=0, ncol=0))
 
-
-registerInputHandler("shiny.number", function(val, ...){
-  ifelse(is.null(val), NA, val)
-})
-
-registerInputHandler("shiny.password", function(val, shinysession, name) {
-  # Mark passwords as not serializable
-  setSerializer(name, serializerUnserializable)
-  val
-})
-
-registerInputHandler("shiny.date", function(val, ...){
-  # First replace NULLs with NA, then convert to Date vector
-  datelist <- ifelse(lapply(val, is.null), NA, val)
-
-  res <- NULL
-  tryCatch({
-      res <- as.Date(unlist(datelist))
-    },
-    error = function(e) {
-      # It's possible for client to send a string like "99999-01-01", which
-      # as.Date can't handle.
-      warning(e$message)
-      res <<- as.Date(rep(NA, length(datelist)))
-    }
-  )
-
-  res
-})
-
-registerInputHandler("shiny.datetime", function(val, ...){
-  # First replace NULLs with NA, then convert to POSIXct vector
-  times <- lapply(val, function(x) {
-    if (is.null(x)) NA
-    else x
+    m <- matrix(unlist(lapply(data, function(x) {
+      sapply(x, function(y) {
+        ifelse(is.null(y), NA, y)
+      })
+    })), nrow = length(data[[1]]), ncol = length(data))
+    return(m)
   })
-  as.POSIXct(unlist(times), origin = "1970-01-01", tz = "UTC")
-})
-
-registerInputHandler("shiny.action", function(val, shinysession, name) {
-  # mark up the action button value with a special class so we can recognize it later
-  class(val) <- c(class(val), "shinyActionButtonValue")
-  val
-})
-
-registerInputHandler("shiny.file", function(val, shinysession, name) {
-  # This function is only used when restoring a Shiny fileInput. When a file is
-  # uploaded the usual way, it takes a different code path and won't hit this
-  # function.
-  if (is.null(val))
-    return(NULL)
-
-  # The data will be a named list of lists; convert to a data frame.
-  val <- as.data.frame(lapply(val, unlist), stringsAsFactors = FALSE)
-
-  # `val$datapath` should be a filename without a path, for security reasons.
-  if (basename(val$datapath) != val$datapath) {
-    stop("Invalid '/' found in file input path.")
-  }
-
-  # Prepend the persistent dir
-  oldfile <- file.path(getCurrentRestoreContext()$dir, val$datapath)
-
-  # Copy the original file to a new temp dir, so that a restored session can't
-  # modify the original.
-  newdir <- file.path(tempdir(), createUniqueId(12))
-  dir.create(newdir)
-  val$datapath <- file.path(newdir, val$datapath)
-  file.copy(oldfile, val$datapath)
-
-  # Need to mark this input value with the correct serializer. When a file is
-  # uploaded the usual way (instead of being restored), this occurs in
-  # session$`@uploadEnd`.
-  setSerializer(name, serializerFileInput)
-
-  snapshotPreprocessInput(name, snapshotPreprocessorFileInput)
-
-  val
-})
 
 
-# to be used with !!!answer
-registerInputHandler("shiny.symbolList", function(val, ...) {
-  if (is.null(val)) {
-    list()
-  } else {
-    lapply(val, as.symbol)
-  }
-})
-# to be used with !!answer
-registerInputHandler("shiny.symbol", function(val, ...) {
-  if (is.null(val) || identical(val, "")) {
-    NULL
-  } else {
-    as.symbol(val)
-  }
-})
+  registerInputHandler("shiny.number", function(val, ...){
+    ifelse(is.null(val), NA, val)
+  })
+
+  registerInputHandler("shiny.password", function(val, shinysession, name) {
+    # Mark passwords as not serializable
+    setSerializer(name, serializerUnserializable)
+    val
+  })
+
+  registerInputHandler("shiny.date", function(val, ...){
+    # First replace NULLs with NA, then convert to Date vector
+    datelist <- ifelse(lapply(val, is.null), NA, val)
+
+    res <- NULL
+    tryCatch({
+        res <- as.Date(unlist(datelist))
+      },
+      error = function(e) {
+        # It's possible for client to send a string like "99999-01-01", which
+        # as.Date can't handle.
+        warning(e$message)
+        res <<- as.Date(rep(NA, length(datelist)))
+      }
+    )
+
+    res
+  })
+
+  registerInputHandler("shiny.datetime", function(val, ...){
+    # First replace NULLs with NA, then convert to POSIXct vector
+    times <- lapply(val, function(x) {
+      if (is.null(x)) NA
+      else x
+    })
+    as.POSIXct(unlist(times), origin = "1970-01-01", tz = "UTC")
+  })
+
+  registerInputHandler("shiny.action", function(val, shinysession, name) {
+    # mark up the action button value with a special class so we can recognize it later
+    class(val) <- c(class(val), "shinyActionButtonValue")
+    val
+  })
+
+  registerInputHandler("shiny.file", function(val, shinysession, name) {
+    # This function is only used when restoring a Shiny fileInput. When a file is
+    # uploaded the usual way, it takes a different code path and won't hit this
+    # function.
+    if (is.null(val))
+      return(NULL)
+
+    # The data will be a named list of lists; convert to a data frame.
+    val <- as.data.frame(lapply(val, unlist), stringsAsFactors = FALSE)
+
+    # `val$datapath` should be a filename without a path, for security reasons.
+    if (basename(val$datapath) != val$datapath) {
+      stop("Invalid '/' found in file input path.")
+    }
+
+    # Prepend the persistent dir
+    oldfile <- file.path(getCurrentRestoreContext()$dir, val$datapath)
+
+    # Copy the original file to a new temp dir, so that a restored session can't
+    # modify the original.
+    newdir <- file.path(tempdir(), createUniqueId(12))
+    dir.create(newdir)
+    val$datapath <- file.path(newdir, val$datapath)
+    file.copy(oldfile, val$datapath)
+
+    # Need to mark this input value with the correct serializer. When a file is
+    # uploaded the usual way (instead of being restored), this occurs in
+    # session$`@uploadEnd`.
+    setSerializer(name, serializerFileInput)
+
+    snapshotPreprocessInput(name, snapshotPreprocessorFileInput)
+
+    val
+  })
+
+
+  # to be used with !!!answer
+  registerInputHandler("shiny.symbolList", function(val, ...) {
+    if (is.null(val)) {
+      list()
+    } else {
+      lapply(val, as.symbol)
+    }
+  })
+  # to be used with !!answer
+  registerInputHandler("shiny.symbol", function(val, ...) {
+    if (is.null(val) || identical(val, "")) {
+      NULL
+    } else {
+      as.symbol(val)
+    }
+  })
+}

R/server.R

@@ -1,7 +1,9 @@
 #' @include server-input-handlers.R
 
-appsByToken <- Map$new()
-appsNeedingFlush <- Map$new()
+# These Map objects are initialized in .onLoad() because Maps based on fastmap
+# can't be saved in one R session and loaded in another.
+appsByToken <- NULL
+appsNeedingFlush <- NULL
 
 # Provide a character representation of the WS that can be used
 # as a key in a Map.

R/shiny.R

@@ -513,8 +513,7 @@ ShinySession <- R6Class(
       # in the web page; in these cases, there's no output_foo_hidden flag,
       # and hidden should be TRUE. In other words, NULL and TRUE should map to
       # TRUE, FALSE should map to FALSE.
-      hidden <- private$.clientData$.values[[paste("output_", name, "_hidden",
-                                           sep="")]]
+      hidden <- private$.clientData$.values$get(paste0("output_", name, "_hidden"))
       if (is.null(hidden)) hidden <- TRUE
 
       return(hidden && private$getOutputOption(name, 'suspendWhenHidden', TRUE))
@@ -1917,7 +1916,7 @@ ShinySession <- R6Class(
 
       fileData <- readBin(file, 'raw', n=bytes)
 
-      if (isTRUE(private$.clientData$.values$allowDataUriScheme)) {
+      if (isTRUE(private$.clientData$.values$get("allowDataUriScheme"))) {
         b64 <- rawToBase64(fileData)
         return(paste('data:', contentType, ';base64,', b64, sep=''))
       } else {
@@ -2220,7 +2219,8 @@ flushPendingSessions <- function() {
   })
 }
 
-.globals$onStopCallbacks <- Callbacks$new()
+# Initialized in .onLoad
+.globals$onStopCallbacks <- NULL
 
 #' Run code after an application or session ends
 #'

R/timer.R

@@ -86,7 +86,8 @@ TimerCallbacks <- R6Class(
   )
 )
 
-timerCallbacks <- TimerCallbacks$new()
+# Initialized in onLoad() because TimerCallbacks uses Map.
+timerCallbacks <- NULL
 
 scheduleTask <- function(millis, callback) {
   cancelled <- FALSE

tests/testthat/test-reactivity.r

@@ -521,8 +521,8 @@ test_that("names() and reactiveValuesToList()", {
   # Assigning names fails
   expect_error(isolate(names(v) <- c('x', 'y')))
 
-  expect_equal(isolate(reactiveValuesToList(values)), list(A=1))
-  expect_equal(isolate(reactiveValuesToList(values, all.names=TRUE)), list(A=1, .B=2))
+  expect_mapequal(isolate(reactiveValuesToList(values)), list(A=1))
+  expect_mapequal(isolate(reactiveValuesToList(values, all.names=TRUE)), list(A=1, .B=2))
 
 
   flushReact()
@@ -1137,10 +1137,10 @@ test_that("reactive domain works across async handlers", {
       ~{hasReactiveDomain <<- identical(getDefaultReactiveDomain(), obj)}
     )
   })
-  
+
   while (is.null(hasReactiveDomain) && !later::loop_empty()) {
     later::run_now()
   }
-  
+
   testthat::expect_true(hasReactiveDomain)
 })