diff --git a/.lintr b/.lintr index 8be37abad..e3810d301 100644 --- a/.lintr +++ b/.lintr @@ -1,7 +1,7 @@ linters: linters_with_defaults( line_length_linter(120), implicit_integer_linter(), - backport_linter("oldrel-4", except = c("R_user_dir", "str2lang")) + backport_linter("oldrel-4", except = c("R_user_dir", "str2lang", "str2expression", "deparse1")) ) exclusions: list( "inst/doc/creating_linters.R" = 1, diff --git a/.lintr_new b/.lintr_new index c76e28296..b3aabf487 100644 --- a/.lintr_new +++ b/.lintr_new @@ -1,7 +1,7 @@ linters: linters_with_defaults( any_duplicated_linter(), any_is_na_linter(), - backport_linter("oldrel-4", except = c("R_user_dir", "str2lang")), + backport_linter("oldrel-4", except = c("R_user_dir", "str2lang", "str2expression", "deparse1")), consecutive_stopifnot_linter(), expect_comparison_linter(), expect_length_linter(), diff --git a/DESCRIPTION b/DESCRIPTION index abe6f85ad..ea8c75ed1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,6 +43,7 @@ Suggests: mockery, patrick, pkgdown, + rlang, rmarkdown, rstudioapi (>= 0.2), testthat (>= 3.0.0), diff --git a/NEWS.md b/NEWS.md index b4a73daa6..5b3cc8660 100644 --- a/NEWS.md +++ b/NEWS.md @@ -64,6 +64,9 @@ * `object_name_linter()` gains parameter `regexes` to allow custom naming conventions (#822, #1421, @AshesITR) +* `literal_coercion_linter()` reports a replacement in the lint message, e.g. code like `as.integer(1)` will + suggest using `1L` instead, and code like `as.numeric(NA)` will suggest using `NA_real_` instead (#1439, @MichaelChirico) + ### New linters * `unnecessary_lambda_linter()`: detect unnecessary lambdas (anonymous functions), e.g. diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index 4d26a9e19..aad7bf21d 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -45,14 +45,12 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export literal_coercion_linter <- function() { - coercers <- xp_text_in_table( - c( - # base coercers - paste0("as.", c("logical", "integer", "numeric", "double", "character")), - # rlang coercers - c("lgl", "int", "dbl", "chr") - ) - ) + rlang_coercers <- c("lgl", "int", "dbl", "chr") + coercers <- xp_text_in_table(c( + # base coercers + paste0("as.", c("logical", "integer", "numeric", "double", "character")), + rlang_coercers + )) # notes for clarification: # - as.integer(1e6) is arguably easier to read than 1000000L @@ -84,13 +82,40 @@ literal_coercion_linter <- function() { bad_expr <- xml2::xml_find_all(xml, xpath) + coercer <- xp_call_name(bad_expr) + # tiptoe around the fact that we don't require {rlang} + is_rlang_coercer <- coercer %in% rlang_coercers + if (any(is_rlang_coercer) && !requireNamespace("rlang", quietly = TRUE)) { + # NB: we _could_ do some extreme customization where each lint + # gets a message according to whether the coercer is from rlang, + # but this seems like overkill. Just use a generic message and move on. + lint_message <- paste( + "Use literals directly where possible, instead of coercion.", + "c.f. 1L instead of as.integer(1) or rlang::int(1), or NA_real_ instead of as.numeric(NA).", + "NB: this message can be improved to show a specific replacement if 'rlang' is installed." + ) + } else { + # duplicate, unless we add 'rlang::' and it wasn't there originally + coercion_str <- report_str <- xml2::xml_text(bad_expr) + if (any(is_rlang_coercer) && !("package:rlang" %in% search())) { + needs_prefix <- is_rlang_coercer & !startsWith(coercion_str, "rlang::") + coercion_str[needs_prefix] <- paste0("rlang::", coercion_str[needs_prefix]) + } + # the linter logic & rlang requirement should ensure that it's safe to run eval() here + # TODO(michaelchirico): this recommends '1' to replace as.numeric(1), where our + # own implicit_integer_linter(), if active, would require this to be 1.0. Should + # we recommend this instead, or offer it as an alternative? + literal_equivalent_str <- vapply(str2expression(coercion_str), function(expr) deparse1(eval(expr)), character(1L)) + lint_message <- sprintf( + "Use %s instead of %s, i.e., use literals directly where possible, instead of coercion.", + literal_equivalent_str, report_str + ) + } + xml_nodes_to_lints( bad_expr, source_expression = source_expression, - lint_message = paste( - "Use literals directly where possible, instead of coercion.", - "c.f. 1L instead of as.integer(1) or rlang::int(1), or NA_real_ instead of as.numeric(NA)." - ), + lint_message = lint_message, type = "warning" ) }) diff --git a/R/zzz.R b/R/zzz.R index 54aee5ef1..5726af512 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -283,10 +283,15 @@ settings <- NULL toset <- !(names(op_lintr) %in% names(op)) if (any(toset)) options(op_lintr[toset]) - backports::import(pkgname, c("trimws", "lengths")) + backports::import(pkgname, c("trimws", "lengths", "deparse1")) # requires R>=3.6.0; see https://github.com/r-lib/backports/issues/68 - if (!exists("str2lang", getNamespace("base"))) { - assign("str2lang", get("str2lang", getNamespace("backports")), getNamespace(pkgname)) + base_ns <- getNamespace("base") + backports_ns <- getNamespace("backports") + lintr_ns <- getNamespace(pkgname) + for (base_fun in c("str2lang", "str2expression")) { + if (!exists(base_fun, base_ns)) { + assign(base_fun, get(base_fun, backports_ns), lintr_ns) + } } default_settings <<- list( diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R index 8ba47e8b4..3db8c5edd 100644 --- a/tests/testthat/test-literal_coercion_linter.R +++ b/tests/testthat/test-literal_coercion_linter.R @@ -35,59 +35,72 @@ test_that("literal_coercion_linter skips allowed rlang usages", { expect_lint("int(1.0e6)", NULL, linter) }) +test_that("literal_coercion_linter skips quoted keyword arguments", { + expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter()) +}) + skip_if_not_installed("tibble") 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."), + lint_msg, 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", - "chr, from chr", "character", '"e"', - "chr, from chr", "character", '"E"', + ~.test_name, ~out_type, ~input, ~lint_msg, + "lgl, from int", "logical", "1L", rex::rex("Use TRUE instead of as.logical(1L)"), + "lgl, from num", "logical", "1", rex::rex("Use TRUE instead of as.logical(1)"), + "lgl, from chr", "logical", '"true"', rex::rex('Use TRUE instead of as.logical("true")'), + "int, from num", "integer", "1", rex::rex("Use 1L instead of as.integer(1)"), + "num, from num", "numeric", "1", rex::rex("Use 1 instead of as.numeric(1)"), + "dbl, from num", "double", "1", rex::rex("Use 1 instead of as.double(1)"), + "chr, from num", "character", "1", rex::rex('Use "1" instead of as.character(1)'), + "chr, from chr", "character", '"e"', rex::rex('Use "e" instead of as.character("e")'), + "chr, from chr", "character", '"E"', rex::rex('Use "E" instead of as.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", rex::rex("Use NA_integer_ instead of as.integer(NA)"), + "num, from NA", "numeric", "NA", rex::rex("Use NA_real_ instead of as.numeric(NA)"), + "dbl, from NA", "double", "NA", rex::rex("Use NA_real_ instead of as.double(NA)"), + "chr, from NA", "character", "NA", rex::rex("Use NA_character_ instead of as.character(NA)") ) ) +skip_if_not_installed("rlang") +test_that("multiple lints return custom messages", { + expect_lint( + "c(as.integer(1), lgl(1L))", + list( + rex::rex("Use 1L instead of as.integer(1)"), + rex::rex("Use TRUE instead of lgl(1L)") + ), + literal_coercion_linter() + ) +}) + 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."), + lint_msg, 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_name, ~out_type, ~input, ~lint_msg, + "rlang::lgl", "lgl", "1L", rex::rex("Use TRUE instead of lgl(1L)"), + "rlang::lgl[ns]", "rlang::lgl", "1L", rex::rex("Use TRUE instead of rlang::lgl(1L)"), + "rlang::int", "int", "1.0", rex::rex("Use 1L instead of int(1.0)"), + "rlang::dbl", "dbl", "1L", rex::rex("Use 1 instead of dbl(1L)"), + "rlang::chr", "chr", '"e"', rex::rex('Use "e" instead of chr("e")'), + "rlang::chr", "chr", '"E"', rex::rex('Use "E" instead of chr("E")') ) ) test_that("literal_coercion_linter blocks scalar rlang list2 construction", { expect_lint( "int(1, )", - "Use literals directly where possible, instead of coercion.", + rex::rex("Use 1L instead of int(1,)"), literal_coercion_linter() ) }) - -test_that("literal_coercion_linter skips quoted keyword arguments", { - expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter()) -})