diff --git a/R/utils.R b/R/utils.R index ffea72cf..92d6e261 100644 --- a/R/utils.R +++ b/R/utils.R @@ -743,9 +743,20 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { error = function(e) { if (is.null(attr(e, "stack.trace", exact = TRUE))) { calls <- sys.calls() + reverseStack <- rev(calls) attr(e, "stack.trace") <- calls - errorCall <- e$call[[1]] - + + if (!is.null(e$call[[1]])) + errorCall <- e$call[[1]] + else { + # attempt to capture the error or warning if thrown by + # simpleError or simpleWarning (which may arise for user-defined errors) + # + # the first matching call in the reversed stack will always be + # getStackTrace, so we select the second match instead + errorCall <- reverseStack[grepl(x=reverseStack, "simpleError|simpleWarning")][[2]] + } + functionsAsList <- lapply(calls, function(completeCall) { currentCall <- completeCall[[1]] @@ -760,8 +771,6 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { }) - reverseStack <- rev(calls) - if (prune_errors) { # this line should match the last occurrence of the function # which raised the error within the call stack; prune here @@ -779,14 +788,18 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { # to stop at the correct position. if (is.function(currentCall[[1]])) { identical(deparse(errorCall), deparse(currentCall[[1]])) - } else { + } else if (currentCall[[1]] == "stop") { + # handle case where function developer deliberately invokes a stop + # condition and halts function execution + identical(deparse(errorCall), deparse(currentCall)) + } + else { FALSE } } ) ) - # the position to stop at is one less than the difference # between the total number of calls and the index of the # call throwing the error @@ -797,12 +810,14 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { functionsAsList <- removeHandlers(functionsAsList) } + # use deparse in case the call throwing the error is a symbol, + # since this cannot be "printed" without deparsing the call warning(call. = FALSE, immediate. = TRUE, sprintf("Execution error in %s: %s", - functionsAsList[[length(functionsAsList)]], + deparse(functionsAsList[[length(functionsAsList)]]), conditionMessage(e))) stack_message <- stackTraceToHTML(functionsAsList, - functionsAsList[[length(functionsAsList)]], + deparse(functionsAsList[[length(functionsAsList)]]), conditionMessage(e)) assign("stack_message", value=stack_message, diff --git a/tests/integration/callbacks/test_handle_stop.py b/tests/integration/callbacks/test_handle_stop.py new file mode 100644 index 00000000..fce8831f --- /dev/null +++ b/tests/integration/callbacks/test_handle_stop.py @@ -0,0 +1,46 @@ +from selenium.webdriver.support.select import Select + +app = """ +library(dash) +library(dashHtmlComponents) +library(dashCoreComponents) + +app <- Dash$new() + +app$layout( + htmlDiv( + list( + dccDropdown(options = list( + list(label = "Red", value = "#FF0000"), + list(label = "Throw error", value = "error") + ), + id = "input-choice", + value = "error"), + htmlDiv(id="div-choice") + ) + ) +) + +app$callback(output(id = 'div-choice', property = 'children'), + list(input(id = 'input-choice', property = 'value')), + function(choice) { + if (choice == "error") { + stop(simpleError("Throwing an error by request")) + } + if (!is.null(unlist(choice))) { + return(sprintf("Choice was %s", choice)) + } else { + return(sprintf("Make a choice")) + } + }) + +app$run_server(debug=TRUE) +""" + + +def test_rshs001_handle_stop(dashr): + dashr.start_server(app) + dashr.wait_for_text_to_equal( + ".dash-fe-error__title", + "Callback error updating div-choice.children" + )