Better error message for inifinite recursion situations

[jankowtf]

Somehow I can't figure out how to "early exit" the withRestarts(tryCatch(...), ...) construct in setReactiveS3() or setShinyReactive():

              obj$.value <<- withRestarts(
                tryCatch(
                  {
                    out <- value()

                    ## Object state updates //
                    obj$.condition <- NULL
                    obj$.has_cached <- TRUE
                    obj$.needs_update <- FALSE

                    out 

                  ## For debugging/testing purposes 
#                     stop("Intentional update fail"),
                  },
                  warning = function(cond) {
                    invokeRestart("muffleWarning")
                  },
                  error = function(cond) {
                    invokeRestart("ReactiveUpdateFailed", cond = cond)
                  }
                ),
                muffleWarning = function(cond) {
                  message(cond)
                  invokeRestart("muffleWarning")
                },
                ReactiveUpdateFailed = function(cond) {     
                  signal <- FALSE
                  if (!cache) { 
                    if (grepl("object.*not found", conditionMessage(cond))) {
                      msg <- paste0("caching disabled -->", conditionMessage(cond))
                    } else if (grepl("evaluation nested too deeply.*infinite recursion", conditionMessage(cond))) {                
                      message(conditionMessage(cond))
                      msg <- "caching disabled --> infinite recursion"
                      signal <- TRUE
                    }
                  } else {
                    msg <- conditionMessage(cond)
                  }
                  cond <- conditionr::signalCondition(
                    call = substitute(
                      get(x= ID, envir = WHERE, inherits = FALSE),
                      list(ID = obj$.id, WHERE = obj$.where)
                    ),
                    condition = "AbortedReactiveUpdateWithError",
                    msg = c(
                      "Update failed",
                      Reason = msg,
                      ID = obj$.id,
                      UID = obj$.uid,
                      Location = capture.output(where)
                    ),
                    ns = "reactr",
                    type = "error",
                    signal = signal
                  )

                  ## Transfer condition //
                  obj$.condition <<- cond
                  NULL
                }
              )

Improve this