From 625b2ce9f93520ec86ce5c789e918e3af9e224ae Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 24 Mar 2022 22:08:53 +0000 Subject: [PATCH 1/5] New literal_coercion_linter --- DESCRIPTION | 1 + NAMESPACE | 1 + NEWS.md | 1 + R/literal_coercion_linter.R | 54 +++++++++++++++++++ inst/lintr/linters.csv | 1 + man/best_practices_linters.Rd | 1 + man/efficiency_linters.Rd | 1 + man/linters.Rd | 9 ++-- man/literal_coercion_linter.Rd | 18 +++++++ tests/testthat/test-literal_coercion_linter.R | 49 +++++++++++++++++ 10 files changed, 132 insertions(+), 4 deletions(-) create mode 100644 R/literal_coercion_linter.R create mode 100644 man/literal_coercion_linter.Rd create mode 100644 tests/testthat/test-literal_coercion_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 69799148c..063551fa7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -86,6 +86,7 @@ Collate: 'lint.R' 'linter_tag_docs.R' 'linter_tags.R' + 'literal_coercion_linter.R' 'make_linter_from_regex.R' 'methods.R' 'missing_argument_linter.R' diff --git a/NAMESPACE b/NAMESPACE index 0e1173ee1..a554cb93d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -53,6 +53,7 @@ export(line_length_linter) export(lint) export(lint_dir) export(lint_package) +export(literal_coercion_linter) export(missing_argument_linter) export(missing_package_linter) export(namespace_linter) diff --git a/NEWS.md b/NEWS.md index 644018b1b..3dbc0b002 100644 --- a/NEWS.md +++ b/NEWS.md @@ -102,6 +102,7 @@ function calls. (#850, #851, @renkun-ken) * `any_is_na_linter()` Require usage of `anyNA(x)` over `any(is.na(x))` * `outer_negation_linter()` Require usage of `!any(x)` over `all(!x)` and `!all(x)` over `any(!x)` * `numeric_leading_zero_linter()` Require a leading `0` in fractional numeric constants, e.g. `0.1` instead of `.1` + * `literal_coercion_linter()` Require using correctly-typed literals instead of direct coercion, e.g. `1L` instead of `as.numeric(1)` * `assignment_linter()` now lints right assignment (`->` and `->>`) and gains two arguments. `allow_cascading_assign` (`TRUE` by default) toggles whether to lint `<<-` and `->>`; `allow_right_assign` toggles whether to lint `->` and `->>` (#915, @michaelchirico) * `infix_spaces_linter()` gains argument `exclude_operators` to disable lints on selected infix operators. By default, all "low-precedence" operators throw lints; see `?infix_spaces_linter` for an enumeration of these. (#914 @michaelchirico) * `infix_spaces_linter()` now throws a lint on `a~b` and `function(a=1) {}` (#930, @michaelchirico) diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R new file mode 100644 index 000000000..d8b65cdfa --- /dev/null +++ b/R/literal_coercion_linter.R @@ -0,0 +1,54 @@ +#' Require usage of correctly-typed literals over literal coercions +#' +#' `as.integer(1)` is the same as `1L` but the latter is more concise and +#' gets typed correctly at compilation. +#' +#' The same applies to missing sentinels like `NA` -- typically, it is not +#' necessary to specify the storage type of `NA`, but when it is, prefer +#' using the typed version (e.g. `NA_real_`) instead of a coercion +#' (like `as.numeric(NA)`). +#' +#' @evalRd rd_tags("literal_coercion_linter") +#' @seealso [linters] for a complete list of linters available in lintr. +#' @export +literal_coercion_linter <- function() { + Linter(function(source_file) { + if (length(source_file$parsed_content) == 0L) { + return(list()) + } + + xml <- source_file$xml_parsed_content + + coercers <- xp_text_in_table(paste0( + "as.", + c("logical", "integer", "numeric", "double", "character") + )) + # notes for clarification: + # - as.integer(1e6) is arguably easier to read than 1000000L + # - in x$"abc", the "abc" STR_CONST is at the top level, so exclude OP-DOLLAR + # - need condition against STR_CONST w/ EQ_SUB to skip quoted keyword arguments (see tests) + xpath <- glue::glue("//expr[ + expr[SYMBOL_FUNCTION_CALL[ {coercers} ]] + and expr[2][ + not(OP-DOLLAR) + and ( + NUM_CONST[not(contains(translate(text(), 'E', 'e'), 'e'))] + or STR_CONST[not(following-sibling::*[1][self::EQ_SUB])] + ) + ] + ]") + + bad_expr <- xml2::xml_find_all(xml, xpath) + + return(lapply( + bad_expr, + xml_nodes_to_lint, + source_file = source_file, + lint_message = paste( + "Use literals directly where possible, instead of coercion.", + "c.f. 1L instead of as.integer(1), or NA_real_ instead of as.numeric(NA)." + ), + type = "warning" + )) + }) +} diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 26b4604f2..440c981e8 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -26,6 +26,7 @@ if_else_match_braces_linter,default style readability implicit_integer_linter,style consistency best_practices infix_spaces_linter,style readability default line_length_linter,style readability default configurable +literal_coercion_linter,best_practices efficiency missing_argument_linter,correctness common_mistakes configurable missing_package_linter,robustness common_mistakes namespace_linter,correctness robustness configurable diff --git a/man/best_practices_linters.Rd b/man/best_practices_linters.Rd index 367878163..5d4197c73 100644 --- a/man/best_practices_linters.Rd +++ b/man/best_practices_linters.Rd @@ -28,6 +28,7 @@ The following linters are tagged with 'best_practices': \item{\code{\link{expect_type_linter}}} \item{\code{\link{extraction_operator_linter}}} \item{\code{\link{implicit_integer_linter}}} +\item{\code{\link{literal_coercion_linter}}} \item{\code{\link{nonportable_path_linter}}} \item{\code{\link{outer_negation_linter}}} \item{\code{\link{seq_linter}}} diff --git a/man/efficiency_linters.Rd b/man/efficiency_linters.Rd index f4d2500a1..ac41b3a1f 100644 --- a/man/efficiency_linters.Rd +++ b/man/efficiency_linters.Rd @@ -13,6 +13,7 @@ Linters highlighting code efficiency problems, such as unneccessary function cal The following linters are tagged with 'efficiency': \itemize{ \item{\code{\link{any_is_na_linter}}} +\item{\code{\link{literal_coercion_linter}}} \item{\code{\link{outer_negation_linter}}} \item{\code{\link{seq_linter}}} \item{\code{\link{undesirable_function_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index 0aacab1df..e34668676 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -17,17 +17,17 @@ Documentation for linters is structured into tags to allow for easier discovery. \section{Tags}{ The following tags exist: \itemize{ -\item{\link[=best_practices_linters]{best_practices} (23 linters)} +\item{\link[=best_practices_linters]{best_practices} (24 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (5 linters)} \item{\link[=configurable_linters]{configurable} (16 linters)} \item{\link[=consistency_linters]{consistency} (8 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (27 linters)} -\item{\link[=efficiency_linters]{efficiency} (7 linters)} +\item{\link[=efficiency_linters]{efficiency} (8 linters)} \item{\link[=package_development_linters]{package_development} (13 linters)} -\item{\link[=readability_linters]{readability} (27 linters)} +\item{\link[=readability_linters]{readability} (28 linters)} \item{\link[=robustness_linters]{robustness} (10 linters)} -\item{\link[=style_linters]{style} (32 linters)} +\item{\link[=style_linters]{style} (33 linters)} } } \section{Linters}{ @@ -60,6 +60,7 @@ The following linters exist: \item{\code{\link{implicit_integer_linter}} (tags: best_practices, consistency, style)} \item{\code{\link{infix_spaces_linter}} (tags: default, readability, style)} \item{\code{\link{line_length_linter}} (tags: configurable, default, readability, style)} +\item{\code{\link{literal_coercion_linter}} (tags: best_practices, efficiency)} \item{\code{\link{missing_argument_linter}} (tags: common_mistakes, configurable, correctness)} \item{\code{\link{missing_package_linter}} (tags: common_mistakes, robustness)} \item{\code{\link{namespace_linter}} (tags: configurable, correctness, robustness)} diff --git a/man/literal_coercion_linter.Rd b/man/literal_coercion_linter.Rd new file mode 100644 index 000000000..f19e1e2e3 --- /dev/null +++ b/man/literal_coercion_linter.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/literal_coercion_linter.R +\name{literal_coercion_linter} +\alias{literal_coercion_linter} +\title{Require usage of correctly-typed literals over literal coercions} +\usage{ +literal_coercion_linter() +} +\description{ +\code{as.integer(1)} is the same as \code{1L} but the latter is more concise and +gets typed correctly at compilation. +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. +} +\section{Tags}{ +\link[=best_practices_linters]{best_practices}, \link[=efficiency_linters]{efficiency} +} diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R new file mode 100644 index 000000000..b01a1045a --- /dev/null +++ b/tests/testthat/test-literal_coercion_linter.R @@ -0,0 +1,49 @@ +test_that("literal_coercion_linter skips allowed usages", { + # naive xpath includes the "_f0" here as a literal + expect_lint('as.numeric(x$"_f0")', NULL, literal_coercion_linter()) + # only examine the first method for as. methods + expect_lint("as.character(as.Date(x), '%Y%m%d')", NULL, literal_coercion_linter()) + + # we are as yet agnostic on whether to prefer literals over coerced vectors + expect_lint("as.integer(c(1, 2, 3))", NULL, literal_coercion_linter()) + # even more ambiguous for character vectors like here, where quotes are much + # more awkward to type than a sequence of numbers + expect_lint("as.character(c(1, 2, 3))", NULL, literal_coercion_linter()) + # not possible to declare raw literals + expect_lint("as.raw(c(1, 2, 3))", NULL, literal_coercion_linter()) + # also not taking a stand on as.complex(0) vs. 0 + 0i + expect_lint("as.complex(0)", NULL, literal_coercion_linter()) + # ditto for as.integer(1e6) vs. 1000000L + expect_lint("as.integer(1e6)", NULL, literal_coercion_linter()) + # ditto for as.numeric(1:3) vs. c(1, 2, 3) + expect_lint("as.numeric(1:3)", NULL, literal_coercion_linter()) +}) + +skip_if_not_installed("patrick") +patrick::with_parameters_test_that( + "literal_coercion_linter blocks simple disallowed usages", + expect_lint( + sprintf("as.%s(%s)", out_type, input), + rex::rex("Use literals directly where possible, instead of coercion."), + literal_coercion_linter() + ), + .cases = tibble::tribble( + ~.test_name, ~out_type, ~input, + "lgl, from int", "logical", "1L", + "lgl, from num", "logical", "1", + "lgl, from chr", "logical", '"true"', + "int, from num", "integer", "1", + "num, from num", "numeric", "1", + "dbl, from num", "double", "1", + "chr, from num", "character", "1", + # affirmatively lint as.(NA) should be NA__ + "int, from NA", "integer", "NA", + "num, from NA", "numeric", "NA", + "dbl, from NA", "double", "NA", + "chr, from NA", "character", "NA", + ) +) + +test_that("literal_coercion_linter skips quoted keyword arguments", { + expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter()) +}) From 805470b432e805d798f03279455c36f1d50cda49 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 24 Mar 2022 22:40:21 +0000 Subject: [PATCH 2/5] add tibble to Suggests --- DESCRIPTION | 1 + tests/testthat/test-literal_coercion_linter.R | 1 + 2 files changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 063551fa7..289f69ca0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,6 +26,7 @@ Imports: jsonlite, knitr, stats, + tibble, utils, xml2 (>= 1.0.0), xmlparsedata (>= 1.0.3) diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R index b01a1045a..e01d9689f 100644 --- a/tests/testthat/test-literal_coercion_linter.R +++ b/tests/testthat/test-literal_coercion_linter.R @@ -19,6 +19,7 @@ test_that("literal_coercion_linter skips allowed usages", { expect_lint("as.numeric(1:3)", NULL, literal_coercion_linter()) }) +skip_if_not_installed("tibble") skip_if_not_installed("patrick") patrick::with_parameters_test_that( "literal_coercion_linter blocks simple disallowed usages", From 7d579611f54c02d60353ed83032cc4c6a53fc6e1 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 25 Mar 2022 00:10:34 -0700 Subject: [PATCH 3/5] tibble->Suggests --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 289f69ca0..324b84981 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,6 @@ Imports: jsonlite, knitr, stats, - tibble, utils, xml2 (>= 1.0.0), xmlparsedata (>= 1.0.3) @@ -38,6 +37,7 @@ Suggests: rmarkdown, rstudioapi (>= 0.2), testthat (>= 3.0.0), + tibble, withr License: MIT + file LICENSE Encoding: UTF-8 From b1f61a200f77f001ed8bc92ad34fc8013d3fcfcc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 25 Mar 2022 20:14:33 +0000 Subject: [PATCH 4/5] add consistency tag --- inst/lintr/linters.csv | 2 +- man/consistency_linters.Rd | 1 + man/linters.Rd | 4 ++-- man/literal_coercion_linter.Rd | 2 +- 4 files changed, 5 insertions(+), 4 deletions(-) diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 5426afddf..bdbed1ec4 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -26,7 +26,7 @@ if_else_match_braces_linter,default style readability implicit_integer_linter,style consistency best_practices infix_spaces_linter,style readability default line_length_linter,style readability default configurable -literal_coercion_linter,best_practices efficiency +literal_coercion_linter,best_practices consistency efficiency missing_argument_linter,correctness common_mistakes configurable missing_package_linter,robustness common_mistakes namespace_linter,correctness robustness configurable diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 442765c81..68f2c991f 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -15,6 +15,7 @@ The following linters are tagged with 'consistency': \itemize{ \item{\code{\link{assignment_linter}}} \item{\code{\link{implicit_integer_linter}}} +\item{\code{\link{literal_coercion_linter}}} \item{\code{\link{no_tab_linter}}} \item{\code{\link{numeric_leading_zero_linter}}} \item{\code{\link{object_name_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index 9ee1f67e1..0372db96b 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -20,7 +20,7 @@ The following tags exist: \item{\link[=best_practices_linters]{best_practices} (24 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (5 linters)} \item{\link[=configurable_linters]{configurable} (16 linters)} -\item{\link[=consistency_linters]{consistency} (8 linters)} +\item{\link[=consistency_linters]{consistency} (9 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (27 linters)} \item{\link[=efficiency_linters]{efficiency} (9 linters)} @@ -60,7 +60,7 @@ The following linters exist: \item{\code{\link{implicit_integer_linter}} (tags: best_practices, consistency, style)} \item{\code{\link{infix_spaces_linter}} (tags: default, readability, style)} \item{\code{\link{line_length_linter}} (tags: configurable, default, readability, style)} -\item{\code{\link{literal_coercion_linter}} (tags: best_practices, efficiency)} +\item{\code{\link{literal_coercion_linter}} (tags: best_practices, consistency, efficiency)} \item{\code{\link{missing_argument_linter}} (tags: common_mistakes, configurable, correctness)} \item{\code{\link{missing_package_linter}} (tags: common_mistakes, robustness)} \item{\code{\link{namespace_linter}} (tags: configurable, correctness, robustness)} diff --git a/man/literal_coercion_linter.Rd b/man/literal_coercion_linter.Rd index 73061505f..40effd268 100644 --- a/man/literal_coercion_linter.Rd +++ b/man/literal_coercion_linter.Rd @@ -20,5 +20,5 @@ using the typed version (e.g. \code{NA_real_}) instead of a coercion \link{linters} for a complete list of linters available in lintr. } \section{Tags}{ -\link[=best_practices_linters]{best_practices}, \link[=efficiency_linters]{efficiency} +\link[=best_practices_linters]{best_practices}, \link[=consistency_linters]{consistency}, \link[=efficiency_linters]{efficiency} } From 77f6ef89f1d700915681766abf8a63e2c64d8408 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 25 Mar 2022 22:04:27 +0000 Subject: [PATCH 5/5] xml_parsed_content --- R/literal_coercion_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index d8b65cdfa..58fe5b31f 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -13,7 +13,7 @@ #' @export literal_coercion_linter <- function() { Linter(function(source_file) { - if (length(source_file$parsed_content) == 0L) { + if (length(source_file$xml_parsed_content) == 0L) { return(list()) }