From d6957965cb5e84cce97970f32c1d5626bc2f21b4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 4 May 2024 11:28:03 -0700 Subject: [PATCH 1/3] Lint for paste0(collapse='') instead of paste(collapse='') (#2559) * Lint for paste0(collapse='') instead of paste(collapse='') * Fix in {lintr} * Also skip on '...', thanks to base R * roxygenize * trailing whitespace --- NEWS.md | 1 + R/deprecated.R | 2 +- R/expect_lint.R | 2 +- R/lint.R | 2 +- R/paste_linter.R | 29 +++++++++++++++- R/utils.R | 2 +- man/paste_linter.Rd | 10 ++++++ tests/testthat/test-lint.R | 2 +- tests/testthat/test-paste_linter.R | 56 ++++++++++++++++++++++-------- 9 files changed, 85 insertions(+), 21 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6cd4f9d72..4a6599e81 100644 --- a/NEWS.md +++ b/NEWS.md @@ -51,6 +51,7 @@ * `vector_logic_linter()` is extended to recognize incorrect usage of scalar operators `&&` and `||` inside subsetting expressions like `dplyr::filter(x, A && B)` (#2166, @MichaelChirico). * `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico). * `make_linter_from_xpath()` errors up front when `lint_message` is missing (instead of delaying this error until the linter is used, #2541, @MichaelChirico). +* `paste_linter()` is extended to recommend using `paste()` instead of `paste0()` for simply aggregating a character vector with `collapse=`, i.e., when `sep=` is irrelevant (#1108, @MichaelChirico). ### New linters diff --git a/R/deprecated.R b/R/deprecated.R index 78ceefd75..a8b26e3c9 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -15,6 +15,6 @@ lintr_deprecated <- function(what, alternative = NULL, version = NULL, ". ", if (length(alternative) > 0L) c("Use ", alternative, " instead.") ) - msg <- paste0(msg, collapse = "") + msg <- paste(msg, collapse = "") signal(msg, call. = FALSE, domain = NA) } diff --git a/R/expect_lint.R b/R/expect_lint.R index 2cc8e1f9e..feb2164ef 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -61,7 +61,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { lints <- lint(file, ...) n_lints <- length(lints) - lint_str <- if (n_lints) paste0(c("", lints), collapse = "\n") else "" + lint_str <- if (n_lints) paste(c("", lints), collapse = "\n") else "" wrong_number_fmt <- "got %d lints instead of %d%s" if (is.null(checks)) { diff --git a/R/lint.R b/R/lint.R index 4435cb081..8a774ac10 100644 --- a/R/lint.R +++ b/R/lint.R @@ -666,7 +666,7 @@ highlight_string <- function(message, column_number = NULL, ranges = NULL) { } fill_with <- function(character = " ", length = 1L) { - paste0(collapse = "", rep.int(character, length)) + paste(collapse = "", rep.int(character, length)) } has_positional_logical <- function(dots) { diff --git a/R/paste_linter.R b/R/paste_linter.R index cd054a068..e41fb4015 100644 --- a/R/paste_linter.R +++ b/R/paste_linter.R @@ -58,6 +58,11 @@ #' linters = paste_linter(allow_file_path = "never") #' ) #' +#' lint( +#' text = 'paste0(x, collapse = "")', +#' linters = paste_linter() +#' ) +#' #' # okay #' lint( #' text = 'paste0("a", "b")', @@ -99,6 +104,11 @@ #' linters = paste_linter() #' ) #' +#' lint( +#' text = 'paste(x, collapse = "")', +#' linters = paste_linter() +#' ) +#' #' @seealso [linters] for a complete list of linters available in lintr. #' @export paste_linter <- function(allow_empty_sep = FALSE, @@ -157,6 +167,15 @@ paste_linter <- function(allow_empty_sep = FALSE, empty_paste_note <- 'Note that paste() converts empty inputs to "", whereas file.path() leaves it empty.' + paste0_collapse_xpath <- " + parent::expr + /parent::expr[ + SYMBOL_SUB[text() = 'collapse'] + and count(expr) = 3 + and not(expr/SYMBOL[text() = '...']) + ] + " + Linter(linter_level = "expression", function(source_expression) { paste_calls <- source_expression$xml_find_function_calls("paste") paste0_calls <- source_expression$xml_find_function_calls("paste0") @@ -219,6 +238,14 @@ paste_linter <- function(allow_empty_sep = FALSE, type = "warning" ) + paste0_collapse_expr <- xml_find_all(paste0_calls, paste0_collapse_xpath) + paste0_collapse_lints <- xml_nodes_to_lints( + paste0_collapse_expr, + source_expression = source_expression, + lint_message = "Use paste(), not paste0(), to collapse a character vector when sep= is not used.", + type = "warning" + ) + if (check_file_paths) { paste_sep_slash_expr <- paste_sep_expr[paste_sep_value == "/"] optional_lints <- c(optional_lints, xml_nodes_to_lints( @@ -248,7 +275,7 @@ paste_linter <- function(allow_empty_sep = FALSE, )) } - c(optional_lints, paste0_sep_lints, paste_strrep_lints) + c(optional_lints, paste0_sep_lints, paste_strrep_lints, paste0_collapse_lints) }) } diff --git a/R/utils.R b/R/utils.R index 8d2f92378..5a9e22b84 100644 --- a/R/utils.R +++ b/R/utils.R @@ -111,7 +111,7 @@ get_content <- function(lines, info) { lines[length(lines)] <- substr(lines[length(lines)], 1L, info$col2) lines[1L] <- substr(lines[1L], info$col1, nchar(lines[1L])) } - paste0(collapse = "\n", lines) + paste(lines, collapse = "\n") } logical_env <- function(x) { diff --git a/man/paste_linter.Rd b/man/paste_linter.Rd index 561ce8709..2317800cf 100644 --- a/man/paste_linter.Rd +++ b/man/paste_linter.Rd @@ -70,6 +70,11 @@ lint( linters = paste_linter(allow_file_path = "never") ) +lint( + text = 'paste0(x, collapse = "")', + linters = paste_linter() +) + # okay lint( text = 'paste0("a", "b")', @@ -111,6 +116,11 @@ lint( linters = paste_linter() ) +lint( + text = 'paste(x, collapse = "")', + linters = paste_linter() +) + } \seealso{ \link{linters} for a complete list of linters available in lintr. diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 1369360bf..0d7d7092f 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -117,7 +117,7 @@ test_that("lint() results from file or text should be consistent", { linters <- list(assignment_linter(), infix_spaces_linter()) lines <- c("x<-1", "x+1") file <- withr::local_tempfile(lines = lines) - text <- paste0(lines, collapse = "\n") + text <- paste(lines, collapse = "\n") file <- normalizePath(file) lint_from_file <- lint(file, linters = linters) diff --git a/tests/testthat/test-paste_linter.R b/tests/testthat/test-paste_linter.R index 0126cad4d..e901dd2c7 100644 --- a/tests/testthat/test-paste_linter.R +++ b/tests/testthat/test-paste_linter.R @@ -52,12 +52,6 @@ test_that("paste_linter blocks simple disallowed usages for collapse=', '", { rex::rex('toString(.) is more expressive than paste(., collapse = ", ")'), paste_linter() ) - - expect_lint( - "paste0(foo(x), collapse = ', ')", - rex::rex('toString(.) is more expressive than paste(., collapse = ", ")'), - paste_linter() - ) }) test_that("paste_linter respects non-default arguments", { @@ -65,7 +59,6 @@ test_that("paste_linter respects non-default arguments", { expect_lint("paste('a', 'b', sep = '')", NULL, paste_linter(allow_empty_sep = TRUE)) expect_lint("paste(collapse = ', ', x)", NULL, paste_linter(allow_to_string = TRUE)) - expect_lint("paste0(foo(x), collapse = ', ')", NULL, paste_linter(allow_to_string = TRUE)) }) test_that("paste_linter works for raw strings", { @@ -107,11 +100,11 @@ test_that("paste_linter skips allowed usages for strrep()", { }) test_that("paste_linter blocks simple disallowed usages", { - linter <- paste_linter() - lint_msg <- rex::rex("strrep(x, times) is better than paste") - - expect_lint("paste0(rep('*', 20L), collapse='')", lint_msg, linter) - expect_lint("paste(rep('#', width), collapse='')", lint_msg, linter) + expect_lint( + "paste(rep('#', width), collapse='')", + rex::rex("strrep(x, times) is better than paste"), + paste_linter() + ) }) test_that("paste_linter skips allowed usages for file paths", { @@ -156,9 +149,6 @@ test_that("paste_linter ignores non-path cases with paste0", { expect_lint("paste0(x)", NULL, linter) expect_lint("paste0('a')", NULL, linter) expect_lint("paste0('a', 1)", NULL, linter) - - # paste0(..., collapse=collapse) not directly mapped to file.path - expect_lint("paste0(x, collapse = '/')", NULL, linter) }) test_that("paste_linter detects paths built with '/' and paste0", { @@ -245,3 +235,39 @@ test_that("raw strings are detected in file path logic", { expect_lint("paste(x, y, sep = R'{//}')", NULL, linter) expect_lint("paste(x, y, sep = R'{/}')", lint_msg, linter) }) + +test_that("paste0(collapse=...) is caught", { + linter <- paste_linter() + lint_msg <- rex::rex("Use paste(), not paste0(), to collapse a character vector when sep= is not used.") + + expect_lint("paste(x, collapse = '')", NULL, linter) + expect_lint("paste0(a, b, collapse = '')", NULL, linter) + # pass-through can pass any number of arguments + expect_lint("paste0(..., collapse = '')", NULL, linter) + expect_lint("paste0(x, collapse = '')", lint_msg, linter) + expect_lint("paste0(x, collapse = 'xxx')", lint_msg, linter) + expect_lint("paste0(foo(x, y, z), collapse = '')", lint_msg, linter) +}) + +test_that("paste0(collapse=...) cases interacting with other rules are handled", { + linter <- paste_linter() + lint_msg <- rex::rex("Use paste(), not paste0(), to collapse a character vector when sep= is not used.") + + # multiple lints when collapse= happens to be ", " + expect_lint( + "paste0(foo(x), collapse = ', ')", + list(rex::rex('toString(.) is more expressive than paste(., collapse = ", ")'), lint_msg), + linter + ) + expect_lint("paste0(foo(x), collapse = ', ')", lint_msg, paste_linter(allow_to_string = TRUE)) + + expect_lint( + "paste0(rep('*', 20L), collapse='')", + list(rex::rex("strrep(x, times) is better than paste"), lint_msg), + linter + ) + + # paste0(..., collapse=collapse) not directly mapped to file.path + expect_lint("paste0(x, collapse = '/')", lint_msg, linter) + expect_lint("paste0(x, y, collapse = '/')", NULL, linter) +}) From 79d105998d06d0d731f19466439dfa7f1cfe4968 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 4 May 2024 23:49:52 -0700 Subject: [PATCH 2/3] Suppress coercion warnings (#2568) --- NEWS.md | 1 + R/literal_coercion_linter.R | 9 +++++++-- tests/testthat/test-literal_coercion_linter.R | 16 ++++++++++++++-- 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4a6599e81..e85efaeb1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -22,6 +22,7 @@ * `.lintr` config validation correctly accepts regular expressions which only compile under `perl = TRUE` (#2375, @MichaelChirico). These have always been valid (since `rex::re_matches()`, which powers the lint exclusion logic, also uses this setting), but the new up-front validation in v3.1.1 incorrectly used `perl = FALSE`. * `.lintr` configs set by option `lintr.linter_file` or environment variable `R_LINTR_LINTER_FILE` can point to subdirectories (#2512, @MichaelChirico). * `indentation_linter()` returns `ranges[1L]==1L` when the offending line has 0 spaces (#2550, @MichaelChirico). +* `literal_coercion_linter()` doesn't surface a warning about NAs during coercion for code like `as.integer("a")` (#2566, @MichaelChirico). ## Changes to default linters diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index 63eb245c3..bfc93fefe 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -97,9 +97,14 @@ literal_coercion_linter <- function() { 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 + # the linter logic & rlang requirement should ensure that it's safe to run eval() here; + # suppressWarnings() is for cases like 'as.integer("a")' which have an NA result, #2566. # TODO(#2473): Avoid a recommendation like '1' that clashes with implicit_integer_linter(). - literal_equivalent_str <- vapply(str2expression(coercion_str), function(expr) deparse1(eval(expr)), character(1L)) + literal_equivalent_str <- vapply( + str2expression(coercion_str), + function(expr) deparse1(suppressWarnings(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 diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R index 247416a2c..aa5f752fb 100644 --- a/tests/testthat/test-literal_coercion_linter.R +++ b/tests/testthat/test-literal_coercion_linter.R @@ -1,5 +1,5 @@ test_that("literal_coercion_linter skips allowed usages", { - linter <- line_length_linter() + linter <- literal_coercion_linter() # naive xpath includes the "_f0" here as a literal expect_lint('as.numeric(x$"_f0")', NULL, linter) @@ -23,7 +23,7 @@ test_that("literal_coercion_linter skips allowed usages", { }) test_that("literal_coercion_linter skips allowed rlang usages", { - linter <- line_length_linter() + linter <- literal_coercion_linter() expect_lint("int(1, 2.0, 3)", NULL, linter) expect_lint("chr('e', 'ab', 'xyz')", NULL, linter) @@ -40,6 +40,18 @@ test_that("literal_coercion_linter skips quoted keyword arguments", { expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter()) }) +test_that("no warnings surfaced by running coercion", { + linter <- literal_coercion_linter() + + expect_no_warning( + expect_lint("as.integer('a')", "Use NA_integer_", linter) + ) + + expect_no_warning( + expect_lint("as.integer(2147483648)", "Use NA_integer_", linter) + ) +}) + skip_if_not_installed("tibble") patrick::with_parameters_test_that( "literal_coercion_linter blocks simple disallowed usages", From 8d310a7cfab694370caf5d47d65adc6d6a670c63 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 6 May 2024 13:09:09 -0700 Subject: [PATCH 3/3] fix paste(collapse='') lints inside pipes (#2572) * fix paste(collapse='') lints inside pipes * pipes() is the test helper, not namespace object * longer line * parameterize test --- R/paste_linter.R | 7 ++++--- tests/testthat/test-paste_linter.R | 16 ++++++++++++++++ 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/R/paste_linter.R b/R/paste_linter.R index e41fb4015..ca5d0dd81 100644 --- a/R/paste_linter.R +++ b/R/paste_linter.R @@ -167,14 +167,15 @@ paste_linter <- function(allow_empty_sep = FALSE, empty_paste_note <- 'Note that paste() converts empty inputs to "", whereas file.path() leaves it empty.' - paste0_collapse_xpath <- " + paste0_collapse_xpath <- glue::glue(" parent::expr /parent::expr[ SYMBOL_SUB[text() = 'collapse'] - and count(expr) = 3 + and count(expr) = + 3 - count(preceding-sibling::*[self::PIPE or self::SPECIAL[{ xp_text_in_table(magrittr_pipes) }]]) and not(expr/SYMBOL[text() = '...']) ] - " + ") Linter(linter_level = "expression", function(source_expression) { paste_calls <- source_expression$xml_find_function_calls("paste") diff --git a/tests/testthat/test-paste_linter.R b/tests/testthat/test-paste_linter.R index e901dd2c7..d5db75aef 100644 --- a/tests/testthat/test-paste_linter.R +++ b/tests/testthat/test-paste_linter.R @@ -249,6 +249,22 @@ test_that("paste0(collapse=...) is caught", { expect_lint("paste0(foo(x, y, z), collapse = '')", lint_msg, linter) }) +local({ + linter <- paste_linter() + lint_msg <- rex::rex("Use paste(), not paste0(), to collapse a character vector when sep= is not used.") + pipes <- pipes() + + patrick::with_parameters_test_that( + "paste0(collapse=...) is caught in pipes", + { + expect_lint(sprintf('x %s paste0(y, collapse = "")', pipe), NULL, linter) + expect_lint(sprintf('x %s paste0(collapse = "")', pipe), lint_msg, linter) + }, + pipe = pipes, + .test_name = pipes + ) +}) + test_that("paste0(collapse=...) cases interacting with other rules are handled", { linter <- paste_linter() lint_msg <- rex::rex("Use paste(), not paste0(), to collapse a character vector when sep= is not used.")