From 79702600aa82f7ebad1bfac9d0ff7c4e38c5c227 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 18 Nov 2023 12:09:01 -0800 Subject: [PATCH] New list_comparison_linter (#2293) --- DESCRIPTION | 1 + NAMESPACE | 1 + NEWS.md | 1 + R/list_comparison_linter.R | 70 ++++++++++++++++++++ inst/lintr/linters.csv | 1 + man/best_practices_linters.Rd | 1 + man/common_mistakes_linters.Rd | 1 + man/efficiency_linters.Rd | 1 + man/linters.Rd | 7 +- man/list_comparison_linter.Rd | 33 +++++++++ tests/testthat/test-list_comparison_linter.R | 34 ++++++++++ 11 files changed, 148 insertions(+), 3 deletions(-) create mode 100644 R/list_comparison_linter.R create mode 100644 man/list_comparison_linter.Rd create mode 100644 tests/testthat/test-list_comparison_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 7e0f6250d..183ce9867 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -128,6 +128,7 @@ Collate: 'linter_tags.R' 'lintr-deprecated.R' 'lintr-package.R' + 'list_comparison_linter.R' 'literal_coercion_linter.R' 'make_linter_from_regex.R' 'matrix_apply_linter.R' diff --git a/NAMESPACE b/NAMESPACE index 8be33824d..a240beb6a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -90,6 +90,7 @@ export(lint_dir) export(lint_package) export(linters_with_defaults) export(linters_with_tags) +export(list_comparison_linter) export(literal_coercion_linter) export(make_linter_from_xpath) export(matrix_apply_linter) diff --git a/NEWS.md b/NEWS.md index 9fe5f6b71..e5ca597dd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -26,6 +26,7 @@ * `stopifnot_all_linter()` discourages tests with `all()` like `stopifnot(all(x > 0))`; `stopifnot()` runs `all()` itself, and uses a better error message (part of #884, @MichaelChirico). * `comparison_negation_linter()` for discouraging negated comparisons when a direct negation is preferable, e.g. `!(x == y)` could be `x != y` (part of #884, @MichaelChirico). * `terminal_close_linter()` for discouraging using `close()` to end functions (part of #884, @MichaelChirico). Such usages are not robust to errors, where `close()` will not be run as intended. Put `close()` in an `on.exit()` hook, or use {withr} to manage connections with proper cleanup. +* `list_comparison_linter()` for discouraging comparisons on the output of `lapply()`, e.g. `lapply(x, sum) > 10` (part of #884, @MichaelChirico). * `print_linter()` for discouraging usage of `print()` on string literals like `print("Reached here")` or `print(paste("Found", nrow(DF), "rows."))` (#1894, @MichaelChirico). ### Lint accuracy fixes: removing false positives diff --git a/R/list_comparison_linter.R b/R/list_comparison_linter.R new file mode 100644 index 000000000..60d5c03eb --- /dev/null +++ b/R/list_comparison_linter.R @@ -0,0 +1,70 @@ +#' Block usage of comparison operators with known-list() functions like lapply +#' +#' Usage like `lapply(x, sum) > 10` is awkward because the list must first +#' be coerced to a vector for comparison. A function like [vapply()] +#' should be preferred. +#' +#' @examples +#' # will produce lints +#' lint( +#' text = "lapply(x, sum) > 10", +#' linters = list_comparison_linter() +#' ) +#' +#' # okay +#' lint( +#' text = "unlist(lapply(x, sum)) > 10", +#' linters = list_comparison_linter() +#' ) +#' +#' @evalRd rd_tags("list_comparison_linter") +#' @seealso [linters] for a complete list of linters available in lintr. +#' @export +list_comparison_linter <- function() { + # TODO(michaelchirico): extend to cases where using simplify=FALSE implies a + # list output, e.g. with sapply, replicate, mapply. + list_mapper_alternatives <- c( + lapply = "vapply(x, FUN, character(1L))", + map = "map_chr(x, FUN)", + Map = "mapply()", + .mapply = "mapply()" + ) + + # NB: anchor to the comparison expr so that we can easily include the comparator + # in the lint message. + xpath <- glue(" + //SYMBOL_FUNCTION_CALL[{ xp_text_in_table(names(list_mapper_alternatives)) }] + /parent::expr + /parent::expr + /parent::expr[{ xp_or(infix_metadata$xml_tag[infix_metadata$comparator]) }] + ") + + Linter(function(source_expression) { + if (!is_lint_level(source_expression, "expression")) { + return(list()) + } + + xml <- source_expression$xml_parsed_content + + bad_expr <- xml_find_all(xml, xpath) + + list_mapper <- xp_call_name(bad_expr, depth = 2L) + + vector_mapper <- list_mapper_alternatives[list_mapper] + # we are at `x ? y` in which the comparator ? comes 2nd + comparator <- xml_find_chr(bad_expr, "string(*[2])") + + lint_message <- as.character(glue( + "The output of {list_mapper}(), a list(), is being ", + "coerced for comparison by `{comparator}`. ", + "Instead, use a mapper that generates a vector with the correct type ", + "directly, for example {vector_mapper} if the output is a string." + )) + xml_nodes_to_lints( + bad_expr, + source_expression = source_expression, + lint_message = lint_message, + type = "warning" + ) + }) +} diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 0308fa3f9..b1416540c 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -49,6 +49,7 @@ length_test_linter,common_mistakes efficiency lengths_linter,efficiency readability best_practices library_call_linter,style best_practices readability configurable line_length_linter,style readability default configurable +list_comparison_linter,best_practices common_mistakes efficiency literal_coercion_linter,best_practices consistency efficiency matrix_apply_linter,readability efficiency missing_argument_linter,correctness common_mistakes configurable diff --git a/man/best_practices_linters.Rd b/man/best_practices_linters.Rd index 4e8cc2ead..c57c9b6f3 100644 --- a/man/best_practices_linters.Rd +++ b/man/best_practices_linters.Rd @@ -43,6 +43,7 @@ The following linters are tagged with 'best_practices': \item{\code{\link{length_levels_linter}}} \item{\code{\link{lengths_linter}}} \item{\code{\link{library_call_linter}}} +\item{\code{\link{list_comparison_linter}}} \item{\code{\link{literal_coercion_linter}}} \item{\code{\link{nonportable_path_linter}}} \item{\code{\link{outer_negation_linter}}} diff --git a/man/common_mistakes_linters.Rd b/man/common_mistakes_linters.Rd index 73767f1f5..b21480c12 100644 --- a/man/common_mistakes_linters.Rd +++ b/man/common_mistakes_linters.Rd @@ -15,6 +15,7 @@ The following linters are tagged with 'common_mistakes': \item{\code{\link{duplicate_argument_linter}}} \item{\code{\link{equals_na_linter}}} \item{\code{\link{length_test_linter}}} +\item{\code{\link{list_comparison_linter}}} \item{\code{\link{missing_argument_linter}}} \item{\code{\link{missing_package_linter}}} \item{\code{\link{redundant_equals_linter}}} diff --git a/man/efficiency_linters.Rd b/man/efficiency_linters.Rd index 146c0be54..334c4573f 100644 --- a/man/efficiency_linters.Rd +++ b/man/efficiency_linters.Rd @@ -20,6 +20,7 @@ The following linters are tagged with 'efficiency': \item{\code{\link{inner_combine_linter}}} \item{\code{\link{length_test_linter}}} \item{\code{\link{lengths_linter}}} +\item{\code{\link{list_comparison_linter}}} \item{\code{\link{literal_coercion_linter}}} \item{\code{\link{matrix_apply_linter}}} \item{\code{\link{nested_ifelse_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index 1c64865bc..ac13ed35f 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -17,14 +17,14 @@ see also \code{\link[=available_tags]{available_tags()}}. \section{Tags}{ The following tags exist: \itemize{ -\item{\link[=best_practices_linters]{best_practices} (56 linters)} -\item{\link[=common_mistakes_linters]{common_mistakes} (8 linters)} +\item{\link[=best_practices_linters]{best_practices} (57 linters)} +\item{\link[=common_mistakes_linters]{common_mistakes} (9 linters)} \item{\link[=configurable_linters]{configurable} (34 linters)} \item{\link[=consistency_linters]{consistency} (24 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} \item{\link[=deprecated_linters]{deprecated} (4 linters)} -\item{\link[=efficiency_linters]{efficiency} (26 linters)} +\item{\link[=efficiency_linters]{efficiency} (27 linters)} \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=pkg_testthat_linters]{pkg_testthat} (12 linters)} @@ -84,6 +84,7 @@ The following linters exist: \item{\code{\link{lengths_linter}} (tags: best_practices, efficiency, readability)} \item{\code{\link{library_call_linter}} (tags: best_practices, configurable, readability, style)} \item{\code{\link{line_length_linter}} (tags: configurable, default, readability, style)} +\item{\code{\link{list_comparison_linter}} (tags: best_practices, common_mistakes, efficiency)} \item{\code{\link{literal_coercion_linter}} (tags: best_practices, consistency, efficiency)} \item{\code{\link{matrix_apply_linter}} (tags: efficiency, readability)} \item{\code{\link{missing_argument_linter}} (tags: common_mistakes, configurable, correctness)} diff --git a/man/list_comparison_linter.Rd b/man/list_comparison_linter.Rd new file mode 100644 index 000000000..9a939a686 --- /dev/null +++ b/man/list_comparison_linter.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_comparison_linter.R +\name{list_comparison_linter} +\alias{list_comparison_linter} +\title{Block usage of comparison operators with known-list() functions like lapply} +\usage{ +list_comparison_linter() +} +\description{ +Usage like \code{lapply(x, sum) > 10} is awkward because the list must first +be coerced to a vector for comparison. A function like \code{\link[=vapply]{vapply()}} +should be preferred. +} +\examples{ +# will produce lints +lint( + text = "lapply(x, sum) > 10", + linters = list_comparison_linter() +) + +# okay +lint( + text = "unlist(lapply(x, sum)) > 10", + linters = list_comparison_linter() +) + +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. +} +\section{Tags}{ +\link[=best_practices_linters]{best_practices}, \link[=common_mistakes_linters]{common_mistakes}, \link[=efficiency_linters]{efficiency} +} diff --git a/tests/testthat/test-list_comparison_linter.R b/tests/testthat/test-list_comparison_linter.R new file mode 100644 index 000000000..6177caed1 --- /dev/null +++ b/tests/testthat/test-list_comparison_linter.R @@ -0,0 +1,34 @@ +test_that("list_comparison_linter skips allowed usages", { + expect_lint("sapply(x, sum) > 10", NULL, list_comparison_linter()) +}) + +local({ + linter <- list_comparison_linter() + lint_msg <- rex::rex("a list(), is being coerced for comparison") + + cases <- expand.grid( + list_mapper = c("lapply", "map", "Map", ".mapply"), + comparator = c("==", "!=", ">=", "<=", ">", "<") + ) + cases$.test_name <- with(cases, paste(list_mapper, comparator)) + patrick::with_parameters_test_that( + "list_comparison_linter blocks simple disallowed usages", + expect_lint(sprintf("%s(x, sum) %s 10", list_mapper, comparator), lint_msg, linter), + .cases = cases + ) +}) + +test_that("list_comparison_linter vectorizes", { + expect_lint( + trim_some("{ + sapply(x, sum) > 10 + .mapply(`+`, list(1:10, 1:10), NULL) == 2 + lapply(x, sum) < 5 + }"), + list( + list(rex::rex(".mapply()", anything, "`==`"), line_number = 3L), + list(rex::rex("lapply()", anything, "`<`"), line_number = 4L) + ), + list_comparison_linter() + ) +})