1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
|
#' Display last deprecation warnings
#'
#' @description
#'
#' Call these helpers to see the last deprecation warnings along with
#' their backtrace:
#'
#' * `last_warnings()` returns a list of all warnings that occurred
#' during the last top-level R command.
#'
#' * `last_warning()` returns only the last.
#'
#' If you call these in the console, these warnings are printed with a
#' backtrace. Pass the `simplify` argument to control the verbosity of
#' the backtrace. It supports one of `"branch"` (the default),
#' `"collapse"`, and `"none"` (in increasing order of verbosity).
#'
#' @examples
#' # These examples are not run because `last_warnings()` does not
#' # work well within knitr and pkgdown
#' \dontrun{
#'
#' f <- function() invisible(g())
#' g <- function() list(h(), i())
#' h <- function() deprecate_warn("1.0.0", "this()")
#' i <- function() deprecate_warn("1.0.0", "that()")
#' f()
#'
#' # Print all the warnings that occurred during the last command:
#' last_warnings()
#'
#' # Print only the last one:
#' last_warning()
#'
#'
#' # By default, the backtraces are printed in their simplified form.
#' # Use `simplify` to control the verbosity:
#' print(last_warnings(), simplify = "none")
#'
#' }
#' @export
last_warnings <- function() {
warnings_env$warnings
}
#' @rdname last_warnings
#' @export
last_warning <- function() {
n <- length(warnings_env$warnings)
if (n) {
warnings_env$warnings[[n]]
} else {
NULL
}
}
new_deprecated_warning <- function(msg, trace) {
warning_cnd(
"lifecycle_warning_deprecated",
message = msg,
trace = trace
)
}
#' @export
print.lifecycle_warning_deprecated <- function(x, ..., simplify = c("branch", "collapse", "none")) {
cat_line(bold("<deprecated>"))
message <- x$message
if (is_string(message) && nzchar(message)) {
cat_line(sprintf("message: %s", italic(message)))
}
trace <- x$trace
if (!is_null(trace)) {
cat_line("backtrace:")
cat_line(red(format(trace, ..., simplify = simplify)))
}
invisible(x)
}
warnings_env <- env(empty_env())
init_warnings <- function() {
warnings_env$last_top_frame <- NULL
warnings_env$warnings <- list()
}
init_warnings()
push_warning <- function(wrn) {
current <- sexp_address(sys.frame(1))
if (identical(warnings_env$last_top_frame, current)) {
warnings_env$warnings <- c(warnings_env$warnings, list(wrn))
} else {
warnings_env$last_top_frame <- current
warnings_env$warnings <- list(wrn)
}
}
# Contains unique IDs of deprecated features so we don't warn multiple times
deprecation_env <- env(empty_env())
|