Fix validation error handling

Validation errors were behaving too much like real errors: they were
being printed with stack traces, and passed to the options(shiny.error)
function. Also, if a reactive() cached a validation error, on future
calls the error would be re-raised (which is correct) without the
custom class names attached (which is not).

R/conditions.R

@@ -130,6 +130,9 @@ withLogErrors <- function(expr,
   withCallingHandlers(
     captureStackTraces(expr),
     error = function(cond) {
+      # Don't print shiny.silent.error (i.e. validation errors)
+      if (inherits(cond, "shiny.silent.error"))
+        return()
       printError(cond, full = full, offset = offset)
     }
   )

R/reactives.R

@@ -347,6 +347,7 @@ Observable <- R6Class(
     .invalidated = logical(0),
     .running = logical(0),
     .value = NULL,
+    .error = FALSE,
     .visible = logical(0),
     .execCount = integer(0),
     .mostRecentCtxId = character(0),
@@ -380,8 +381,8 @@ Observable <- R6Class(
 
       .graphDependsOnId(getCurrentContext()$id, .mostRecentCtxId)
 
-      if (identical(class(.value), 'try-error')) {
-        stop(attr(.value, 'condition'))
+      if (.error) {
+        stop(.value)
       }
 
       if (.visible)
@@ -408,7 +409,10 @@ Observable <- R6Class(
       ctx$run(function() {
         result <- withCallingHandlers(
 
-          withVisible(.func()),
+          {
+            .error <<- FALSE
+            withVisible(.func())
+          },
 
           error = function(cond) {
             # If an error occurs, we want to propagate the error, but we also
@@ -426,7 +430,8 @@ Observable <- R6Class(
             #
             # We use try(stop()) as an easy way to generate a try-error object
             # out of this condition.
-            .value <<- try(stop(stripStackTrace(cond)), silent = TRUE)
+            .value <<- cond
+            .error <<- TRUE
             .visible <<- FALSE
           }
         )

R/utils.R

@@ -533,10 +533,16 @@ assignNestedList <- function(x = list(), idx, value) {
 # option (e.g. we can set options(shiny.error = recover))
 #' @include conditions.R
 shinyCallingHandlers <- function(expr) {
-  withCallingHandlers(captureStackTraces(expr), error = function(e) {
-    handle <- getOption('shiny.error')
-    if (is.function(handle)) handle()
-  })
+  withCallingHandlers(captureStackTraces(expr),
+    error = function(e) {
+      # Don't intercept shiny.silent.error (i.e. validation errors)
+      if (inherits(e, "shiny.silent.error"))
+        return()
+
+      handle <- getOption('shiny.error')
+      if (is.function(handle)) handle()
+    }
+  )
 }
 
 #' Print message for deprecated functions in Shiny

inst/tests/test-stacks.R

@@ -75,3 +75,53 @@ test_that("integration tests", {
     FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
     FALSE, FALSE, FALSE))
 })
+
+test_that("shiny.error", {
+  caught <- NULL
+  op <- options(shiny.error = function() { caught <<- TRUE })
+  on.exit(options(op))
+
+  # Regular errors should be intercepted by shiny.error
+  try(shiny:::shinyCallingHandlers(stop("boom")), silent = TRUE)
+  expect_true(caught)
+
+  caught <- NULL
+
+  # Validation errors shouldn't be intercepted by shiny.error
+
+  try(shiny:::shinyCallingHandlers(validate(need(NULL, FALSE))), silent = TRUE)
+  expect_null(caught)
+
+  er <- eventReactive(NULL, { "Hello" })
+  try(shiny:::shinyCallingHandlers(isolate(er())), silent = TRUE)
+  expect_null(caught)
+  try(shiny:::shinyCallingHandlers(isolate(er())), silent = TRUE)
+  expect_null(caught)
+})
+
+test_that("validation error logging", {
+  caught <- NULL
+
+  # Given an error-throwing exception expr, execute it
+  # using withLogErrors, and superassign the warning that
+  # results (the error log is emitted using warning())
+  # into the parent variable `caught`
+  captureErrorLog <- function(expr) {
+    tryCatch(
+      tryCatch(
+        shiny::withLogErrors(expr),
+        warning = function(cond) {
+          caught <<- cond
+        }
+      ),
+      error = function(e) {
+      }
+    )
+  }
+
+  captureErrorLog(validate("boom"))
+  expect_null(caught)
+
+  captureErrorLog(stop("boom"))
+  expect_true(!is.null(caught))
+})