diff --git a/NEWS.md b/NEWS.md index 704a28e5b..f524aed45 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,10 +3,15 @@ * `modify_defaults()` no longer uses the mistaken `"lintr_function"` S3 class, instead applying the `"linter"` class also common to `Linter()`. `Linter()` also includes `"function"` in the S3 class of its output to facilitate S3 dispatch to `function` methods where appropriate (#1392, @MichaelChirico). + ## Changes to defaults -* `seq_linter()` additionally lints on `1:n()` (from dplyr) - and `1:.N` (from data.table) (#1396, @IndrajeetPatil). +* `seq_linter()` additionally lints on `1:n()` (from {dplyr}) + and `1:.N` (from {data.table}) (#1396, @IndrajeetPatil). + +* `literal_coercion_linter()` lints {rlang}'s atomic vector constructors + (i.e., `int()`, `chr()`, `lgl()`, and `dbl()`) if the argument is a scalar + (#1437, @IndrajeetPatil). * `redundant_ifelse_linter()`'s lint message correctly suggests negation when the `yes` condition is `0` (#1432, @IndrajeetPatil). diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index faa820296..ac8fe1d66 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -1,7 +1,7 @@ #' 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. +#' `as.integer(1)` (or `rlang::int(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 @@ -12,23 +12,31 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export literal_coercion_linter <- function() { - coercers <- xp_text_in_table(paste0( - "as.", - c("logical", "integer", "numeric", "double", "character") - )) + coercers <- xp_text_in_table( + c( + # base coercers + paste0("as.", c("logical", "integer", "numeric", "double", "character")), + # rlang coercers + c("lgl", "int", "dbl", "chr") + ) + ) + # 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) + # - for {rlang} coercers, both `int(1)` and `int(1, )` need to be linted + not_extraction_or_scientific <- "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])] + ) + ]" xpath <- glue::glue("//expr[ expr[1][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])] - ) - ] + and {not_extraction_or_scientific} + and count(expr) = 2 ]") Linter(function(source_expression) { @@ -45,7 +53,7 @@ literal_coercion_linter <- function() { source_expression = source_expression, 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)." + "c.f. 1L instead of as.integer(1) or rlang::int(1), or NA_real_ instead of as.numeric(NA)." ), type = "warning" ) diff --git a/man/literal_coercion_linter.Rd b/man/literal_coercion_linter.Rd index 40effd268..7ee14e11a 100644 --- a/man/literal_coercion_linter.Rd +++ b/man/literal_coercion_linter.Rd @@ -7,8 +7,8 @@ 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. +\code{as.integer(1)} (or \code{rlang::int(1)}) is the same as \code{1L} but the latter is +more concise and gets typed correctly at compilation. } \details{ The same applies to missing sentinels like \code{NA} -- typically, it is not diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R index e01d9689f..02d7fcb50 100644 --- a/tests/testthat/test-literal_coercion_linter.R +++ b/tests/testthat/test-literal_coercion_linter.R @@ -19,6 +19,18 @@ test_that("literal_coercion_linter skips allowed usages", { expect_lint("as.numeric(1:3)", NULL, literal_coercion_linter()) }) +test_that("literal_coercion_linter skips allowed rlang usages", { + expect_lint("int(1, 2.0, 3)", NULL, literal_coercion_linter()) + expect_lint("chr('e', 'ab', 'xyz')", NULL, literal_coercion_linter()) + expect_lint("lgl(0, 1)", NULL, literal_coercion_linter()) + expect_lint("lgl(0L, 1)", NULL, literal_coercion_linter()) + expect_lint("dbl(1.2, 1e5, 3L, 2E4)", NULL, literal_coercion_linter()) + # make sure using namespace (`rlang::`) doesn't create problems + expect_lint("rlang::int(1, 2, 3)", NULL, literal_coercion_linter()) + # even if scalar, carve out exceptions for the following + expect_lint("int(1.0e6)", NULL, literal_coercion_linter()) +}) + skip_if_not_installed("tibble") skip_if_not_installed("patrick") patrick::with_parameters_test_that( @@ -29,22 +41,50 @@ patrick::with_parameters_test_that( 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", + ~.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", + "chr, from chr", "character", '"e"', + "chr, from chr", "character", '"E"', # 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", + "int, from NA", "integer", "NA", + "num, from NA", "numeric", "NA", + "dbl, from NA", "double", "NA", + "chr, from NA", "character", "NA", + ) +) + +patrick::with_parameters_test_that( + "literal_coercion_linter blocks rlang disallowed usages", + expect_lint( + sprintf("%s(%s)", out_type, input), + rex::rex("Use literals directly where possible, instead of coercion."), + literal_coercion_linter() + ), + # even if `as.character(1)` works, `chr(1)` doesn't, so no corresponding test case + .cases = tibble::tribble( + ~.test_name, ~out_type, ~input, + "rlang::lgl", "lgl", "1L", + "rlang::int", "int", "1.0", + "rlang::dbl", "dbl", "1L", + "rlang::chr", "chr", '"e"', + "rlang::chr", "chr", '"E"', ) ) +test_that("literal_coercion_linter blocks scalar rlang list2 construction", { + expect_lint( + "int(1, )", + "Use literals directly where possible, instead of coercion.", + literal_coercion_linter() + ) +}) + test_that("literal_coercion_linter skips quoted keyword arguments", { expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter()) })