Skip to content

Commit

Permalink
Remove extractStackTrace and formatStackTrace
Browse files Browse the repository at this point in the history
  • Loading branch information
@wch
wch committed Nov 10, 2020
1 parent cb9d953 commit a1e79e8
Show file tree
Hide file tree
Showing 3 changed files with 23 additions and 163 deletions.
2 changes: 0 additions & 2 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,7 +101,6 @@ export(enableBookmarking)
export(eventReactive)
export(exportTestValues)
export(exprToFunction)
export(extractStackTrace)
export(fileInput)
export(fillCol)
export(fillPage)
Expand All @@ -112,7 +111,6 @@ export(fixedRow)
export(flowLayout)
export(fluidPage)
export(fluidRow)
export(formatStackTrace)
export(freezeReactiveVal)
export(freezeReactiveValue)
export(getCurrentOutputInfo)
Expand Down
156 changes: 23 additions & 133 deletions R/conditions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,7 @@ captureStackTraces <- function(expr) {
createStackTracePromiseDomain <- function() {
# These are actually stateless, we wouldn't have to create a new one each time
# if we didn't want to. They're pretty cheap though.

d <- promises::new_promise_domain(
wrapOnFulfilled = function(onFulfilled) {
force(onFulfilled)
Expand Down Expand Up @@ -266,10 +266,10 @@ withLogErrors <- function(expr,
printError <- function(cond,
full = getOption("shiny.fullstacktrace", FALSE),
offset = getOption("shiny.stacktraceoffset", TRUE)) {
warning(call. = FALSE, immediate. = TRUE, sprintf("Error in %s: %s",

warning(call. = FALSE, immediate. = TRUE, sprintf("Error in %s: %s",
getCallNames(list(conditionCall(cond))), conditionMessage(cond)))

printStackTrace(cond, full = full, offset = offset)
}

Expand All @@ -282,16 +282,16 @@ printStackTrace <- function(cond,
should_drop <- !full
should_strip <- !full
should_prune <- !full

stackTraceCalls <- c(
attr(cond, "deep.stack.trace", exact = TRUE),
list(attr(cond, "stack.trace", exact = TRUE))
)

stackTraceParents <- lapply(stackTraceCalls, attr, which = "parents", exact = TRUE)
stackTraceCallNames <- lapply(stackTraceCalls, getCallNames)
stackTraceCalls <- lapply(stackTraceCalls, offsetSrcrefs, offset = offset)

# Use dropTrivialFrames logic to remove trailing bits (.handleSimpleError, h)
if (should_drop) {
# toKeep is a list of logical vectors, of which elements (stack frames) to keep
Expand All @@ -301,7 +301,7 @@ printStackTrace <- function(cond,
stackTraceCallNames <- mapply(stackTraceCallNames, FUN = `[`, toKeep, SIMPLIFY = FALSE)
stackTraceParents <- mapply(stackTraceParents, FUN = `[`, toKeep, SIMPLIFY = FALSE)
}

delayedAssign("all_true", {
# List of logical vectors that are all TRUE, the same shape as
# stackTraceCallNames. Delay the evaluation so we don't create it unless
Expand All @@ -310,7 +310,7 @@ printStackTrace <- function(cond,
rep_len(TRUE, length(st))
})
})

# stripStackTraces and lapply(stackTraceParents, pruneStackTrace) return lists
# of logical vectors. Use mapply(FUN = `&`) to boolean-and each pair of the
# logical vectors.
Expand All @@ -320,7 +320,7 @@ printStackTrace <- function(cond,
FUN = `&`,
SIMPLIFY = FALSE
)

dfs <- mapply(seq_along(stackTraceCalls), rev(stackTraceCalls), rev(stackTraceCallNames), rev(toShow), FUN = function(i, calls, nms, index) {
st <- data.frame(
num = rev(which(index)),
Expand All @@ -329,7 +329,7 @@ printStackTrace <- function(cond,
category = rev(getCallCategories(calls[index])),
stringsAsFactors = FALSE
)

if (i != 1) {
message("From earlier call:")
}
Expand Down Expand Up @@ -357,83 +357,8 @@ printStackTrace <- function(cond,

st
}, SIMPLIFY = FALSE)

invisible()
}

#' @details `extractStackTrace` takes a list of calls (e.g. as returned
#' from `conditionStackTrace(cond)`) and returns a data frame with one
#' row for each stack frame and the columns `num` (stack frame number),
#' `call` (a function name or similar), and `loc` (source file path
#' and line number, if available). It was deprecated after shiny 1.0.5 because
#' it doesn't support deep stack traces.
#' @rdname stacktrace
#' @export
extractStackTrace <- function(calls,
full = getOption("shiny.fullstacktrace", FALSE),
offset = getOption("shiny.stacktraceoffset", TRUE)) {

shinyDeprecated(NULL,
"extractStackTrace is deprecated. Please contact the Shiny team if you were using this functionality.",
version = "1.0.5")

srcrefs <- getSrcRefs(calls)
if (offset) {
# Offset calls vs. srcrefs by 1 to make them more intuitive.
# E.g. for "foo [bar.R:10]", line 10 of bar.R will be part of
# the definition of foo().
srcrefs <- c(utils::tail(srcrefs, -1), list(NULL))
}
calls <- setSrcRefs(calls, srcrefs)

callnames <- getCallNames(calls)

# Hide and show parts of the callstack based on ..stacktrace(on|off)..
if (full) {
toShow <- rep.int(TRUE, length(calls))
} else {
# Remove stop(), .handleSimpleError(), and h() calls from the end of
# the calls--they don't add any helpful information. But only remove
# the last *contiguous* block of them, and then, only if they are the
# last thing in the calls list.
hideable <- callnames %in% c("stop", ".handleSimpleError", "h")
# What's the last that *didn't* match stop/.handleSimpleError/h?
lastGoodCall <- max(which(!hideable))
toRemove <- length(calls) - lastGoodCall
# But don't remove more than 5 levels--that's an indication we might
# have gotten it wrong, I guess
if (toRemove > 0 && toRemove < 5) {
calls <- utils::head(calls, -toRemove)
callnames <- utils::head(callnames, -toRemove)
}

# This uses a ref-counting scheme. It might make sense to switch this
# to a toggling scheme, so the most recent ..stacktrace(on|off)..
# directive wins, regardless of what came before it.
# Also explicitly remove ..stacktraceon.. because it can appear with
# score > 0 but still should never be shown.
score <- rep.int(0, length(callnames))
score[callnames == "..stacktraceoff.."] <- -1
score[callnames == "..stacktraceon.."] <- 1
toShow <- (1 + cumsum(score)) > 0 & !(callnames %in% c("..stacktraceon..", "..stacktraceoff..", "..stacktracefloor.."))

# doTryCatch, tryCatchOne, and tryCatchList are not informative--they're
# just internals for tryCatch
toShow <- toShow & !(callnames %in% c("doTryCatch", "tryCatchOne", "tryCatchList"))
}
calls <- calls[toShow]

calls <- rev(calls) # Show in traceback() order
index <- rev(which(toShow))
width <- floor(log10(max(index))) + 1

data.frame(
num = index,
call = getCallNames(calls),
loc = getLocs(calls),
category = getCallCategories(calls),
stringsAsFactors = FALSE
)
invisible()
}

stripStackTraces <- function(stackTraces, values = FALSE) {
Expand All @@ -459,19 +384,19 @@ stripOneStackTrace <- function(stackTrace, truncateFloor, startingScore) {
prefix <- rep_len(FALSE, indexOfFloor)
}
}

if (length(stackTrace) == 0) {
return(list(score = startingScore, character(0)))
}

score <- rep.int(0L, length(stackTrace))
score[stackTrace == "..stacktraceon.."] <- 1L
score[stackTrace == "..stacktraceoff.."] <- -1L
score <- startingScore + cumsum(score)

toShow <- score > 0 & !(stackTrace %in% c("..stacktraceon..", "..stacktraceoff..", "..stacktracefloor.."))


list(score = utils::tail(score, 1), trace = c(prefix, toShow))
}

Expand All @@ -486,11 +411,11 @@ pruneStackTrace <- function(parents) {
# sufficient; we also need to drop nodes that are the last child, but one of
# their ancestors is not.
is_dupe <- duplicated(parents, fromLast = TRUE)

# The index of the most recently seen node that was actually kept instead of
# dropped.
current_node <- 0

# Loop over the parent indices. Anything that is not parented by current_node
# (a.k.a. last-known-good node), or is a dupe, can be discarded. Anything that
# is kept becomes the new current_node.
Expand All @@ -502,7 +427,7 @@ pruneStackTrace <- function(parents) {
FALSE
}
}, FUN.VALUE = logical(1))

include
}

Expand All @@ -515,7 +440,7 @@ dropTrivialFrames <- function(callnames) {
# What's the last that *didn't* match stop/.handleSimpleError/h?
lastGoodCall <- max(which(!hideable))
toRemove <- length(callnames) - lastGoodCall

c(
rep_len(TRUE, length(callnames) - toRemove),
rep_len(FALSE, toRemove)
Expand All @@ -530,46 +455,11 @@ offsetSrcrefs <- function(calls, offset = TRUE) {
# E.g. for "foo [bar.R:10]", line 10 of bar.R will be part of
# the definition of foo().
srcrefs <- c(utils::tail(srcrefs, -1), list(NULL))

calls <- setSrcRefs(calls, srcrefs)
}

calls
}

#' @details `formatStackTrace` is similar to `extractStackTrace`, but
#' it returns a preformatted character vector instead of a data frame. It was
#' deprecated after shiny 1.0.5 because it doesn't support deep stack traces.
#' @param indent A string to prefix every line of the stack trace.
#' @rdname stacktrace
#' @export
formatStackTrace <- function(calls, indent = " ",
full = getOption("shiny.fullstacktrace", FALSE),
offset = getOption("shiny.stacktraceoffset", TRUE)) {

shinyDeprecated(NULL,
"extractStackTrace is deprecated. Please contact the Shiny team if you were using this functionality.",
version = "1.0.5")

st <- extractStackTrace(calls, full = full, offset = offset)
if (nrow(st) == 0) {
return(character(0))
calls <- setSrcRefs(calls, srcrefs)
}

width <- floor(log10(max(st$num))) + 1
paste0(
indent,
formatC(st$num, width = width),
": ",
mapply(paste0(st$call, st$loc), st$category, FUN = function(name, category) {
if (category == "pkg")
crayon::silver(name)
else if (category == "user")
crayon::blue$bold(name)
else
crayon::white(name)
})
)
calls
}

getSrcRefs <- function(calls) {
Expand Down
28 changes: 0 additions & 28 deletions man/stacktrace.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit a1e79e8

Please sign in to comment.