diff --git a/NEWS.md b/NEWS.md index 7573a1288..5f7cdb91f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -28,6 +28,7 @@ + to discourage many consecutive calls to `suppressMessages()` or `suppressPackageStartupMessages()` (part of #884, @MichaelChirico). * `return_linter()` also has an argument `return_style` (`"implicit"` by default) which checks that all functions confirm to the specified return style of `"implicit"` or `"explicit"` (part of #884, @MichaelChirico, @AshesITR and @MEO265). * `unnecessary_lambda_linter` is extended to encourage vectorized comparisons where possible, e.g. `sapply(x, sum) > 0` instead of `sapply(x, function(x) sum(x) > 0)` (part of #884, @MichaelChirico). Toggle this behavior with argument `allow_comparison`. +* `backport_linter()` is slightly faster by moving expensive computations outside the linting function (#2339, #2348, @AshesITR and @MichaelChirico). * `Linter()` has a new argument `linter_level` (default `NA`). This is used by `lint()` to more efficiently check for expression levels than the idiom `if (!is_lint_level(...)) { return(list()) }` (#2351, @AshesITR). ### New linters diff --git a/R/backport_linter.R b/R/backport_linter.R index d407d0fdb..cef27881d 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -42,6 +42,8 @@ backport_linter <- function(r_version = getRversion(), except = character()) { backport_blacklist <- backports[r_version < R_system_version(names(backports))] backport_blacklist <- lapply(backport_blacklist, setdiff, except) + backport_index <- rep(names(backport_blacklist), times = lengths(backport_blacklist)) + names(backport_index) <- unlist(backport_blacklist) names_xpath <- "//SYMBOL | //SYMBOL_FUNCTION_CALL" @@ -52,26 +54,20 @@ backport_linter <- function(r_version = getRversion(), except = character()) { all_names_nodes <- xml_find_all(xml, names_xpath) all_names <- xml_text(all_names_nodes) - # not sapply/vapply, which may over-simplify to vector - # rbind makes sure we have a matrix with dimensions [n_versions x n_names] - # so that colSums() works to tell us which names are in an unavailable version - # rbind not cbind because R is column-major --> which() below will be in column order - needs_backport <- do.call(rbind, lapply(backport_blacklist, function(nm) all_names %in% nm)) - bad_idx <- colSums(needs_backport) > 0L + bad_versions <- unname(backport_index[all_names]) + needs_backport <- !is.na(bad_versions) - # which(arr.ind) returns things in the same order as which() - needs_backport_version_idx <- ((which(needs_backport) - 1L) %% length(backport_blacklist)) + 1L lint_message <- sprintf( paste( "%s (R %s) is not available for dependency R >= %s.", "Use the `except` argument of `backport_linter()` to configure available backports." ), - all_names[bad_idx], - names(backport_blacklist)[needs_backport_version_idx], + all_names[needs_backport], + bad_versions[needs_backport], r_version ) xml_nodes_to_lints( - all_names_nodes[bad_idx], + all_names_nodes[needs_backport], source_expression = source_expression, lint_message = lint_message, type = "warning"