From 3882350fd8a77980301e8ce4dc676017713c601f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 5 Mar 2025 23:44:08 +0000 Subject: [PATCH 001/131] use maybe_write_content for easier 'mocking' --- R/expect_lint.R | 21 +++++++++++--------- tests/testthat/test-get_source_expressions.R | 1 + 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index c8e81cafa..30e377d7c 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -47,15 +47,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { old_lang <- set_lang(language) on.exit(reset_lang(old_lang)) - if (is.null(file)) { - file <- tempfile() - on.exit(unlink(file), add = TRUE) - local({ - con <- base::file(file, encoding = "UTF-8") - on.exit(close(con)) - writeLines(content, con = con, sep = "\n") - }) - } + file <- maybe_write_content(file, content) lints <- lint(file, ...) n_lints <- length(lints) @@ -121,6 +113,17 @@ expect_no_lint <- function(content, ..., file = NULL, language = "en") { expect_lint(content, NULL, ..., file = file, language = language) } +maybe_write_content <- function(file, lines) { + if (!is.null(file)) { + return(file) + } + tmp <- tempfile() + con <- file(tmp, encoding = "UTF-8") + on.exit(close(con)) + writeLines(lines, con = con, sep = "\n") + tmp +} + #' Test that the package is lint free #' #' This function is a thin wrapper around lint_package that simply tests there are no diff --git a/tests/testthat/test-get_source_expressions.R b/tests/testthat/test-get_source_expressions.R index eeaff905b..64dbd548d 100644 --- a/tests/testthat/test-get_source_expressions.R +++ b/tests/testthat/test-get_source_expressions.R @@ -105,6 +105,7 @@ test_that("Multi-byte character truncated by parser is ignored", { }) test_that("Can read non UTF-8 file", { + withr::local_options(list(lintr.linter_file = tempfile())) proj_dir <- test_path("dummy_projects", "project") withr::local_dir(proj_dir) expect_no_lint(file = "cp1252.R", linters = list()) From c392c535066ea661051956aaccd9e09e44596f7f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 01:00:16 +0000 Subject: [PATCH 002/131] initial progress --- .dev/ast_fuzz_test.R | 43 +++++++++++++++++++++++++++++++++ .dev/maybe_fuzz_content.R | 50 +++++++++++++++++++++++++++++++++++++++ R/expect_lint.R | 48 ++++++++++++++++++++++++++++++++++++- 3 files changed, 140 insertions(+), 1 deletion(-) create mode 100644 .dev/ast_fuzz_test.R create mode 100644 .dev/maybe_fuzz_content.R diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R new file mode 100644 index 000000000..cd330d210 --- /dev/null +++ b/.dev/ast_fuzz_test.R @@ -0,0 +1,43 @@ +# Fuzz testing for lint consistency +# +# We have often encountered issues where we handle +# equivalent R constructs inconsistently, e.g., +# function(...) should almost always match the same +# rules as \(...), and '<-' assignment should almost +# always be equivalent to '='. +# +# Here, we seek to enforce that (under eventual consistency) +# by randomly altering the contents of files encountered +# under expect_lint() to swap known equivalencies. + +expect_lint_file <- "R/expect_lint.R" + +original <- readLines(expect_lint_file) +expected_line <- "file <- maybe_write_content(file, content)" +expected_line_idx <- grep(expected_line, original, fixed = TRUE) +if (length(expected_line_idx) != 1L) { + stop(sprintf( + "Please update this workflow -- need exactly one hit for line '%s' in file '%s'.", + expected_line, expect_lint_file + )) +} +writeLines( + c( + head(original, expected_line_idx-1L), + # overwrite original exit hook to always delete the fuzzed file + "on.exit({reset_lang(old_lang); unlink(file)})", + "file <- maybe_fuzz_content(file, content)", + tail(original, -expected_line_idx), + readLines(".dev/maybe_fuzz_content.R") + ), + expect_lint_file +) +# Not useful in CI but good when running locally. +withr::defer({ + writeLines(original, expect_lint_file) + pkgload::load_all() +}) + +pkgload::load_all() + +testthat::test_dir("tests") diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R new file mode 100644 index 000000000..fffce7d1f --- /dev/null +++ b/.dev/maybe_fuzz_content.R @@ -0,0 +1,50 @@ +maybe_fuzz_content <- function(file, lines) { + new_file <- tempfile() + if (is.null(file)) { + con <- file(new_file, encoding = "UTF-8") + writeLines(lines, con = con, sep = "\n") + close(con) + } else { + file.copy(file, new_file, copy.mode = FALSE) + } + + fuzz_contents(new_file) + + new_file +} + +fuzz_contents <- function(f) { + pd <- getParseData(parse(f, keep.source = TRUE)) + + fun_tokens <- c("'\\\\'", "FUNCTION") + fun_idx <- which(pd$token %in% fun_tokens) + n_fun <- length(fun_idx) + + if (n_fun == 0L) { + return(invisible()) + } + + pd$new_token[fun_idx] <- sample(fun_tokens, n_fun, replace = TRUE) + + l <- readLines(f) + + replacement_map <- c(FUNCTION = " \\", `'\\\\'` = "function") + for (ii in rev(fun_idx)) { + if (pd$token[ii] == pd$new_token[ii]) next + browser() + ptn = rex::rex( + start, + capture(n_times(anything, pd$col1[ii] - 1L), name = "prefix"), + pd$text[ii] + ) + l[pd$line1[ii]] <- rex::re_substitutes(l[pd$line1[ii]], ptn, replacement_map[pd$token[ii]]) + } + + + start <- pd$col1[fun_idx] + substr(l[pd$line1[fun_idx]], start, start + nchar("function") - 1L) <- replacement_map[pd$token[fun_idx]] + + writeLines(l, f) + + invisible() +} diff --git a/R/expect_lint.R b/R/expect_lint.R index 30e377d7c..5d321354a 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -47,7 +47,9 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { old_lang <- set_lang(language) on.exit(reset_lang(old_lang)) - file <- maybe_write_content(file, content) + if (is.null(file)) on.exit(unlink(file), add = TRUE) +on.exit({reset_lang(old_lang); unlink(file)}) +file <- maybe_fuzz_content(file, content) lints <- lint(file, ...) n_lints <- length(lints) @@ -165,3 +167,47 @@ require_testthat <- function() { ) } } +maybe_fuzz_content <- function(file, lines) { + new_file <- tempfile() + if (is.null(file)) { + con <- file(new_file, encoding = "UTF-8") + writeLines(lines, con = con, sep = "\n") + close(con) + } else { + file.copy(file, new_file, copy.mode = FALSE) + } + + fuzz_contents(new_file) + + new_file +} + +fuzz_contents <- function(f) { + pd <- getParseData(parse(f, keep.source = TRUE)) + + fun_tokens <- c("'\\\\'", "FUNCTION") + fun_idx <- which(pd$token %in% fun_tokens) + n_fun <- length(fun_idx) + + if (n_fun == 0L) { + return(invisible()) + } + + pd$new_token[fun_idx] <- sample(fun_tokens, length(fun_idx), replace = TRUE) + + l <- readLines(f) + + for (ii in rev(fun_idx)) { + if (pd$token[ii] == pd$new_token[ii]) next + browser() + ptn = paste0("^(.{", pd$col1 - 1L, "})") + } + + replacement_map <- c(FUNCTION = " \\", `'\\\\'` = "function") + start <- pd$col1[fun_idx] + substr(l[pd$line1[fun_idx]], start, start + nchar("function") - 1L) <- replacement_map[pd$token[fun_idx]] + + writeLines(l, f) + + invisible() +} From 5cef281b62b7a6ba61466b10a9ec9cf3bf58e430 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 17:35:37 +0000 Subject: [PATCH 003/131] getting very close i think... --- .dev/ast_fuzz_test.R | 4 ++-- .dev/maybe_fuzz_content.R | 10 +++------- R/expect_lint.R | 3 +-- 3 files changed, 6 insertions(+), 11 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index cd330d210..46be6a27c 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -25,8 +25,8 @@ writeLines( c( head(original, expected_line_idx-1L), # overwrite original exit hook to always delete the fuzzed file - "on.exit({reset_lang(old_lang); unlink(file)})", - "file <- maybe_fuzz_content(file, content)", + " on.exit({reset_lang(old_lang); unlink(file)})", + " file <- maybe_fuzz_content(file, content)", tail(original, -expected_line_idx), readLines(".dev/maybe_fuzz_content.R") ), diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index fffce7d1f..b5af3cb09 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -24,26 +24,22 @@ fuzz_contents <- function(f) { return(invisible()) } + pd$new_token <- NA_character_ pd$new_token[fun_idx] <- sample(fun_tokens, n_fun, replace = TRUE) l <- readLines(f) - replacement_map <- c(FUNCTION = " \\", `'\\\\'` = "function") + replacement_map <- c(FUNCTION = "\\", `'\\\\'` = "function") for (ii in rev(fun_idx)) { if (pd$token[ii] == pd$new_token[ii]) next - browser() ptn = rex::rex( start, capture(n_times(anything, pd$col1[ii] - 1L), name = "prefix"), pd$text[ii] ) - l[pd$line1[ii]] <- rex::re_substitutes(l[pd$line1[ii]], ptn, replacement_map[pd$token[ii]]) + l[pd$line1[ii]] <- rex::re_substitutes(l[pd$line1[ii]], ptn, paste0("\\1", rex::rex(replacement_map[pd$token[ii]]))) } - - start <- pd$col1[fun_idx] - substr(l[pd$line1[fun_idx]], start, start + nchar("function") - 1L) <- replacement_map[pd$token[fun_idx]] - writeLines(l, f) invisible() diff --git a/R/expect_lint.R b/R/expect_lint.R index 5d321354a..811dda0ea 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -48,8 +48,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { on.exit(reset_lang(old_lang)) if (is.null(file)) on.exit(unlink(file), add = TRUE) -on.exit({reset_lang(old_lang); unlink(file)}) -file <- maybe_fuzz_content(file, content) + file <- maybe_write_content(file, content) lints <- lint(file, ...) n_lints <- length(lints) From a4e4a66f36a7bbe4d8db6fab56d90f58ef9449b2 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 17:41:43 +0000 Subject: [PATCH 004/131] skip Rmd files --- .dev/maybe_fuzz_content.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index b5af3cb09..3f2969f66 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -14,7 +14,11 @@ maybe_fuzz_content <- function(file, lines) { } fuzz_contents <- function(f) { - pd <- getParseData(parse(f, keep.source = TRUE)) + pd <- tryCatch(getParseData(parse(f, keep.source = TRUE)), error = identity) + # e.g. Rmd files. We could use get_source_expressions(), but with little benefit & much slower. + if (inherits(pd, "error")) { + return(invisible()) + } fun_tokens <- c("'\\\\'", "FUNCTION") fun_idx <- which(pd$token %in% fun_tokens) From 0b1eaf5e5984928ded4fc4ac44357c9d12b14b4e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 17:43:06 +0000 Subject: [PATCH 005/131] caught a live one! --- R/terminal_close_linter.R | 2 +- tests/testthat/test-terminal_close_linter.R | 36 +++++++++++++++++++-- 2 files changed, 34 insertions(+), 4 deletions(-) diff --git a/R/terminal_close_linter.R b/R/terminal_close_linter.R index 20b86ac64..7c4a44285 100644 --- a/R/terminal_close_linter.R +++ b/R/terminal_close_linter.R @@ -39,7 +39,7 @@ #' @export terminal_close_linter <- make_linter_from_xpath( xpath = " - //FUNCTION + (//FUNCTION | //OP-LAMBDA) /following-sibling::expr /expr[last()][ expr/SYMBOL_FUNCTION_CALL[text() = 'close'] diff --git a/tests/testthat/test-terminal_close_linter.R b/tests/testthat/test-terminal_close_linter.R index 697804f68..b20149005 100644 --- a/tests/testthat/test-terminal_close_linter.R +++ b/tests/testthat/test-terminal_close_linter.R @@ -9,7 +9,7 @@ test_that("terminal_close_linter skips allowed cases", { return(invisible()) } ") - expect_lint(lines, NULL, linter) + expect_no_lint(lines, linter) lines <- trim_some(" foo <- function(bar) { @@ -17,7 +17,15 @@ test_that("terminal_close_linter skips allowed cases", { return(close) } ") - expect_lint(lines, NULL, linter) + expect_no_lint(lines, linter) + + lines <- trim_some(" + foo <- \\(bar) { + close <- bar + 1 + return(close) + } + ") + expect_no_lint(lines, linter) lines <- trim_some(" foo <- function(bar) { @@ -25,7 +33,7 @@ test_that("terminal_close_linter skips allowed cases", { close } ") - expect_lint(lines, NULL, linter) + expect_no_lint(lines, linter) }) test_that("terminal_close_linter blocks simple cases", { @@ -72,3 +80,25 @@ test_that("terminal_close_linter blocks simple cases", { linter ) }) + +test_that("lints vectorize", { + expect_lint( + trim_some("{ + foo <- function() { + tmp <- file(tempfile()) + writeLines(letters, tmp) + close(tmp) + } + bar <- \\() { + tmp <- file(tempfile()) + writeLines(letters, tmp) + close(tmp) + } + }"), + list( + list("close connections", line_number = 5L), + list("close connections", line_number = 10L) + ), + terminal_close_linter() + ) +}) From 868ad3079a4b287b3e88701d99b8410fc3403d12 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 17:55:25 +0000 Subject: [PATCH 006/131] need to match original file extension? --- .dev/maybe_fuzz_content.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 3f2969f66..60bb6588c 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -1,10 +1,11 @@ maybe_fuzz_content <- function(file, lines) { - new_file <- tempfile() if (is.null(file)) { + new_file <- tempfile() con <- file(new_file, encoding = "UTF-8") writeLines(lines, con = con, sep = "\n") close(con) } else { + new_file <- tempfile(fileext = tools::file_ext(file)) file.copy(file, new_file, copy.mode = FALSE) } From 0ed5cc042506832b19587161899e9d80aea9c988 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 17:58:44 +0000 Subject: [PATCH 007/131] caught another one! --- R/library_call_linter.R | 4 ++-- tests/testthat/test-library_call_linter.R | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/library_call_linter.R b/R/library_call_linter.R index fb5c20e80..b87297d8e 100644 --- a/R/library_call_linter.R +++ b/R/library_call_linter.R @@ -111,7 +111,7 @@ library_call_linter <- function(allow_preamble = TRUE) { expr[2][STR_CONST] or ( SYMBOL_SUB[text() = 'character.only'] - and not(ancestor::expr[FUNCTION]) + and not(ancestor::expr[FUNCTION or OP-LAMBDA]) ) ] ") @@ -122,7 +122,7 @@ library_call_linter <- function(allow_preamble = TRUE) { //SYMBOL_FUNCTION_CALL[{ xp_text_in_table(bad_indirect_funs) }] /parent::expr /parent::expr[ - not(ancestor::expr[FUNCTION]) + not(ancestor::expr[FUNCTION or OP-LAMBDA]) and expr[{ call_symbol_cond }] ] ") diff --git a/tests/testthat/test-library_call_linter.R b/tests/testthat/test-library_call_linter.R index fc5b53367..f43790b36 100644 --- a/tests/testthat/test-library_call_linter.R +++ b/tests/testthat/test-library_call_linter.R @@ -220,7 +220,9 @@ test_that("skips allowed usages of library()/character.only=TRUE", { expect_no_lint("library(data.table)", linter) expect_no_lint("function(pkg) library(pkg, character.only = TRUE)", linter) + expect_no_lint("\\(pkg) library(pkg, character.only = TRUE)", linter) expect_no_lint("function(pkgs) sapply(pkgs, require, character.only = TRUE)", linter) + expect_no_lint("\\(pkgs) sapply(pkgs, require, character.only = TRUE)", linter) }) test_that("blocks disallowed usages of strings in library()/require()", { From 99d00a36548bcd27572e97261ed6d6ee5fe697bf Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 18:29:58 +0000 Subject: [PATCH 008/131] simpler approach, avoid rex() due to bug --- .dev/maybe_fuzz_content.R | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 60bb6588c..16c5e566c 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -21,28 +21,24 @@ fuzz_contents <- function(f) { return(invisible()) } - fun_tokens <- c("'\\\\'", "FUNCTION") - fun_idx <- which(pd$token %in% fun_tokens) + fun_tokens <- c(`'\\\\'` = "\\", `FUNCTION` = "function") + fun_idx <- which(pd$token %in% names(fun_tokens)) n_fun <- length(fun_idx) if (n_fun == 0L) { return(invisible()) } - pd$new_token <- NA_character_ - pd$new_token[fun_idx] <- sample(fun_tokens, n_fun, replace = TRUE) + pd$new_text <- NA_character_ + pd$new_text[fun_idx] <- sample(fun_tokens, n_fun, replace = TRUE) l <- readLines(f) - replacement_map <- c(FUNCTION = "\\", `'\\\\'` = "function") for (ii in rev(fun_idx)) { - if (pd$token[ii] == pd$new_token[ii]) next - ptn = rex::rex( - start, - capture(n_times(anything, pd$col1[ii] - 1L), name = "prefix"), - pd$text[ii] - ) - l[pd$line1[ii]] <- rex::re_substitutes(l[pd$line1[ii]], ptn, paste0("\\1", rex::rex(replacement_map[pd$token[ii]]))) + if (pd$text[ii] == pd$new_text[ii]) next + # Tried, with all rex(), hit a bug: https://github.com/r-lib/rex/issues/96 + ptn = paste0("^(.{", pd$col1[ii] - 1L, "})", rex::rex(pd$text[ii])) + l[pd$line1[ii]] <- rex::re_substitutes(l[pd$line1[ii]], ptn, paste0("\\1", rex::rex(pd$new_text[ii]))) } writeLines(l, f) From d3cca7ad7a5af660f0544e7bc329586ff8db53f7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 19:35:29 +0000 Subject: [PATCH 009/131] also ignore warnings --- .dev/maybe_fuzz_content.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 16c5e566c..b14a90aeb 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -15,8 +15,9 @@ maybe_fuzz_content <- function(file, lines) { } fuzz_contents <- function(f) { - pd <- tryCatch(getParseData(parse(f, keep.source = TRUE)), error = identity) - # e.g. Rmd files. We could use get_source_expressions(), but with little benefit & much slower. + # skip errors for e.g. Rmd files, and ignore warnings. + # We could use get_source_expressions(), but with little benefit & much slower. + pd <- tryCatch(getParseData(suppressWarnings(parse(f, keep.source = TRUE))), error = identity) if (inherits(pd, "error")) { return(invisible()) } From 59dc1b02ead3249c3f914f85dd78dfffcbcd8bb5 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 19:59:09 +0000 Subject: [PATCH 010/131] finally getting somewhere... --- .dev/ast_fuzz_test.R | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 46be6a27c..993be3b6b 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -40,4 +40,20 @@ withr::defer({ pkgload::load_all() -testthat::test_dir("tests") +reporter <- testthat::SummaryReporter$new() +testthat::test_local(reporter = reporter) + +failures <- reporter$failures$as_list() +valid_failure <- vapply( + failures, + function(failure) { + if (grepl("column_number [0-9]+L? did not match", failure$message)) { + return(TRUE) + } + FALSE + }, + logical(1L) +) +for (failure in failures) { + +} From a25065f7244f3d889b4335dea4401a092577ea3c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 20:48:40 +0000 Subject: [PATCH 011/131] progressively more complicated :( --- .dev/ast_fuzz_test.R | 46 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 43 insertions(+), 3 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 993be3b6b..802c19eeb 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -40,6 +40,46 @@ withr::defer({ pkgload::load_all() +test_restorations <- list() +for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = TRUE)) { + xml <- xml2::read_xml(xmlparsedata::xml_parse_data(parse(test_file, keep.source = TRUE))) + # parent::* to catch top-level comments (exprlist) + nofuzz_lines <- xml_find_all(xml, "//COMMENT[contains(text(), 'nofuzz')]/parent::*") + if (length(nofuzz_lines) == 0L) next + + original <- test_lines <- readLines(test_file) + + for (nofuzz_line in nofuzz_lines) { + comments <- xml2::xml_find_all(nofuzz_line, "COMMENT[contains(text(), 'nofuzz')]") + comment_text <- xml2::xml_text(comments) + start_idx <- grep("nofuzz start", comment_text, fixed = TRUE) + end_idx <- grep("nofuzz end", comment_text, fixed = TRUE) + if (length(start_idx) != length(end_idx) || any(end_idx < start_idx)) { + stop(sprintf( + "Mismatched '# nofuzz start' (%s), '# nofuzz end' (%s) in %s", + toString(start_idx), toString(end_idx), test_file + )) + } + + comment_range <- Map(`:`, + as.integer(xml2::xml_attr(comments[start_idx], "line1")), + as.integer(xml2::xml_attr(comments[end_idx], "line1")) + ) + for (comment_range in comment_ranges) { + test_lines[comment_range] <- paste("#", test_lines[comment_range]) + } + + if (!any(!start_idx & !end_idx)) next + + comment_range <- as.integer(xml2::xml_attr(nofuzz_line, "line1")):as.integer(xml2::xml_attr(nofuzz_line, "line2")) + test_lines[comment_range] <- paste("#", test_lines[comment_range]) + } + + writeLines(test_lines, test_file) + test_restorations <- c(test_restorations, list(list(file = test_file, lines = original))) +} +withr::defer(for (restoration in test_restorations) writeLines(restoration$original, restoration$file)) + reporter <- testthat::SummaryReporter$new() testthat::test_local(reporter = reporter) @@ -50,10 +90,10 @@ valid_failure <- vapply( if (grepl("column_number [0-9]+L? did not match", failure$message)) { return(TRUE) } + if (grepl("ranges list[(].* did not match", failure$message)) { + return(TRUE) + } FALSE }, logical(1L) ) -for (failure in failures) { - -} From 491a3405ae88761410a5ee2b9c5444228617ec1d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 20:58:02 +0000 Subject: [PATCH 012/131] round of fixes & first working nofuzz --- .dev/ast_fuzz_test.R | 7 +++++-- tests/testthat/test-exclusions.R | 2 +- tests/testthat/test-get_source_expressions.R | 21 +++++++++++--------- tests/testthat/test-indentation_linter.R | 2 ++ 4 files changed, 20 insertions(+), 12 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 802c19eeb..9cc411084 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -61,7 +61,7 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = )) } - comment_range <- Map(`:`, + comment_ranges <- Map(`:`, as.integer(xml2::xml_attr(comments[start_idx], "line1")), as.integer(xml2::xml_attr(comments[end_idx], "line1")) ) @@ -69,8 +69,11 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = test_lines[comment_range] <- paste("#", test_lines[comment_range]) } - if (!any(!start_idx & !end_idx)) next + if (length(start_idx) > 0L && !any(!start_idx & !end_idx)) next + # NB: one-line tests line expect_lint(...) # nofuzz are not supported, + # since the comment will attach to the parent test_that() & thus comment + # out the whole unit. Easiest solution is just to spread out those few tests for now. comment_range <- as.integer(xml2::xml_attr(nofuzz_line, "line1")):as.integer(xml2::xml_attr(nofuzz_line, "line2")) test_lines[comment_range] <- paste("#", test_lines[comment_range]) } diff --git a/tests/testthat/test-exclusions.R b/tests/testthat/test-exclusions.R index 9fce8adf5..9bfddc81e 100644 --- a/tests/testthat/test-exclusions.R +++ b/tests/testthat/test-exclusions.R @@ -142,7 +142,7 @@ test_that("#1442: is_excluded_files works if no global exclusions are specified" ) # 3 lints: assignment_linter(), quotes_linter() and line_length_linter() - expect_lint( + expect_lint( # nofuzz file = file.path(tmp, "bad.R"), checks = list( list(linter = "assignment_linter", line_number = 1L), diff --git a/tests/testthat/test-get_source_expressions.R b/tests/testthat/test-get_source_expressions.R index 64dbd548d..d99016d78 100644 --- a/tests/testthat/test-get_source_expressions.R +++ b/tests/testthat/test-get_source_expressions.R @@ -108,7 +108,10 @@ test_that("Can read non UTF-8 file", { withr::local_options(list(lintr.linter_file = tempfile())) proj_dir <- test_path("dummy_projects", "project") withr::local_dir(proj_dir) - expect_no_lint(file = "cp1252.R", linters = list()) + expect_no_lint( # nofuzz + file = "cp1252.R", + linters = list() + ) }) test_that("Warns if encoding is misspecified, Pt. 1", { @@ -142,14 +145,14 @@ test_that("Warns if encoding is misspecified, Pt. 1", { test_that("Can extract line number from parser errors", { with_content_to_parse( - trim_some(' - "ok" - R"---a---" - '), - { - expect_identical(error$message, "Malformed raw string literal.") - expect_identical(error$line_number, 2L) - } +# # trim_some(' +# # "ok" +# # R"---a---" +# # '), +# # { +# # expect_identical(error$message, "Malformed raw string literal.") +# # expect_identical(error$line_number, 2L) +# # } ) with_content_to_parse( diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R index 4dd640389..10550eaff 100644 --- a/tests/testthat/test-indentation_linter.R +++ b/tests/testthat/test-indentation_linter.R @@ -152,6 +152,7 @@ test_that("indentation linter flags improper closing curly braces", { ) }) +# nofuzz start test_that("function argument indentation works in tidyverse-style", { linter <- indentation_linter() expect_no_lint( @@ -260,6 +261,7 @@ test_that("function argument indentation works in tidyverse-style", { linter ) }) +# nofuzz end test_that("function argument indentation works in always-hanging-style", { linter <- indentation_linter(hanging_indent_style = "always") From 92f0628ff64cd109e87120392ffe7add7992d232 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 21:03:19 +0000 Subject: [PATCH 013/131] looks like we got another live one... break time --- tests/testthat/test-indentation_linter.R | 2 +- tests/testthat/test-object_usage_linter.R | 14 ++++++++------ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R index 10550eaff..229f78cbe 100644 --- a/tests/testthat/test-indentation_linter.R +++ b/tests/testthat/test-indentation_linter.R @@ -261,7 +261,6 @@ test_that("function argument indentation works in tidyverse-style", { linter ) }) -# nofuzz end test_that("function argument indentation works in always-hanging-style", { linter <- indentation_linter(hanging_indent_style = "always") @@ -357,6 +356,7 @@ test_that("function argument indentation works in always-hanging-style", { linter ) }) +# nofuzz end test_that("indentation with operators works", { linter <- indentation_linter() diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index a12620008..3472fec3a 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -177,10 +177,10 @@ test_that("calls with top level function definitions are ignored", { test_that("object-usage line-numbers are relative to start-of-file", { expect_lint( trim_some(" - a <- function(y) { + a <- \\(y) { y ** 2 } - b <- function() { + b <- \\() { x } "), @@ -672,6 +672,8 @@ test_that("messages without a quoted name are caught", { # See #1914 test_that("symbols in formulas aren't treated as 'undefined global'", { + linter <- object_usage_linter() + expect_lint( trim_some(" foo <- function(x) { @@ -686,7 +688,7 @@ test_that("symbols in formulas aren't treated as 'undefined global'", { line_number = 4L, column_number = 21L ), - object_usage_linter() + linter ) # neither on the RHS @@ -704,7 +706,7 @@ test_that("symbols in formulas aren't treated as 'undefined global'", { line_number = 4L, column_number = 21L ), - object_usage_linter() + linter ) # nor in nested expressions @@ -722,7 +724,7 @@ test_that("symbols in formulas aren't treated as 'undefined global'", { line_number = 4L, column_number = 21L ), - object_usage_linter() + linter ) # nor as a call @@ -743,7 +745,7 @@ test_that("symbols in formulas aren't treated as 'undefined global'", { line_number = 4L, column_number = 21L ), - object_usage_linter() + linter ) }) From d387a715ee5ce35669d2f9c6beef0129b93e0024 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 21:40:23 +0000 Subject: [PATCH 014/131] another true positive --- R/unnecessary_lambda_linter.R | 2 +- tests/testthat/test-object_usage_linter.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index 007b3c831..f2f62232d 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -93,7 +93,7 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { # NB: this includes 0+3 and TRUE+FALSE, which are also fine. inner_comparison_xpath <- glue(" parent::expr - /expr[FUNCTION] + /expr[FUNCTION or OP-LAMBDA] /expr[ ({ xp_or(infix_metadata$xml_tag[infix_metadata$comparator]) }) and expr[ diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index 3472fec3a..d2c58371e 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -177,10 +177,10 @@ test_that("calls with top level function definitions are ignored", { test_that("object-usage line-numbers are relative to start-of-file", { expect_lint( trim_some(" - a <- \\(y) { + a <- function(y) { y ** 2 } - b <- \\() { + b <- function() { x } "), From e150ffe73791da5d70b863c3c5ce5d87eb8c46c9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 22:01:14 +0000 Subject: [PATCH 015/131] more ignores, need '.' in file extension, restore test --- .dev/ast_fuzz_test.R | 11 ++++------- .dev/maybe_fuzz_content.R | 2 +- tests/testthat/test-get_source_expressions.R | 16 ++++++++-------- 3 files changed, 13 insertions(+), 16 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 9cc411084..84f263d7d 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -47,7 +47,7 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = nofuzz_lines <- xml_find_all(xml, "//COMMENT[contains(text(), 'nofuzz')]/parent::*") if (length(nofuzz_lines) == 0L) next - original <- test_lines <- readLines(test_file) + test_original <- test_lines <- readLines(test_file) for (nofuzz_line in nofuzz_lines) { comments <- xml2::xml_find_all(nofuzz_line, "COMMENT[contains(text(), 'nofuzz')]") @@ -79,9 +79,9 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = } writeLines(test_lines, test_file) - test_restorations <- c(test_restorations, list(list(file = test_file, lines = original))) + test_restorations <- c(test_restorations, list(list(file = test_file, lines = test_original))) } -withr::defer(for (restoration in test_restorations) writeLines(restoration$original, restoration$file)) +withr::defer(for (restoration in test_restorations) writeLines(restoration$lines, restoration$file)) reporter <- testthat::SummaryReporter$new() testthat::test_local(reporter = reporter) @@ -90,10 +90,7 @@ failures <- reporter$failures$as_list() valid_failure <- vapply( failures, function(failure) { - if (grepl("column_number [0-9]+L? did not match", failure$message)) { - return(TRUE) - } - if (grepl("ranges list[(].* did not match", failure$message)) { + if (grepl('(column_number|ranges|line) .* did not match', failure$message)) { return(TRUE) } FALSE diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index b14a90aeb..b805b865d 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -5,7 +5,7 @@ maybe_fuzz_content <- function(file, lines) { writeLines(lines, con = con, sep = "\n") close(con) } else { - new_file <- tempfile(fileext = tools::file_ext(file)) + new_file <- tempfile(fileext = paste0(".", tools::file_ext(file))) file.copy(file, new_file, copy.mode = FALSE) } diff --git a/tests/testthat/test-get_source_expressions.R b/tests/testthat/test-get_source_expressions.R index d99016d78..bbda9d362 100644 --- a/tests/testthat/test-get_source_expressions.R +++ b/tests/testthat/test-get_source_expressions.R @@ -145,14 +145,14 @@ test_that("Warns if encoding is misspecified, Pt. 1", { test_that("Can extract line number from parser errors", { with_content_to_parse( -# # trim_some(' -# # "ok" -# # R"---a---" -# # '), -# # { -# # expect_identical(error$message, "Malformed raw string literal.") -# # expect_identical(error$line_number, 2L) -# # } + trim_some(' + "ok" + R"---a---" + '), + { + expect_identical(error$message, "Malformed raw string literal.") + expect_identical(error$line_number, 2L) + } ) with_content_to_parse( From 3d1fc0ea7f8b32ac7cecd2ad3a3e8343dd09a1ca Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 22:07:41 +0000 Subject: [PATCH 016/131] wrapping up --- .dev/ast_fuzz_test.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 84f263d7d..6ae518e31 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -97,3 +97,10 @@ valid_failure <- vapply( }, logical(1L) ) +if (!all(valid_failure)) { + failures <- failures[!valid_failure] + names(failures) <- vapply(failures, `[[`, "test", FUN.VALUE = character(1L)) + cat("Some fuzzed tests failed unexpectedly!\n") + print(failures) + stop("Use # nofuzz [start|end] to mark false positives or fix any bugs.") +} From b69b7cd0a8d8632a022c96a135c8212c04b80b63 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 22:11:53 +0000 Subject: [PATCH 017/131] Write up the GHA config --- .dev/ast_fuzz_test.R | 14 ++++++++------ .github/workflows/ast-fuzz.yaml | 30 ++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 6 deletions(-) create mode 100644 .github/workflows/ast-fuzz.yaml diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 6ae518e31..d8a14ade7 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -10,6 +10,8 @@ # by randomly altering the contents of files encountered # under expect_lint() to swap known equivalencies. +library(xml2) + expect_lint_file <- "R/expect_lint.R" original <- readLines(expect_lint_file) @@ -42,7 +44,7 @@ pkgload::load_all() test_restorations <- list() for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = TRUE)) { - xml <- xml2::read_xml(xmlparsedata::xml_parse_data(parse(test_file, keep.source = TRUE))) + xml <- read_xml(xmlparsedata::xml_parse_data(parse(test_file, keep.source = TRUE))) # parent::* to catch top-level comments (exprlist) nofuzz_lines <- xml_find_all(xml, "//COMMENT[contains(text(), 'nofuzz')]/parent::*") if (length(nofuzz_lines) == 0L) next @@ -50,8 +52,8 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = test_original <- test_lines <- readLines(test_file) for (nofuzz_line in nofuzz_lines) { - comments <- xml2::xml_find_all(nofuzz_line, "COMMENT[contains(text(), 'nofuzz')]") - comment_text <- xml2::xml_text(comments) + comments <- xml_find_all(nofuzz_line, "COMMENT[contains(text(), 'nofuzz')]") + comment_text <- xml_text(comments) start_idx <- grep("nofuzz start", comment_text, fixed = TRUE) end_idx <- grep("nofuzz end", comment_text, fixed = TRUE) if (length(start_idx) != length(end_idx) || any(end_idx < start_idx)) { @@ -62,8 +64,8 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = } comment_ranges <- Map(`:`, - as.integer(xml2::xml_attr(comments[start_idx], "line1")), - as.integer(xml2::xml_attr(comments[end_idx], "line1")) + as.integer(xml_attr(comments[start_idx], "line1")), + as.integer(xml_attr(comments[end_idx], "line1")) ) for (comment_range in comment_ranges) { test_lines[comment_range] <- paste("#", test_lines[comment_range]) @@ -74,7 +76,7 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = # NB: one-line tests line expect_lint(...) # nofuzz are not supported, # since the comment will attach to the parent test_that() & thus comment # out the whole unit. Easiest solution is just to spread out those few tests for now. - comment_range <- as.integer(xml2::xml_attr(nofuzz_line, "line1")):as.integer(xml2::xml_attr(nofuzz_line, "line2")) + comment_range <- as.integer(xml_attr(nofuzz_line, "line1")):as.integer(xml_attr(nofuzz_line, "line2")) test_lines[comment_range] <- paste("#", test_lines[comment_range]) } diff --git a/.github/workflows/ast-fuzz.yaml b/.github/workflows/ast-fuzz.yaml new file mode 100644 index 000000000..6242360cf --- /dev/null +++ b/.github/workflows/ast-fuzz.yaml @@ -0,0 +1,30 @@ +# Randomly change some code & ensure lint equivalency is maintained +on: + push: + branches: [main] + # TODO before merging: remove this. Only kept to demonstrate during review. + pull_request: + branches: [main] + +name: ast-fuzz + +jobs: + repo-meta-tests: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: "release" + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + + - name: Ensure equivalent code generates equivalent lints + run: | + callr::rscript(".dev/ast_fuzz_test.R") + shell: Rscript {0} From b8a06e39b3a9d6cbc8924fccc9143b2d945cdfe5 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 22:23:16 +0000 Subject: [PATCH 018/131] annotation --- .dev/ast_fuzz_test.R | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index d8a14ade7..e67dc0ecc 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -42,10 +42,23 @@ withr::defer({ pkgload::load_all() +# beware lazy eval: originally tried adding a withr::defer() in each iteration, but +# this effectively only runs the last 'defer' expression as the names are only +# evaluated at run-time. So instead keep track of all edits in this object. +# this approach to implementing 'nofuzz' feels painfully manual, but I couldn't +# figure out how else to get 'testthat' to give us what we need -- the failures +# object in the reporter is frustratingly inconsistent in whether the trace +# exists, and even if it does, we'd have to text-mangle to get the corresponding +# file names out. Also, the trace 'srcref' happens under keep.source=FALSE, +# so we lose any associated comments anyway. even that would not solve the issue +# of getting top-level exclusions done for 'nofuzz start|end' ranges, except +# maybe if it enabled us to reuse lintr's own exclude() system. +# therefore we take this approach: pass over the test suite first and comment out +# any tests/units that have been marked 'nofuzz'. restore later. test_restorations <- list() for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = TRUE)) { xml <- read_xml(xmlparsedata::xml_parse_data(parse(test_file, keep.source = TRUE))) - # parent::* to catch top-level comments (exprlist) + # parent::* to catch top-level comments (exprlist). matches one-line nofuzz and start/end ranges. nofuzz_lines <- xml_find_all(xml, "//COMMENT[contains(text(), 'nofuzz')]/parent::*") if (length(nofuzz_lines) == 0L) next @@ -54,6 +67,7 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = for (nofuzz_line in nofuzz_lines) { comments <- xml_find_all(nofuzz_line, "COMMENT[contains(text(), 'nofuzz')]") comment_text <- xml_text(comments) + # handle start/end ranges first. start_idx <- grep("nofuzz start", comment_text, fixed = TRUE) end_idx <- grep("nofuzz end", comment_text, fixed = TRUE) if (length(start_idx) != length(end_idx) || any(end_idx < start_idx)) { @@ -85,10 +99,18 @@ for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = } withr::defer(for (restoration in test_restorations) writeLines(restoration$lines, restoration$file)) +# for some reason, 'report <- test_dir(...)' did not work -- the resulting object is ~empty. +# even 'report <- test_local(...)', which does return an object, lacks any information about +# which tests failed (all reports are about successful or skipped tests). probably this is not +# the best approach but documentation was not very helpful. reporter <- testthat::SummaryReporter$new() testthat::test_local(reporter = reporter) failures <- reporter$failures$as_list() +# ignore any test that failed for expected reasons, e.g. some known lint metadata changes +# about line numbers or the contents of the line. this saves us having to pepper tons of +# 'nofuzz' comments throughout the suite, as well as getting around the difficulty of injecting +# 'expect_lint()' with new code to ignore these attributes (this latter we might explore later). valid_failure <- vapply( failures, function(failure) { From a3dbf278766af57ac7c007f98000a4fe45fd0ae8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 22:26:05 +0000 Subject: [PATCH 019/131] comment for future work --- .dev/maybe_fuzz_content.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index b805b865d..6a7849c39 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -14,6 +14,8 @@ maybe_fuzz_content <- function(file, lines) { new_file } +# we could also consider just passing any test where no fuzzing takes place, +# i.e. letting the other GHA handle whether unfuzzed tests pass as expected. fuzz_contents <- function(f) { # skip errors for e.g. Rmd files, and ignore warnings. # We could use get_source_expressions(), but with little benefit & much slower. From 5a22050b2ac38cb6346206f0860e4a6b2b88fcdf Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 22:30:33 +0000 Subject: [PATCH 020/131] vestigial --- R/expect_lint.R | 44 -------------------------------------------- 1 file changed, 44 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index 811dda0ea..6e1c9e630 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -166,47 +166,3 @@ require_testthat <- function() { ) } } -maybe_fuzz_content <- function(file, lines) { - new_file <- tempfile() - if (is.null(file)) { - con <- file(new_file, encoding = "UTF-8") - writeLines(lines, con = con, sep = "\n") - close(con) - } else { - file.copy(file, new_file, copy.mode = FALSE) - } - - fuzz_contents(new_file) - - new_file -} - -fuzz_contents <- function(f) { - pd <- getParseData(parse(f, keep.source = TRUE)) - - fun_tokens <- c("'\\\\'", "FUNCTION") - fun_idx <- which(pd$token %in% fun_tokens) - n_fun <- length(fun_idx) - - if (n_fun == 0L) { - return(invisible()) - } - - pd$new_token[fun_idx] <- sample(fun_tokens, length(fun_idx), replace = TRUE) - - l <- readLines(f) - - for (ii in rev(fun_idx)) { - if (pd$token[ii] == pd$new_token[ii]) next - browser() - ptn = paste0("^(.{", pd$col1 - 1L, "})") - } - - replacement_map <- c(FUNCTION = " \\", `'\\\\'` = "function") - start <- pd$col1[fun_idx] - substr(l[pd$line1[fun_idx]], start, start + nchar("function") - 1L) <- replacement_map[pd$token[fun_idx]] - - writeLines(l, f) - - invisible() -} From 76b869f8a5cbefbfbaebb7f4c8e20cc9e3ccd09d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:07:04 +0000 Subject: [PATCH 021/131] skips on old R --- tests/testthat/test-library_call_linter.R | 4 +++- tests/testthat/test-terminal_close_linter.R | 2 ++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-library_call_linter.R b/tests/testthat/test-library_call_linter.R index f43790b36..aca3427c0 100644 --- a/tests/testthat/test-library_call_linter.R +++ b/tests/testthat/test-library_call_linter.R @@ -220,8 +220,10 @@ test_that("skips allowed usages of library()/character.only=TRUE", { expect_no_lint("library(data.table)", linter) expect_no_lint("function(pkg) library(pkg, character.only = TRUE)", linter) - expect_no_lint("\\(pkg) library(pkg, character.only = TRUE)", linter) expect_no_lint("function(pkgs) sapply(pkgs, require, character.only = TRUE)", linter) + + skip_if_not_r_version("4.1.0") + expect_no_lint("\\(pkg) library(pkg, character.only = TRUE)", linter) expect_no_lint("\\(pkgs) sapply(pkgs, require, character.only = TRUE)", linter) }) diff --git a/tests/testthat/test-terminal_close_linter.R b/tests/testthat/test-terminal_close_linter.R index b20149005..2a3d23d1c 100644 --- a/tests/testthat/test-terminal_close_linter.R +++ b/tests/testthat/test-terminal_close_linter.R @@ -82,6 +82,8 @@ test_that("terminal_close_linter blocks simple cases", { }) test_that("lints vectorize", { + skip_if_not_r_version("4.1.0") + expect_lint( trim_some("{ foo <- function() { From afec7431fb0d922da21489c71bba10fbcfa09ecf Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:10:11 +0000 Subject: [PATCH 022/131] expect_no_lint --- .../testthat/test-unnecessary_lambda_linter.R | 96 +++++++++---------- 1 file changed, 47 insertions(+), 49 deletions(-) diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 9a9839bb9..d223fad89 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -1,80 +1,77 @@ test_that("unnecessary_lambda_linter skips allowed usages", { linter <- unnecessary_lambda_linter() - expect_lint("lapply(DF, sum)", NULL, linter) - expect_lint("apply(M, 1, sum, na.rm = TRUE)", NULL, linter) + expect_no_lint("lapply(DF, sum)", linter) + expect_no_lint("apply(M, 1, sum, na.rm = TRUE)", linter) # the first argument may be ... or have a cumbersome name, so an anonymous # function may be preferable (e.g. this is often the case for grep() calls) - expect_lint("sapply(x, function(xi) foo(1, xi))", NULL, linter) - expect_lint("sapply(x, function(xi) return(foo(1, xi)))", NULL, linter) + expect_no_lint("sapply(x, function(xi) foo(1, xi))", linter) + expect_no_lint("sapply(x, function(xi) return(foo(1, xi)))", linter) # if the argument is re-used, that's also a no-go - expect_lint("dendrapply(x, function(xi) foo(xi, xi))", NULL, linter) + expect_no_lint("dendrapply(x, function(xi) foo(xi, xi))", linter) # at any nesting level - expect_lint("parLapply(cl, x, function(xi) foo(xi, 2, bar(baz(xi))))", NULL, linter) + expect_no_lint("parLapply(cl, x, function(xi) foo(xi, 2, bar(baz(xi))))", linter) # multi-expression case - expect_lint("lapply(x, function(xi) { print(xi); xi^2 })", NULL, linter) + expect_no_lint("lapply(x, function(xi) { print(xi); xi^2 })", linter) # multi-expression, multi-line cases - expect_lint( + expect_no_lint( trim_some(" lapply(x, function(xi) { print(xi); xi^2 }) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" lapply(x, function(xi) { print(xi) xi^2 }) "), - NULL, linter ) # This _could_ be lapply(x, `%in%`, tbl), but don't force infix into lambda - expect_lint("lapply(x, function(xi) xi %in% tbl)", NULL, linter) + expect_no_lint("lapply(x, function(xi) xi %in% tbl)", linter) # This one could not - expect_lint("lapply(x, function(xi) tbl %in% xi)", NULL, linter) + expect_no_lint("lapply(x, function(xi) tbl %in% xi)", linter) # would require multiple lapply() loops - expect_lint("lapply(x, function(xi) foo(bar(xi)))", NULL, linter) - expect_lint("lapply(x, function(xi) return(foo(bar(xi))))", NULL, linter) + expect_no_lint("lapply(x, function(xi) foo(bar(xi)))", linter) + expect_no_lint("lapply(x, function(xi) return(foo(bar(xi))))", linter) # extractions, #2231 - expect_lint("lapply(l, function(x) rle(x)$values)", NULL, linter) - expect_lint('lapply(l, function(x) rle(x)["values"])', NULL, linter) - expect_lint('lapply(l, function(x) rle(x)[["values"]])', NULL, linter) - expect_lint("lapply(l, function(x) rle(x)@values)", NULL, linter) + expect_no_lint("lapply(l, function(x) rle(x)$values)", linter) + expect_no_lint('lapply(l, function(x) rle(x)["values"])', linter) + expect_no_lint('lapply(l, function(x) rle(x)[["values"]])', linter) + expect_no_lint("lapply(l, function(x) rle(x)@values)", linter) # return() extractions, #2258 - expect_lint("lapply(l, function(x) return(foo(x)$bar))", NULL, linter) - expect_lint('lapply(l, function(x) return(rle(x)["values"]))', NULL, linter) - expect_lint('lapply(l, function(x) return(rle(x)[["values"]]))', NULL, linter) - expect_lint("lapply(l, function(x) return(rle(x)@values))", NULL, linter) + expect_no_lint("lapply(l, function(x) return(foo(x)$bar))", linter) + expect_no_lint('lapply(l, function(x) return(rle(x)["values"]))', linter) + expect_no_lint('lapply(l, function(x) return(rle(x)[["values"]]))', linter) + expect_no_lint("lapply(l, function(x) return(rle(x)@values))", linter) # Other operators, #2247 - expect_lint("lapply(l, function(x) foo(x) - 1)", NULL, linter) - expect_lint("lapply(l, function(x) foo(x) * 2)", NULL, linter) - expect_lint("lapply(l, function(x) foo(x) ^ 3)", NULL, linter) - expect_lint("lapply(l, function(x) foo(x) %% 4)", NULL, linter) + expect_no_lint("lapply(l, function(x) foo(x) - 1)", linter) + expect_no_lint("lapply(l, function(x) foo(x) * 2)", linter) + expect_no_lint("lapply(l, function(x) foo(x) ^ 3)", linter) + expect_no_lint("lapply(l, function(x) foo(x) %% 4)", linter) # Don't include other lambdas, #2249 - expect_lint( + expect_no_lint( trim_some('{ lapply(x, function(e) sprintf("%o", e)) lapply(y, function(e) paste(strlpad(e, "0", width))) }'), - NULL, linter ) # only call is on RHS of operator, #2310 - expect_lint("lapply(l, function(x) 'a' %in% names(x))", NULL, linter) - expect_lint("lapply(l, function(x = 1) 'a' %in% names(x))", NULL, linter) + expect_no_lint("lapply(l, function(x) 'a' %in% names(x))", linter) + expect_no_lint("lapply(l, function(x = 1) 'a' %in% names(x))", linter) }) test_that("unnecessary_lambda_linter skips allowed inner comparisons", { @@ -82,13 +79,13 @@ test_that("unnecessary_lambda_linter skips allowed inner comparisons", { # lapply returns a list, so not the same, though as.list is probably # a better choice - expect_lint("lapply(x, function(xi) foo(xi) == 2)", NULL, linter) + expect_no_lint("lapply(x, function(xi) foo(xi) == 2)", linter) # this _may_ return a matrix, though outer is probably a better choice if so - expect_lint("sapply(x, function(xi) foo(xi) == y)", NULL, linter) + expect_no_lint("sapply(x, function(xi) foo(xi) == y)", linter) # only lint "plain" calls that can be replaced by eliminating the lambda - expect_lint("sapply(x, function(xi) sum(abs(xi)) == 0)", NULL, linter) + expect_no_lint("sapply(x, function(xi) sum(abs(xi)) == 0)", linter) }) test_that("unnecessary_lambda_linter blocks simple disallowed usage", { @@ -132,9 +129,9 @@ test_that("unnecessary_lambda_linter blocks simple disallowed usages", { expect_lint("sapply(x, function(xi) foo(xi) == 'a')", lint_msg, linter) expect_lint("sapply(x, function(xi) foo(xi) == 1 + 2i)", lint_msg, linter) - expect_lint("sapply(x, function(xi) foo(xi) == 2)", NULL, linter_allow) - expect_lint("sapply(x, function(xi) foo(xi) == 'a')", NULL, linter_allow) - expect_lint("sapply(x, function(xi) foo(xi) == 1 + 2i)", NULL, linter_allow) + expect_no_lint("sapply(x, function(xi) foo(xi) == 2)", linter_allow) + expect_no_lint("sapply(x, function(xi) foo(xi) == 'a')", linter_allow) + expect_no_lint("sapply(x, function(xi) foo(xi) == 1 + 2i)", linter_allow) # vapply counts as well # NB: we ignore the FUN.VALUE argument, for now @@ -154,22 +151,24 @@ test_that("unnecessary_lambda_linter blocks other comparators as well", { expect_lint("sapply(x, function(xi) foo(xi) != 'a')", lint_msg, linter) expect_lint("sapply(x, function(xi) foo(xi) < 1 + 2i)", lint_msg, linter) - expect_lint("sapply(x, function(xi) foo(xi) >= 2)", NULL, linter_allow) - expect_lint("sapply(x, function(xi) foo(xi) != 'a')", NULL, linter_allow) - expect_lint("sapply(x, function(xi) foo(xi) < 1 + 2i)", NULL, linter_allow) + expect_no_lint("sapply(x, function(xi) foo(xi) >= 2)", linter_allow) + expect_no_lint("sapply(x, function(xi) foo(xi) != 'a')", linter_allow) + expect_no_lint("sapply(x, function(xi) foo(xi) < 1 + 2i)", linter_allow) }) test_that("unnecessary_lambda_linter doesn't apply to keyword args", { - expect_lint("lapply(x, function(xi) data.frame(nm = xi))", NULL, unnecessary_lambda_linter()) - expect_lint("lapply(x, function(xi) return(data.frame(nm = xi)))", NULL, unnecessary_lambda_linter()) + linter <- unnecessary_lambda_linter() + + expect_no_lint("lapply(x, function(xi) data.frame(nm = xi))", linter) + expect_no_lint("lapply(x, function(xi) return(data.frame(nm = xi)))", linter) }) test_that("purrr-style anonymous functions are also caught", { linter <- unnecessary_lambda_linter() - expect_lint("purrr::map(x, ~.x)", NULL, linter) - expect_lint("purrr::map_df(x, ~lm(y, .x))", NULL, linter) - expect_lint("map_dbl(x, ~foo(bar = .x))", NULL, linter) + expect_no_lint("purrr::map(x, ~.x)", linter) + expect_no_lint("purrr::map_df(x, ~lm(y, .x))", linter) + expect_no_lint("map_dbl(x, ~foo(bar = .x))", linter) expect_lint( "purrr::map(x, ~foo(.x))", @@ -234,20 +233,19 @@ test_that("cases with braces are caught", { linter ) - expect_lint( + expect_no_lint( trim_some(" lapply(x, function(xi) { print(xi) xi }) "), - NULL, linter ) # false positives like #2231, #2247 are avoided with braces too - expect_lint("lapply(x, function(xi) { foo(xi)$bar })", NULL, linter) - expect_lint("lapply(x, function(xi) { foo(xi) - 1 })", NULL, linter) + expect_no_lint("lapply(x, function(xi) { foo(xi)$bar })", linter) + expect_no_lint("lapply(x, function(xi) { foo(xi) - 1 })", linter) }) test_that("function shorthand is handled", { From 51593e408237a1c9f74368bdd215c0e0cacdd4a9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:10:58 +0000 Subject: [PATCH 023/131] new tests --- tests/testthat/test-unnecessary_lambda_linter.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index d223fad89..00f70d284 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -256,6 +256,14 @@ test_that("function shorthand is handled", { rex::rex("Pass sum directly as a symbol to lapply()"), unnecessary_lambda_linter() ) + + expect_lint("sapply(x, \\(xi) foo(xi) == 2)", lint_msg, linter) + expect_lint("sapply(x, \\(xi) foo(xi) == 'a')", lint_msg, linter) + expect_lint("sapply(x, \\(xi) foo(xi) == 1 + 2i)", lint_msg, linter) + + expect_no_lint("sapply(x, \\(xi) foo(xi) == 2)", linter_allow) + expect_no_lint("sapply(x, \\(xi) foo(xi) == 'a')", linter_allow) + expect_no_lint("sapply(x, \\(xi) foo(xi) == 1 + 2i)", linter_allow) }) test_that("lints vectorize", { From f4b9481f3ac160f67dfbc4849ddb8d79f69d0a47 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:13:14 +0000 Subject: [PATCH 024/131] NEWS --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 661038ad7..8ea061062 100644 --- a/NEWS.md +++ b/NEWS.md @@ -53,6 +53,10 @@ ### Lint accuracy fixes: removing false negatives * `todo_comment_linter()` finds comments inside {roxygen2} markup comments (#2447, @MichaelChirico). +* Linters with logic around function declarations consistently include the R 4.0.0 shorthand `\()` (#2818, continuation of earlier #2190, @MichaelChirico). + + `library_call_linter()` + + `terminal_close_linter()` + + `unnecessary_lambda_linter()` ## Notes From 6389d5539ce55be4e3292b8c051f28b314568c5b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 15:20:39 -0800 Subject: [PATCH 025/131] bad copy-paste --- tests/testthat/test-unnecessary_lambda_linter.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 00f70d284..608421429 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -250,13 +250,16 @@ test_that("cases with braces are caught", { test_that("function shorthand is handled", { skip_if_not_r_version("4.1.0") - + linter <- unnecessary_lambda_linter() + linter_allow <- unnecessary_lambda_linter(allow_comparison = TRUE) + expect_lint( "lapply(DF, \\(x) sum(x))", rex::rex("Pass sum directly as a symbol to lapply()"), - unnecessary_lambda_linter() + linter ) + lint_msg <- rex::rex("Compare to a constant after calling sapply() to get", anything, "sapply(x, foo)") expect_lint("sapply(x, \\(xi) foo(xi) == 2)", lint_msg, linter) expect_lint("sapply(x, \\(xi) foo(xi) == 'a')", lint_msg, linter) expect_lint("sapply(x, \\(xi) foo(xi) == 1 + 2i)", lint_msg, linter) From 1550eadca280f3c25241d73a7ee6accddb2a817f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:36:51 +0000 Subject: [PATCH 026/131] need stop_on_failure for batch? --- .dev/ast_fuzz_test.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index e67dc0ecc..501a5b2cc 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -104,7 +104,7 @@ withr::defer(for (restoration in test_restorations) writeLines(restoration$lines # which tests failed (all reports are about successful or skipped tests). probably this is not # the best approach but documentation was not very helpful. reporter <- testthat::SummaryReporter$new() -testthat::test_local(reporter = reporter) +testthat::test_local(reporter = reporter, stop_on_failure = FALSE) failures <- reporter$failures$as_list() # ignore any test that failed for expected reasons, e.g. some known lint metadata changes From bbdac439e2818c5c32d151f27406f426de088abc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:50:21 +0000 Subject: [PATCH 027/131] delint, fix last skip for R<4.1.0 --- tests/testthat/test-terminal_close_linter.R | 9 +++++---- tests/testthat/test-unnecessary_lambda_linter.R | 2 +- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-terminal_close_linter.R b/tests/testthat/test-terminal_close_linter.R index 2a3d23d1c..2423745c5 100644 --- a/tests/testthat/test-terminal_close_linter.R +++ b/tests/testthat/test-terminal_close_linter.R @@ -20,17 +20,18 @@ test_that("terminal_close_linter skips allowed cases", { expect_no_lint(lines, linter) lines <- trim_some(" - foo <- \\(bar) { + foo <- function(bar) { close <- bar + 1 - return(close) + close } ") expect_no_lint(lines, linter) + skip_if_not_r_version("4.1.0") lines <- trim_some(" - foo <- function(bar) { + foo <- \\(bar) { close <- bar + 1 - close + return(close) } ") expect_no_lint(lines, linter) diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 608421429..44655b44b 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -252,7 +252,7 @@ test_that("function shorthand is handled", { skip_if_not_r_version("4.1.0") linter <- unnecessary_lambda_linter() linter_allow <- unnecessary_lambda_linter(allow_comparison = TRUE) - + expect_lint( "lapply(DF, \\(x) sum(x))", rex::rex("Pass sum directly as a symbol to lapply()"), From 523c21867fdd8afb6706bb00938943bb41e840f3 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 00:14:49 +0000 Subject: [PATCH 028/131] more extensible structure --- .dev/maybe_fuzz_content.R | 42 +++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 15 deletions(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 6a7849c39..3db32d7c1 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -9,21 +9,12 @@ maybe_fuzz_content <- function(file, lines) { file.copy(file, new_file, copy.mode = FALSE) } - fuzz_contents(new_file) + apply_fuzzers(new_file) new_file } -# we could also consider just passing any test where no fuzzing takes place, -# i.e. letting the other GHA handle whether unfuzzed tests pass as expected. -fuzz_contents <- function(f) { - # skip errors for e.g. Rmd files, and ignore warnings. - # We could use get_source_expressions(), but with little benefit & much slower. - pd <- tryCatch(getParseData(suppressWarnings(parse(f, keep.source = TRUE))), error = identity) - if (inherits(pd, "error")) { - return(invisible()) - } - +function_lambda_fuzzer <- function(pd, lines) { fun_tokens <- c(`'\\\\'` = "\\", `FUNCTION` = "function") fun_idx <- which(pd$token %in% names(fun_tokens)) n_fun <- length(fun_idx) @@ -35,16 +26,37 @@ fuzz_contents <- function(f) { pd$new_text <- NA_character_ pd$new_text[fun_idx] <- sample(fun_tokens, n_fun, replace = TRUE) - l <- readLines(f) - for (ii in rev(fun_idx)) { if (pd$text[ii] == pd$new_text[ii]) next # Tried, with all rex(), hit a bug: https://github.com/r-lib/rex/issues/96 ptn = paste0("^(.{", pd$col1[ii] - 1L, "})", rex::rex(pd$text[ii])) - l[pd$line1[ii]] <- rex::re_substitutes(l[pd$line1[ii]], ptn, paste0("\\1", rex::rex(pd$new_text[ii]))) + lines[pd$line1[ii]] <- rex::re_substitutes(lines[pd$line1[ii]], ptn, paste0("\\1", rex::rex(pd$new_text[ii]))) } + lines +} - writeLines(l, f) +# we could also consider just passing any test where no fuzzing takes place, +# i.e. letting the other GHA handle whether unfuzzed tests pass as expected. +apply_fuzzers <- function(f) { + # skip errors for e.g. Rmd files, and ignore warnings. + # We could use get_source_expressions(), but with little benefit & much slower. + pd <- tryCatch(getParseData(suppressWarnings(parse(f, keep.source = TRUE))), error = identity) + if (inherits(pd, "error")) { + return(invisible()) + } + + reparse <- FALSE + lines <- readLines(f) + for (fuzzer in list(function_lambda_fuzzer)) { + if (reparse) { + pd <- getParseData(parse(f, keep.source = TRUE)) + lines <- readLines(f) + } + updated_lines <- fuzzer(pd, lines) + reparse <- !is.null(updated_lines) + if (!reparse) next # skip some I/O if we can + writeLines(updated_lines, f) + } invisible() } From 852d0eafe2fdb9c1febb66dac52932467a457a9e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 00:33:52 +0000 Subject: [PATCH 029/131] expect_no_lint --- tests/testthat/test-brace_linter.R | 97 +++++++++++++----------------- 1 file changed, 43 insertions(+), 54 deletions(-) diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index 5bc8eb3dd..ec10d6f32 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -8,13 +8,13 @@ test_that("brace_linter lints braces correctly", { ) linter <- brace_linter() - expect_lint("blah", NULL, linter) - expect_lint("a <- function() {\n}", NULL, linter) - expect_lint("a <- function() { \n}", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("a <- function() {\n}", linter) + expect_no_lint("a <- function() { \n}", linter) expect_lint("a <- function() { 1 }", list(open_curly_msg, closed_curly_msg), linter) # allowed by allow_single_line - expect_lint("a <- function() { 1 }", NULL, brace_linter(allow_single_line = TRUE)) + expect_no_lint("a <- function() { 1 }", brace_linter(allow_single_line = TRUE)) expect_lint( trim_some(" @@ -51,30 +51,28 @@ test_that("brace_linter lints braces correctly", { ) # }) is allowed - expect_lint("eval(bquote({\n...\n}))", NULL, linter) + expect_no_lint("eval(bquote({\n...\n}))", linter) # }] is too - expect_lint("df[, {\n...\n}]", NULL, linter) + expect_no_lint("df[, {\n...\n}]", linter) # }, is allowed - expect_lint( + expect_no_lint( trim_some(" fun({ statements }, param)"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" fun(function(a) { statements }, param)"), - NULL, linter ) # ,<\n>{ is allowed - expect_lint( + expect_no_lint( trim_some(" switch( x, @@ -86,12 +84,11 @@ test_that("brace_linter lints braces correctly", { } ) "), - NULL, linter ) # a comment before ,<\n>{ is allowed - expect_lint( + expect_no_lint( trim_some(" switch( x, @@ -103,12 +100,11 @@ test_that("brace_linter lints braces correctly", { } ) "), - NULL, linter ) # a comment before <\n>{ is allowed - expect_lint( + expect_no_lint( trim_some(" switch(stat, o = { @@ -120,11 +116,10 @@ test_that("brace_linter lints braces correctly", { } ) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" fun( 'This is very very very long text.', @@ -134,12 +129,11 @@ test_that("brace_linter lints braces correctly", { } ) "), - NULL, linter ) # (\n{ is allowed optionally - expect_lint( + expect_no_lint( trim_some(" tryCatch( { @@ -149,14 +143,13 @@ test_that("brace_linter lints braces correctly", { } ) "), - NULL, linter ) # {{ }} is allowed - expect_lint("{{ x }}", NULL, linter) + expect_no_lint("{{ x }}", linter) - expect_lint( + expect_no_lint( trim_some(" pkg_name <- function(path = find_package()) { if (is.null(path)) { @@ -166,7 +159,6 @@ test_that("brace_linter lints braces correctly", { } } "), - NULL, linter ) @@ -185,13 +177,12 @@ test_that("brace_linter lints braces correctly", { expect_lint("a <- function()\n\t{\n 1 \n}", open_curly_msg, linter) # trailing comments are allowed - expect_lint( + expect_no_lint( trim_some(' if ("P" != "NP") { # what most people expect print("Cryptomania is possible") } '), - NULL, linter ) }) @@ -236,10 +227,9 @@ test_that("brace_linter lints spaces before open braces", { ) # should ignore strings and comments, as in regexes: - expect_lint("grepl('(iss){2}', 'Mississippi')", NULL, linter) - expect_lint( + expect_no_lint("grepl('(iss){2}', 'Mississippi')", linter) + expect_no_lint( "x <- 123 # don't flag (paren){brace} if inside a comment", - NULL, linter ) # should not be thrown when the brace lies on subsequent line @@ -258,8 +248,8 @@ test_that("brace_linter lints spaces before open braces", { test_that("brace_linter lints else correctly", { linter <- brace_linter() - expect_lint("if (TRUE) 1 else 2", NULL, linter) - expect_lint("if (TRUE) 1", NULL, linter) + expect_no_lint("if (TRUE) 1 else 2", linter) + expect_no_lint("if (TRUE) 1", linter) lines_brace <- trim_some(" if (TRUE) { @@ -268,7 +258,7 @@ test_that("brace_linter lints else correctly", { 2 } ") - expect_lint(lines_brace, NULL, linter) + expect_no_lint(lines_brace, linter) # such usage is also not allowed by the style guide, but test anyway lines_unbrace <- trim_some(" @@ -279,7 +269,7 @@ test_that("brace_linter lints else correctly", { 2 } ") - expect_lint(lines_unbrace, NULL, linter) + expect_no_lint(lines_unbrace, linter) lines <- trim_some(" foo <- function(x) { @@ -380,8 +370,8 @@ test_that("brace_linter lints function expressions correctly", { test_that("brace_linter lints if/else matching braces correctly", { linter <- brace_linter() - expect_lint("if (TRUE) 1 else 2", NULL, linter) - expect_lint("if (TRUE) 1", NULL, linter) + expect_no_lint("if (TRUE) 1 else 2", linter) + expect_no_lint("if (TRUE) 1", linter) lines_brace <- trim_some(" if (TRUE) { @@ -390,7 +380,7 @@ test_that("brace_linter lints if/else matching braces correctly", { 2 } ") - expect_lint(lines_brace, NULL, linter) + expect_no_lint(lines_brace, linter) # such usage is also not allowed by the style guide, but test anyway lines_unbrace <- trim_some(" @@ -401,7 +391,7 @@ test_that("brace_linter lints if/else matching braces correctly", { 2 } ") - expect_lint(lines_unbrace, NULL, linter) + expect_no_lint(lines_unbrace, linter) # else if is OK lines_else_if <- trim_some(" @@ -413,7 +403,7 @@ test_that("brace_linter lints if/else matching braces correctly", { 3 } ") - expect_lint(lines_else_if, NULL, linter) + expect_no_lint(lines_else_if, linter) lines_if <- trim_some(" foo <- function(x) { @@ -444,13 +434,17 @@ test_that("brace_linter lints if/else matching braces correctly", { # Keep up to date with https://github.com/tidyverse/style/issues/191 test_that("empty brace expressions are always allowed inline", { - expect_lint("while (FALSE) {}", NULL, brace_linter()) - expect_lint("while (FALSE) { }", NULL, brace_linter()) + linter <- brace_linter() + linter_allow <- brace_linter(allow_single_line = TRUE) + lint_msg <- rex::rex("Opening curly braces") + + expect_no_lint("while (FALSE) {}", linter) + expect_no_lint("while (FALSE) { }", linter) # only applies when `{` is "attached" to the preceding token on the same line - expect_lint("while (FALSE)\n{}", rex::rex("Opening curly braces"), brace_linter()) - expect_lint("while (FALSE)\n{ }", rex::rex("Opening curly braces"), brace_linter()) - expect_lint("while (FALSE) {}", NULL, brace_linter(allow_single_line = TRUE)) - expect_lint("while (FALSE) { }", NULL, brace_linter(allow_single_line = TRUE)) + expect_lint("while (FALSE)\n{}", lint_msg, linter) + expect_lint("while (FALSE)\n{ }", lint_msg, linter) + expect_no_lint("while (FALSE) {}", linter_allow) + expect_no_lint("while (FALSE) { }", linter_allow) }) test_that("formula syntax is linted properly", { @@ -458,7 +452,7 @@ test_that("formula syntax is linted properly", { lint_msg_open <- rex::rex("Opening curly braces should never go on their own line") lint_msg_closed <- rex::rex("Closing curly-braces should always be on their own line") - expect_lint( + expect_no_lint( trim_some(" map( .x = 1:4, @@ -466,7 +460,6 @@ test_that("formula syntax is linted properly", { .x + 1 } )"), - NULL, linter ) @@ -515,35 +508,32 @@ test_that("code with pipes is handled correctly", { lint_msg_open <- rex::rex("Opening curly braces should never go on their own line") lint_msg_closed <- rex::rex("Closing curly-braces should always be on their own line") - expect_lint( + expect_no_lint( trim_some(" out <- lapply(stuff, function(i) { do_something(i) }) %>% unlist "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" 1:4 %!>% { sum(.) } "), - NULL, linter ) # %>%\n{ is allowed - expect_lint( + expect_no_lint( trim_some(" 1:4 %T>% { sum(.) } "), - NULL, linter ) @@ -592,13 +582,12 @@ test_that("code with pipes is handled correctly", { skip_if_not_r_version("4.1.0") - expect_lint( + expect_no_lint( trim_some(" out <- lapply(stuff, function(i) { do_something(i) }) |> unlist() "), - NULL, linter ) @@ -615,7 +604,7 @@ test_that("function shorthand is treated like 'full' function", { skip_if_not_r_version("4.1.0") linter <- brace_linter() - expect_lint("a <- \\() { \n}", NULL, linter) + expect_no_lint("a <- \\() { \n}", linter) expect_lint( trim_some(" x <- \\() From 3eb21ca307d7e059073b823d57e8fb24b09590b7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 01:07:17 +0000 Subject: [PATCH 030/131] progress, incl. many 'nofuzz' & 'no_lint' --- .dev/ast_fuzz_test.R | 4 +- .dev/maybe_fuzz_content.R | 43 ++++--- tests/testthat/test-brace_linter.R | 2 +- .../test-implicit_assignment_linter.R | 121 ++++++++---------- tests/testthat/test-infix_spaces_linter.R | 81 ++++++------ tests/testthat/test-one_call_pipe_linter.R | 32 ++--- tests/testthat/test-pipe_call_linter.R | 20 +-- tests/testthat/test-pipe_consistency_linter.R | 22 ++-- .../testthat/test-pipe_continuation_linter.R | 31 +++-- tests/testthat/test-pipe_return_linter.R | 8 +- tests/testthat/test-return_linter.R | 2 + .../test-unnecessary_placeholder_linter.R | 12 +- tests/testthat/test-unused_import_linter.R | 30 +++-- 13 files changed, 205 insertions(+), 203 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 501a5b2cc..d72b4279c 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -54,7 +54,9 @@ pkgload::load_all() # of getting top-level exclusions done for 'nofuzz start|end' ranges, except # maybe if it enabled us to reuse lintr's own exclude() system. # therefore we take this approach: pass over the test suite first and comment out -# any tests/units that have been marked 'nofuzz'. restore later. +# any tests/units that have been marked 'nofuzz'. restore later. one consequence +# is there's no support for fuzzer-specific exclusion, e.g. we fully disable +# the unnecessary_placeholder_linter() tests because |> and _ placeholders differ. test_restorations <- list() for (test_file in list.files("tests/testthat", pattern = "^test-", full.names = TRUE)) { xml <- read_xml(xmlparsedata::xml_parse_data(parse(test_file, keep.source = TRUE))) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 3db32d7c1..e60ab4655 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -14,27 +14,38 @@ maybe_fuzz_content <- function(file, lines) { new_file } -function_lambda_fuzzer <- function(pd, lines) { - fun_tokens <- c(`'\\\\'` = "\\", `FUNCTION` = "function") - fun_idx <- which(pd$token %in% names(fun_tokens)) - n_fun <- length(fun_idx) +simple_swap_fuzzer <- function(pd_filter, replacements) { + function(pd, lines) { + idx <- which(pd_filter(pd)) + n <- length(idx) - if (n_fun == 0L) { - return(invisible()) - } + if (n == 0L) { + return(invisible()) + } - pd$new_text <- NA_character_ - pd$new_text[fun_idx] <- sample(fun_tokens, n_fun, replace = TRUE) + pd$new_text <- NA_character_ + pd$new_text[idx] <- sample(replacements, n, replace = TRUE) - for (ii in rev(fun_idx)) { - if (pd$text[ii] == pd$new_text[ii]) next - # Tried, with all rex(), hit a bug: https://github.com/r-lib/rex/issues/96 - ptn = paste0("^(.{", pd$col1[ii] - 1L, "})", rex::rex(pd$text[ii])) - lines[pd$line1[ii]] <- rex::re_substitutes(lines[pd$line1[ii]], ptn, paste0("\\1", rex::rex(pd$new_text[ii]))) + for (ii in rev(idx)) { + if (pd$text[ii] == pd$new_text[ii]) next + # Tried, with all rex(), hit a bug: https://github.com/r-lib/rex/issues/96 + ptn = paste0("^(.{", pd$col1[ii] - 1L, "})", rex::rex(pd$text[ii])) + lines[pd$line1[ii]] <- rex::re_substitutes(lines[pd$line1[ii]], ptn, paste0("\\1", rex::rex(pd$new_text[ii]))) + } + lines } - lines } +function_lambda_fuzzer <- simple_swap_fuzzer( + \(pd) pd$token %in% c("'\\\\'", "FUNCTION"), + replacements = c("\\", "function") +) + +pipe_fuzzer <- simple_swap_fuzzer( + \(pd) (pd$token == "SPECIAL" & pd$text == "%>%") | pd$token == "PIPE", + replacements = c("%>%", "|>") +) + # we could also consider just passing any test where no fuzzing takes place, # i.e. letting the other GHA handle whether unfuzzed tests pass as expected. apply_fuzzers <- function(f) { @@ -47,7 +58,7 @@ apply_fuzzers <- function(f) { reparse <- FALSE lines <- readLines(f) - for (fuzzer in list(function_lambda_fuzzer)) { + for (fuzzer in list(function_lambda_fuzzer, pipe_fuzzer)) { if (reparse) { pd <- getParseData(parse(f, keep.source = TRUE)) lines <- readLines(f) diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index ec10d6f32..0d0532f8e 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -512,7 +512,7 @@ test_that("code with pipes is handled correctly", { trim_some(" out <- lapply(stuff, function(i) { do_something(i) - }) %>% unlist + }) %>% unlist() "), linter ) diff --git a/tests/testthat/test-implicit_assignment_linter.R b/tests/testthat/test-implicit_assignment_linter.R index 5457cb441..91ab4de64 100644 --- a/tests/testthat/test-implicit_assignment_linter.R +++ b/tests/testthat/test-implicit_assignment_linter.R @@ -1,83 +1,76 @@ test_that("implicit_assignment_linter skips allowed usages", { linter <- implicit_assignment_linter() - expect_lint("x <- 1L", NULL, linter) - expect_lint("1L -> x", NULL, linter) - expect_lint("x <<- 1L", NULL, linter) - expect_lint("1L ->> x", NULL, linter) - expect_lint("y <- if (is.null(x)) z else x", NULL, linter) - expect_lint("for (x in 1:10) x <- x + 1", NULL, linter) + expect_no_lint("x <- 1L", linter) + expect_no_lint("1L -> x", linter) + expect_no_lint("x <<- 1L", linter) + expect_no_lint("1L ->> x", linter) + expect_no_lint("y <- if (is.null(x)) z else x", linter) + expect_no_lint("for (x in 1:10) x <- x + 1", linter) - expect_lint("abc <- mean(1:4)", NULL, linter) - expect_lint("mean(1:4) -> abc", NULL, linter) + expect_no_lint("abc <- mean(1:4)", linter) + expect_no_lint("mean(1:4) -> abc", linter) - expect_lint( + expect_no_lint( trim_some(" x <- 1:4 mean(x)"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" x <- 1L if (x) TRUE"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" 0L -> abc while (abc) { FALSE }"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" if (x > 20L) { x <- x / 2.0 }"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" i <- 1 while (i < 6L) { print(i) i <- i + 1 }"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { x <- x + 1 return(x) }"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" f <- function() { p <- g() p <- if (is.null(p)) x else p }"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" map( .x = 1:4, @@ -86,42 +79,37 @@ test_that("implicit_assignment_linter skips allowed usages", { x } )"), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" lapply(1:4, function(x) { x <- x + 1 x })"), - NULL, linter ) skip_if_not_r_version("4.1.0") - expect_lint( + expect_no_lint( trim_some(" map(1:4, \\(x) { x <- x + 1 x })"), - NULL, linter ) }) test_that("implicit_assignment_linter respects except argument", { - expect_lint( + expect_no_lint( "local({ a <- 1L })", - NULL, implicit_assignment_linter(except = NULL) ) - expect_lint( + expect_no_lint( "local({ a <- 1L })", - NULL, implicit_assignment_linter(except = character(0L)) ) @@ -137,9 +125,8 @@ test_that("implicit_assignment_linter respects except argument", { implicit_assignment_linter(except = NULL) ) - expect_lint( + expect_no_lint( "local(a <- 1L)", - NULL, implicit_assignment_linter(except = "local") ) }) @@ -147,58 +134,52 @@ test_that("implicit_assignment_linter respects except argument", { test_that("implicit_assignment_linter skips allowed usages with braces", { linter <- implicit_assignment_linter(except = character(0L)) - expect_lint( + expect_no_lint( trim_some(" foo({ a <- 1L }) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" output <- capture.output({ x <- f() }) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" quote({ a <- 1L }) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" bquote({ a <- 1L }) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" expression({ a <- 1L }) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" local({ a <- 1L }) "), - NULL, linter ) }) @@ -206,20 +187,19 @@ test_that("implicit_assignment_linter skips allowed usages with braces", { test_that("implicit_assignment_linter makes exceptions for functions that capture side-effects", { linter <- implicit_assignment_linter() - expect_lint( + expect_no_lint( trim_some(" test_that('my test', { a <- 1L expect_equal(a, 1L) })"), - NULL, linter ) # rlang - expect_lint("expr(a <- 1L)", NULL, linter) - expect_lint("quo(a <- 1L)", NULL, linter) - expect_lint("quos(a <- 1L)", NULL, linter) + expect_no_lint("expr(a <- 1L)", linter) + expect_no_lint("quo(a <- 1L)", linter) + expect_no_lint("quos(a <- 1L)", linter) }) test_that("implicit_assignment_linter blocks disallowed usages in simple conditional statements", { @@ -335,15 +315,18 @@ test_that("implicit_assignment_linter blocks disallowed usages in function calls test_that("implicit_assignment_linter works as expected with pipes and walrus operator", { linter <- implicit_assignment_linter() - expect_lint("data %>% mutate(a := b)", NULL, linter) - expect_lint("dt %>% .[, z := x + y]", NULL, linter) - expect_lint("data %<>% mutate(a := b)", NULL, linter) + expect_no_lint("data %>% mutate(a := b)", linter) + expect_no_lint( # nofuzz + "dt %>% .[, z := x + y]", + linter + ) + expect_no_lint("data %<>% mutate(a := b)", linter) - expect_lint("DT[i, x := i]", NULL, linter) + expect_no_lint("DT[i, x := i]", linter) skip_if_not_r_version("4.1.0") - expect_lint("data |> mutate(a := b)", NULL, linter) + expect_no_lint("data |> mutate(a := b)", linter) }) test_that("parenthetical assignments are caught", { @@ -358,21 +341,21 @@ test_that("allow_lazy lets lazy assignments through", { linter <- implicit_assignment_linter(allow_lazy = TRUE) lint_message <- rex::rex("Avoid implicit assignments in function calls.") - expect_lint("A && (B <- foo(A))", NULL, linter) + expect_no_lint("A && (B <- foo(A))", linter) # || also admits laziness - expect_lint("A || (B <- foo(A))", NULL, linter) + expect_no_lint("A || (B <- foo(A))", linter) # & and |, however, do not expect_lint("A & (B <- foo(A))", lint_message, linter) expect_lint("A | (B <- foo(A))", lint_message, linter) - expect_lint("A && foo(bar(idx <- baz()))", NULL, linter) + expect_no_lint("A && foo(bar(idx <- baz()))", linter) # LHS _is_ linted expect_lint("(A <- foo()) && B", lint_message, linter) # however we skip on _any_ RHS (even if it's later an LHS) # test on all &&/|| combinations to stress test operator precedence - expect_lint("A && (B <- foo(A)) && C", NULL, linter) - expect_lint("A && (B <- foo(A)) || C", NULL, linter) - expect_lint("A || (B <- foo(A)) && C", NULL, linter) - expect_lint("A || (B <- foo(A)) || C", NULL, linter) + expect_no_lint("A && (B <- foo(A)) && C", linter) + expect_no_lint("A && (B <- foo(A)) || C", linter) + expect_no_lint("A || (B <- foo(A)) && C", linter) + expect_no_lint("A || (B <- foo(A)) || C", linter) # &&/|| elsewhere in the tree don't matter expect_lint( trim_some(" @@ -388,13 +371,12 @@ test_that("allow_scoped skips scoped assignments", { linter <- implicit_assignment_linter(allow_scoped = TRUE) lint_message <- rex::rex("Avoid implicit assignments in function calls.") - expect_lint( + expect_no_lint( trim_some(" if (any(idx <- x < 0)) { stop('negative elements: ', toString(which(idx))) } "), - NULL, linter ) expect_lint( @@ -418,12 +400,11 @@ test_that("allow_scoped skips scoped assignments", { linter ) - expect_lint( + expect_no_lint( trim_some(" obj <- letters while ((n <- length(obj)) > 0) obj <- obj[-n] "), - NULL, linter ) expect_lint( @@ -446,13 +427,12 @@ test_that("allow_scoped skips scoped assignments", { test_that("interaction of allow_lazy and allow_scoped", { linter <- implicit_assignment_linter(allow_scoped = TRUE, allow_lazy = TRUE) - expect_lint( + expect_nl_lint( trim_some(" if (any(idx <- foo()) && BB) { stop('Invalid foo() output: ', toString(idx)) } "), - NULL, linter ) expect_lint( @@ -465,14 +445,13 @@ test_that("interaction of allow_lazy and allow_scoped", { rex::rex("Avoid implicit assignments in function calls."), linter ) - expect_lint( + expect_no_lint( trim_some(" if (AA && any(idx <- foo())) { stop('Invalid foo() output: ', toString(idx)) } print(format(idx)) # NB: bad code! idx may not exist. "), - NULL, linter ) }) diff --git a/tests/testthat/test-infix_spaces_linter.R b/tests/testthat/test-infix_spaces_linter.R index ade7969c0..7b73411e7 100644 --- a/tests/testthat/test-infix_spaces_linter.R +++ b/tests/testthat/test-infix_spaces_linter.R @@ -31,28 +31,32 @@ test_that("returns the correct linting", { linter <- infix_spaces_linter() lint_msg <- rex::rex("Put spaces around all infix operators.") - expect_lint("blah", NULL, linter) + expect_no_lint("blah", linter) for (op in ops) { - expect_lint(paste0("1 ", op, " 2"), NULL, linter) - expect_lint(paste0("1 ", op, "\n2"), NULL, linter) - expect_lint(paste0("1 ", op, "\n 2"), NULL, linter) + expect_no_lint(paste0("1 ", op, " 2"), linter) + expect_no_lint(paste0("1 ", op, "\n2"), linter) + expect_no_lint(paste0("1 ", op, "\n 2"), linter) - expect_lint(paste0("1", op, "2"), lint_msg, linter) + expect_lint( # nofuzz + paste0("1", op, "2"), + lint_msg, + linter + ) # unary plus and minus can have no space before them if (!op %in% ops[1L:2L]) { - expect_lint(paste0("1 ", op, "2"), lint_msg, linter) + expect_lint(paste0("1 ", op, "2"), lint_msg, linter) # nofuzz } expect_lint(paste0("1", op, " 2"), lint_msg, linter) } - expect_lint("b <- 2E+4", NULL, linter) - expect_lint("a <- 1e-3", NULL, linter) - expect_lint("a[-1]", NULL, linter) - expect_lint("a[-1 + 1]", NULL, linter) - expect_lint("a[1 + -1]", NULL, linter) + expect_no_lint("b <- 2E+4", linter) + expect_no_lint("a <- 1e-3", linter) + expect_no_lint("a[-1]", linter) + expect_no_lint("a[-1 + 1]", linter) + expect_no_lint("a[1 + -1]", linter) expect_lint("fun(a=1)", lint_msg, linter) }) @@ -72,26 +76,25 @@ test_that("The three `=` are all linted", { test_that("exclude_operators works", { lint_msg <- rex::rex("Put spaces around all infix operators.") - expect_lint("a+b", NULL, infix_spaces_linter(exclude_operators = "+")) - expect_lint( + expect_no_lint("a+b", infix_spaces_linter(exclude_operators = "+")) + expect_no_lint( trim_some(" a+b a-b "), - NULL, infix_spaces_linter(exclude_operators = c("+", "-")) ) # operators match on text, not hidden node expect_lint("a<<-1", lint_msg, infix_spaces_linter(exclude_operators = "<-")) - expect_lint("a<<-1", NULL, infix_spaces_linter(exclude_operators = "<<-")) + expect_no_lint("a<<-1", infix_spaces_linter(exclude_operators = "<<-")) expect_lint("a:=1", lint_msg, infix_spaces_linter(exclude_operators = "<-")) - expect_lint("a:=1", NULL, infix_spaces_linter(exclude_operators = ":=")) + expect_no_lint("a:=1", infix_spaces_linter(exclude_operators = ":=")) expect_lint("a->>1", lint_msg, infix_spaces_linter(exclude_operators = "->")) - expect_lint("a->>1", NULL, infix_spaces_linter(exclude_operators = "->>")) - expect_lint("a%any%1", NULL, infix_spaces_linter(exclude_operators = "%%")) - expect_lint("function(a=1) { }", NULL, infix_spaces_linter(exclude_operators = "=")) - expect_lint("foo(a=1)", NULL, infix_spaces_linter(exclude_operators = "=")) + expect_no_lint("a->>1", infix_spaces_linter(exclude_operators = "->>")) + expect_no_lint("a%any%1", infix_spaces_linter(exclude_operators = "%%")) + expect_no_lint("function(a=1) { }", infix_spaces_linter(exclude_operators = "=")) + expect_no_lint("foo(a=1)", infix_spaces_linter(exclude_operators = "=")) }) # more tests specifically for assignment @@ -99,23 +102,22 @@ test_that("assignment cases return the correct linting", { linter <- infix_spaces_linter() lint_msg <- rex::rex("Put spaces around all infix operators.") - expect_lint("fun(blah = 1)", NULL, linter) + expect_no_lint("fun(blah = 1)", linter) - expect_lint("blah <- 1", NULL, linter) - expect_lint("blah = 1", NULL, linter) + expect_no_lint("blah <- 1", linter) + expect_no_lint("blah = 1", linter) - expect_lint("\"my = variable\" <- 42.0", NULL, linter) + expect_no_lint("\"my = variable\" <- 42.0", linter) - expect_lint("if (0 < 1) x <- 42L", NULL, linter) - expect_lint( + expect_no_lint("if (0 < 1) x <- 42L", linter) + expect_no_lint( trim_some(" if (0 < 1) { x <- 42L }"), - NULL, linter ) - expect_lint("my = bad = variable = name <- 2.0", NULL, linter) + expect_no_lint("my = bad = variable = name <- 2.0", linter) expect_lint("blah<- 1", lint_msg, linter) expect_lint("blah <-1", lint_msg, linter) @@ -135,9 +137,9 @@ test_that("infix_spaces_linter can allow >1 spaces optionally", { test_that("exception for box::use()", { linter <- infix_spaces_linter() - expect_lint("box::use(a/b)", NULL, linter) - expect_lint("box::use(./a/b)", NULL, linter) - expect_lint( + expect_no_lint("box::use(a/b)", linter) + expect_no_lint("box::use(./a/b)", linter) + expect_no_lint( trim_some(" box::use( a, @@ -146,7 +148,6 @@ test_that("exception for box::use()", { alias = a/b/c[xyz = abc, ...], ) "), - NULL, linter ) }) @@ -167,8 +168,8 @@ test_that("Rules around missing arguments are respected", { linter <- infix_spaces_linter() lint_msg <- rex::rex("Put spaces around all infix operators.") - expect_lint("switch(a = , b = 2)", NULL, linter) - expect_lint("alist(missing_arg = )", NULL, linter) + expect_no_lint("switch(a = , b = 2)", linter) + expect_no_lint("alist(missing_arg = )", linter) expect_lint("switch(a =, b = 2)", lint_msg, linter) expect_lint("alist(missing_arg =)", lint_msg, linter) @@ -178,7 +179,7 @@ test_that("native pipe is supported", { skip_if_not_r_version("4.1.0") linter <- infix_spaces_linter() - expect_lint("a |> foo()", NULL, linter) + expect_no_lint("a |> foo()", linter) expect_lint("a|>foo()", rex::rex("Put spaces around all infix operators."), linter) }) @@ -194,19 +195,19 @@ test_that("mixed unary & binary operators aren't mis-lint", { }) test_that("parse tags are accepted by exclude_operators", { - expect_lint("sum(x, na.rm=TRUE)", NULL, infix_spaces_linter(exclude_operators = "EQ_SUB")) - expect_lint("function(x, na.rm=TRUE) { }", NULL, infix_spaces_linter(exclude_operators = "EQ_FORMALS")) - expect_lint("x=1", NULL, infix_spaces_linter(exclude_operators = "EQ_ASSIGN")) + expect_no_lint("sum(x, na.rm=TRUE)", infix_spaces_linter(exclude_operators = "EQ_SUB")) + expect_no_lint("function(x, na.rm=TRUE) { }", infix_spaces_linter(exclude_operators = "EQ_FORMALS")) + expect_no_lint("x=1", infix_spaces_linter(exclude_operators = "EQ_ASSIGN")) # uses parse_tag - expect_lint("1+1", NULL, infix_spaces_linter(exclude_operators = "'+'")) + expect_no_lint("1+1", infix_spaces_linter(exclude_operators = "'+'")) # mixing text <- "x=function(a=foo(bar=1)) { }" col_assign <- list(column_number = 2L) col_formals <- list(column_number = 13L) col_sub <- list(column_number = 21L) - expect_lint(text, NULL, infix_spaces_linter(exclude_operators = c("EQ_SUB", "EQ_FORMALS", "EQ_ASSIGN"))) + expect_no_lint(text, infix_spaces_linter(exclude_operators = c("EQ_SUB", "EQ_FORMALS", "EQ_ASSIGN"))) expect_lint(text, col_assign, infix_spaces_linter(exclude_operators = c("EQ_SUB", "EQ_FORMALS"))) expect_lint(text, col_formals, infix_spaces_linter(exclude_operators = c("EQ_SUB", "EQ_ASSIGN"))) expect_lint(text, col_sub, infix_spaces_linter(exclude_operators = c("EQ_FORMALS", "EQ_ASSIGN"))) diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index 9a1a84975..654202237 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -2,14 +2,14 @@ test_that("one_call_pipe_linter skips allowed usages", { linter <- one_call_pipe_linter() # two pipe steps is OK - expect_lint("x %>% foo() %>% bar()", NULL, linter) + expect_no_lint("x %>% foo() %>% bar()", linter) # call in first step --> OK - expect_lint("foo(x) %>% bar()", NULL, linter) + expect_no_lint("foo(x) %>% bar()", linter) # both calls in second step --> OK - expect_lint("x %>% foo(bar(.))", NULL, linter) + expect_no_lint("x %>% foo(bar(.))", linter) # assignment pipe is exempted - expect_lint("x %<>% as.character()", NULL, linter) + expect_no_lint("x %<>% as.character()", linter) }) test_that("one_call_pipe_linter blocks simple disallowed usages", { @@ -25,33 +25,31 @@ test_that("one_call_pipe_linter blocks simple disallowed usages", { expect_lint("x %>% inner_join(y %>% filter(is_treatment))", lint_msg, linter) }) +# nofuzz start test_that("one_call_pipe_linter skips data.table chains", { linter <- one_call_pipe_linter() lint_msg <- rex::rex("Avoid pipe %>% for expressions with only a single call.") - expect_lint("DT[x > 5, sum(y), by = keys] %>% .[, .SD[1], by = key1]", NULL, linter) + expect_no_lint("DT[x > 5, sum(y), by = keys] %>% .[, .SD[1], by = key1]", linter) # lint here: instead of a pipe, use DT[x > 5, sum(y), by = keys] expect_lint("DT %>% .[x > 5, sum(y), by = keys]", lint_msg, linter) # ditto for [[ - expect_lint("DT %>% rowSums() %>% .[[idx]]", NULL, linter) + expect_no_lint("DT %>% rowSums() %>% .[[idx]]", linter) expect_lint("DT %>% .[[idx]]", lint_msg, linter) }) +# nofuzz end test_that("one_call_pipe_linter treats all pipes equally", { linter <- one_call_pipe_linter() lint_msg_part <- " for expressions with only a single call." - expect_lint("foo %>% bar() %$% col", NULL, linter) + expect_no_lint("foo %>% bar() %$% col", linter) expect_lint("x %T>% foo()", rex::rex("%T>%", lint_msg_part), linter) expect_lint("x %$%\n foo", rex::rex("%$%", lint_msg_part), linter) - expect_lint( - 'data %>% filter(type == "console") %$% obscured_id %>% unique()', - NULL, - linter - ) + expect_no_lint('data %>% filter(type == "console") %$% obscured_id %>% unique()', linter) }) test_that("multiple lints are generated correctly", { @@ -83,8 +81,8 @@ test_that("Native pipes are handled as well", { ) # mixed pipes - expect_lint("x |> foo() %>% bar()", NULL, linter) - expect_lint("x %>% foo() |> bar()", NULL, linter) + expect_no_lint("x |> foo() %>% bar()", linter) + expect_no_lint("x %>% foo() |> bar()", linter) expect_lint( trim_some("{ @@ -99,19 +97,21 @@ test_that("Native pipes are handled as well", { ) }) +# nofuzz start test_that("one_call_pipe_linter skips data.table chains with native pipe", { skip_if_not_r_version("4.3.0") linter <- one_call_pipe_linter() lint_msg <- rex::rex("Avoid pipe |> for expressions with only a single call.") - expect_lint("DT[x > 5, sum(y), by = keys] |> _[, .SD[1], by = key1]", NULL, linter) + expect_no_lint("DT[x > 5, sum(y), by = keys] |> _[, .SD[1], by = key1]", linter) # lint here: instead of a pipe, use DT[x > 5, sum(y), by = keys] expect_lint("DT |> _[x > 5, sum(y), by = keys]", lint_msg, linter) # ditto for [[ - expect_lint("DT |> rowSums() |> _[[idx]]", NULL, linter) + expect_no_lint("DT |> rowSums() |> _[[idx]]", linter) expect_lint("DT |> _[[idx]]", lint_msg, linter) }) +# nofuzz end diff --git a/tests/testthat/test-pipe_call_linter.R b/tests/testthat/test-pipe_call_linter.R index 96cf2036e..7e389878e 100644 --- a/tests/testthat/test-pipe_call_linter.R +++ b/tests/testthat/test-pipe_call_linter.R @@ -1,10 +1,11 @@ +# nofuzz start test_that("pipe_call_linter skips allowed usages", { linter <- pipe_call_linter() - expect_lint("a %>% foo()", NULL, linter) - expect_lint("a %>% foo(x)", NULL, linter) - expect_lint("b %>% { foo(., ., .) }", NULL, linter) - expect_lint("a %>% foo() %>% bar()", NULL, linter) + expect_no_lint("a %>% foo()", linter) + expect_no_lint("a %>% foo(x)", linter) + expect_no_lint("b %>% { foo(., ., .) }", linter) + expect_no_lint("a %>% foo() %>% bar()", linter) # ensure it works across lines too lines <- trim_some(" @@ -12,10 +13,10 @@ test_that("pipe_call_linter skips allowed usages", { foo() %>% bar() ") - expect_lint(lines, NULL, linter) + expect_no_lint(lines, linter) # symbol extraction is OK (don't force extract2(), e.g.) - expect_lint("a %>% .$y %>% mean()", NULL, linter) + expect_no_lint("a %>% .$y %>% mean()", linter) # more complicated expressions don't pick up on nested symbols lines <- trim_some(" @@ -25,10 +26,10 @@ test_that("pipe_call_linter skips allowed usages", { my_combination_fun(tmp, bla) } ") - expect_lint(lines, NULL, linter) + expect_no_lint(lines, linter) # extraction pipe uses RHS symbols - expect_lint("a %$% b", NULL, linter) + expect_no_lint("a %$% b", linter) }) test_that("pipe_call_linter blocks simple disallowed usages", { @@ -68,7 +69,7 @@ local({ patrick::with_parameters_test_that( "All pipe operators are caught", { - expect_lint(sprintf("a %s foo()", pipe), NULL, linter) + expect_no_lint(sprintf("a %s foo()", pipe), linter) expect_lint(sprintf("a %s foo", pipe), sprintf("`a %s foo`", pipe), linter) }, pipe = pipes, @@ -89,3 +90,4 @@ test_that("Multiple lints give custom messages", { pipe_call_linter() ) }) +# nofuzz end diff --git a/tests/testthat/test-pipe_consistency_linter.R b/tests/testthat/test-pipe_consistency_linter.R index 4a236b156..57c6df83b 100644 --- a/tests/testthat/test-pipe_consistency_linter.R +++ b/tests/testthat/test-pipe_consistency_linter.R @@ -1,19 +1,19 @@ +# nofuzz start test_that("pipe_consistency skips allowed usage", { skip_if_not_r_version("4.1.0") linter <- pipe_consistency_linter() - expect_lint("1:3 %>% mean() %>% as.character()", NULL, linter) - expect_lint("1:3 |> mean() |> as.character()", NULL, linter) + expect_no_lint("1:3 %>% mean() %>% as.character()", linter) + expect_no_lint("1:3 |> mean() |> as.character()", linter) # With no pipes - expect_lint("x <- 1:5", NULL, linter) + expect_no_lint("x <- 1:5", linter) # Across multiple lines - expect_lint( + expect_no_lint( trim_some(" 1:3 %>% mean() %>% as.character() "), - NULL, linter ) }) @@ -96,9 +96,8 @@ test_that("pipe_consistency_linter works with |> argument", { linter ) - expect_lint( + expect_no_lint( "1:3 |> mean() |> as.character()", - NULL, linter ) @@ -134,11 +133,7 @@ test_that("pipe_consistency_linter works with %>% argument", { linter ) - expect_lint( - "1:3 %>% mean() %>% as.character()", - NULL, - linter - ) + expect_no_lint("1:3 %>% mean() %>% as.character()", linter) expect_lint( trim_some(" @@ -156,7 +151,7 @@ test_that("pipe_consistency_linter works with other magrittr pipes", { linter <- pipe_consistency_linter() expected_message <- rex::rex("Stick to one pipe operator; found 1 instances of %>% and 1 instances of |>.") - expect_lint("1:3 %>% mean() %T% print()", NULL, linter) + expect_no_lint("1:3 %>% mean() %T% print()", linter) expect_lint( "1:3 |> mean() %T>% print()", list( @@ -166,3 +161,4 @@ test_that("pipe_consistency_linter works with other magrittr pipes", { linter ) }) +# nofuzz end diff --git a/tests/testthat/test-pipe_continuation_linter.R b/tests/testthat/test-pipe_continuation_linter.R index 0d3350bca..7775007d1 100644 --- a/tests/testthat/test-pipe_continuation_linter.R +++ b/tests/testthat/test-pipe_continuation_linter.R @@ -3,19 +3,18 @@ test_that("pipe-continuation correctly handles stand-alone expressions", { lint_msg <- rex::rex("Put a space before `%>%` and a new line after it,") # Expressions without pipes are ignored - expect_lint("blah", NULL, linter) + expect_no_lint("blah", linter) # Pipe expressions on a single line are ignored - expect_lint("foo %>% bar() %>% baz()", NULL, linter) + expect_no_lint("foo %>% bar() %>% baz()", linter) # Pipe expressions spanning multiple lines with each expression on a line are ignored - expect_lint( + expect_no_lint( trim_some(" foo %>% bar() %>% baz() "), - NULL, linter ) @@ -66,13 +65,12 @@ test_that("pipe-continuation linter correctly handles nesting", { ) # but no lints here - expect_lint( + expect_no_lint( # nofuzz. Not valid with '|>' trim_some(" 1:4 %>% { (.) %>% sum() } "), - NULL, linter ) }) @@ -84,14 +82,13 @@ test_that("pipe-continuation linter handles native pipe", { lint_msg_native <- rex::rex("Put a space before `|>` and a new line after it,") lint_msg_magrittr <- rex::rex("Put a space before `%>%` and a new line after it,") - expect_lint("foo |> bar() |> baz()", NULL, linter) - expect_lint( + expect_no_lint("foo |> bar() |> baz()", linter) + expect_no_lint( trim_some(" foo |> bar() |> baz() "), - NULL, linter ) expect_lint( @@ -161,12 +158,14 @@ local({ test_data <- diamonds %>% head(10) %>% tail(5) }) "), "three inside test_that()", - trim_some(" - { - x <- a %>% b %>% c - y <- c %>% b %>% a - } - "), "two different single-line pipelines", + trim_some( # nofuzz. Native pipe requires calls, not symbols. + " + { + x <- a %>% b %>% c + y <- c %>% b %>% a + } + " + ), "two different single-line pipelines", trim_some(" my_fun <- function() { a %>% @@ -179,7 +178,7 @@ local({ "valid nesting is handled", # nolint next: unnecessary_nesting_linter. TODO(#2334): Remove this nolint. { - expect_lint(code_string, NULL, linter) + expect_no_lint(code_string, linter) }, .cases = .cases ) diff --git a/tests/testthat/test-pipe_return_linter.R b/tests/testthat/test-pipe_return_linter.R index 1d7af5f6c..22ea6a9a2 100644 --- a/tests/testthat/test-pipe_return_linter.R +++ b/tests/testthat/test-pipe_return_linter.R @@ -6,7 +6,7 @@ test_that("pipe_return_linter skips allowed usages", { filter(str > 5) %>% summarize(str = sum(str)) ") - expect_lint(normal_pipe_lines, NULL, linter) + expect_no_lint(normal_pipe_lines, linter) normal_function_lines <- trim_some(" pipeline <- function(x) { @@ -16,7 +16,7 @@ test_that("pipe_return_linter skips allowed usages", { return(out) } ") - expect_lint(normal_function_lines, NULL, linter) + expect_no_lint(normal_function_lines, linter) nested_return_lines <- trim_some(" pipeline <- function(x) { @@ -27,9 +27,10 @@ test_that("pipe_return_linter skips allowed usages", { return(x_squared) } ") - expect_lint(nested_return_lines, NULL, linter) + expect_no_lint(nested_return_lines, linter) }) +# nofuzz start test_that("pipe_return_linter blocks simple disallowed usages", { lines <- trim_some(" pipeline <- function(x) { @@ -65,3 +66,4 @@ test_that("lints vectorize", { pipe_return_linter() ) }) +# nofuzz end diff --git a/tests/testthat/test-return_linter.R b/tests/testthat/test-return_linter.R index 1a228e912..e4ad3caaa 100644 --- a/tests/testthat/test-return_linter.R +++ b/tests/testthat/test-return_linter.R @@ -495,6 +495,7 @@ test_that("return_linter allows return()-less namespace hook calls", { ) }) +# nofuzz start test_that("return_linter correctly handles pipes", { linter <- return_linter(return_style = "explicit") @@ -532,6 +533,7 @@ test_that("return_linter correctly handles pipes", { linter ) }) +# nofuzz end test_that("return_linter handles pipes in control flow", { linter <- return_linter(return_style = "explicit") diff --git a/tests/testthat/test-unnecessary_placeholder_linter.R b/tests/testthat/test-unnecessary_placeholder_linter.R index d8a1e677a..ba89c8237 100644 --- a/tests/testthat/test-unnecessary_placeholder_linter.R +++ b/tests/testthat/test-unnecessary_placeholder_linter.R @@ -1,3 +1,4 @@ +# nofuzz start linter <- unnecessary_placeholder_linter() pipes <- pipes(exclude = "|>") @@ -5,15 +6,15 @@ patrick::with_parameters_test_that( "unnecessary_placeholder_linter skips allowed usages", { # . used in position other than first --> ok - expect_lint(sprintf("x %s foo(y, .)", pipe), NULL, linter) + expect_no_lint(sprintf("x %s foo(y, .)", pipe), linter) # ditto for nested usage - expect_lint(sprintf("x %s foo(y, bar(.))", pipe), NULL, linter) + expect_no_lint(sprintf("x %s foo(y, bar(.))", pipe), linter) # . used twice --> ok - expect_lint(sprintf("x %s foo(., .)", pipe), NULL, linter) + expect_no_lint(sprintf("x %s foo(., .)", pipe), linter) # . used as a keyword argument --> ok - expect_lint(sprintf("x %s foo(arg = .)", pipe), NULL, linter) + expect_no_lint(sprintf("x %s foo(arg = .)", pipe), linter) # . used inside a scope --> ok - expect_lint(sprintf("x %s { foo(arg = .) }", pipe), NULL, linter) + expect_no_lint(sprintf("x %s { foo(arg = .) }", pipe), linter) }, .test_name = names(pipes), pipe = pipes @@ -53,3 +54,4 @@ test_that("lints vectorize", { unnecessary_placeholder_linter() ) }) +# nofuzz end diff --git a/tests/testthat/test-unused_import_linter.R b/tests/testthat/test-unused_import_linter.R index cb6f89872..4c2bac2ff 100644 --- a/tests/testthat/test-unused_import_linter.R +++ b/tests/testthat/test-unused_import_linter.R @@ -1,21 +1,27 @@ test_that("unused_import_linter lints as expected", { linter <- unused_import_linter() - expect_lint("library(dplyr)\ntibble(a = 1)", NULL, linter) + expect_no_lint("library(dplyr)\ntibble(a = 1)", linter) # SYMBOL_FUNCTION_CALL usage is detected - expect_lint("library(tidyverse)\ntibble(a = 1)", NULL, linter) + expect_no_lint("library(tidyverse)\ntibble(a = 1)", linter) # SYMBOL usage is detected - expect_lint("library(dplyr)\ndo.call(tibble, args = list(a = 1))", NULL, linter) + expect_no_lint("library(dplyr)\ndo.call(tibble, args = list(a = 1))", linter) # SPECIAL usage is detected - expect_lint("library(magrittr)\n1:3 %>% mean()", NULL, linter) + expect_no_lint( # nofuzz + trim_some(" + library(magrittr) + 1:3 %>% mean() + "), + linter + ) # dataset is detected - expect_lint("library(dplyr)\nstarwars", NULL, linter) - expect_lint("library(datasets)\nstate.center", NULL, linter) + expect_no_lint("library(dplyr)\nstarwars", linter) + expect_no_lint("library(datasets)\nstate.center", linter) # Missing packages are ignored - expect_lint("library(not.a.package)\ntibble(a = 1)", NULL, linter) + expect_no_lint("library(not.a.package)\ntibble(a = 1)", linter) # SYMBOL calls with character.only = TRUE are ignored, even if the argument is a package name - expect_lint("library(dplyr, character.only = TRUE)\n1 + 1", NULL, linter) + expect_no_lint("library(dplyr, character.only = TRUE)\n1 + 1", linter) lint_msg <- rex::rex("Package 'dplyr' is attached but never used") msg_ns <- rex::rex("Don't attach package 'dplyr', which is only used by namespace.") @@ -26,11 +32,11 @@ test_that("unused_import_linter lints as expected", { expect_lint("library('dplyr', character.only = TRUE)\n1 + 1", lint_msg, linter) # ignore namespaced usages by default, but provide custom lint message expect_lint("library(dplyr)\ndplyr::tibble(a = 1)", msg_ns, linter) - expect_lint("library(dplyr)\ndplyr::tibble(a = 1)", NULL, unused_import_linter(allow_ns_usage = TRUE)) + expect_no_lint("library(dplyr)\ndplyr::tibble(a = 1)", unused_import_linter(allow_ns_usage = TRUE)) # ignore packages in except_packages - expect_lint("library(data.table)\n1 + 1", NULL, linter) - expect_lint("library(dplyr)\n1 + 1", NULL, unused_import_linter(except_packages = "dplyr")) + expect_no_lint("library(data.table)\n1 + 1", linter) + expect_no_lint("library(dplyr)\n1 + 1", unused_import_linter(except_packages = "dplyr")) }) test_that("unused_import_linter handles message vectorization", { @@ -70,6 +76,6 @@ test_that("glue usages are seen", { glue('{ xml_parse_data() }') ") - expect_lint(lines, NULL, unused_import_linter()) + expect_no_lint(lines, unused_import_linter()) expect_lint(lines, lint_msg, unused_import_linter(interpret_glue = FALSE)) }) From 8059091e7a5942ba51002e6761a6c7c3d42efc2c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:00:26 -0800 Subject: [PATCH 031/131] another round of nofuzz --- tests/testthat/test-brace_linter.R | 2 ++ tests/testthat/test-implicit_assignment_linter.R | 2 +- tests/testthat/test-infix_spaces_linter.R | 10 ++++------ tests/testthat/test-one_call_pipe_linter.R | 2 +- tests/testthat/test-return_linter.R | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index 0d0532f8e..76c475e0c 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -548,6 +548,7 @@ test_that("code with pipes is handled correctly", { linter ) + # nofuzz start expect_lint( trim_some(" x %>% @@ -579,6 +580,7 @@ test_that("code with pipes is handled correctly", { ), linter ) + # nofuzz end skip_if_not_r_version("4.1.0") diff --git a/tests/testthat/test-implicit_assignment_linter.R b/tests/testthat/test-implicit_assignment_linter.R index 91ab4de64..da0d9c6f7 100644 --- a/tests/testthat/test-implicit_assignment_linter.R +++ b/tests/testthat/test-implicit_assignment_linter.R @@ -427,7 +427,7 @@ test_that("allow_scoped skips scoped assignments", { test_that("interaction of allow_lazy and allow_scoped", { linter <- implicit_assignment_linter(allow_scoped = TRUE, allow_lazy = TRUE) - expect_nl_lint( + expect_no_lint( trim_some(" if (any(idx <- foo()) && BB) { stop('Invalid foo() output: ', toString(idx)) diff --git a/tests/testthat/test-infix_spaces_linter.R b/tests/testthat/test-infix_spaces_linter.R index 7b73411e7..9180f912b 100644 --- a/tests/testthat/test-infix_spaces_linter.R +++ b/tests/testthat/test-infix_spaces_linter.R @@ -33,24 +33,22 @@ test_that("returns the correct linting", { expect_no_lint("blah", linter) + # nofuzz start for (op in ops) { expect_no_lint(paste0("1 ", op, " 2"), linter) expect_no_lint(paste0("1 ", op, "\n2"), linter) expect_no_lint(paste0("1 ", op, "\n 2"), linter) - expect_lint( # nofuzz - paste0("1", op, "2"), - lint_msg, - linter - ) + expect_lint(paste0("1", op, "2"), lint_msg, linter) # unary plus and minus can have no space before them if (!op %in% ops[1L:2L]) { - expect_lint(paste0("1 ", op, "2"), lint_msg, linter) # nofuzz + expect_lint(paste0("1 ", op, "2"), lint_msg, linter) } expect_lint(paste0("1", op, " 2"), lint_msg, linter) } + # nofuzz end expect_no_lint("b <- 2E+4", linter) expect_no_lint("a <- 1e-3", linter) diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index 654202237..5822cec6e 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -69,6 +69,7 @@ test_that("multiple lints are generated correctly", { ) }) +# nofuzz start test_that("Native pipes are handled as well", { skip_if_not_r_version("4.1.0") @@ -97,7 +98,6 @@ test_that("Native pipes are handled as well", { ) }) -# nofuzz start test_that("one_call_pipe_linter skips data.table chains with native pipe", { skip_if_not_r_version("4.3.0") diff --git a/tests/testthat/test-return_linter.R b/tests/testthat/test-return_linter.R index e4ad3caaa..6a17faca5 100644 --- a/tests/testthat/test-return_linter.R +++ b/tests/testthat/test-return_linter.R @@ -539,7 +539,7 @@ test_that("return_linter handles pipes in control flow", { linter <- return_linter(return_style = "explicit") lint_msg <- rex::rex("All functions must have an explicit return().") - expect_no_lint( + expect_no_lint( # nofuzz trim_some(" foo <- function(x) { if (TRUE) { From df8cccc3b078d08a73ec2db42cdee4dfd4f59478 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:08:25 -0800 Subject: [PATCH 032/131] another batch --- .dev/ast_fuzz_test.R | 2 +- tests/testthat/test-one_call_pipe_linter.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index d72b4279c..1f57bbffa 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -116,7 +116,7 @@ failures <- reporter$failures$as_list() valid_failure <- vapply( failures, function(failure) { - if (grepl('(column_number|ranges|line) .* did not match', failure$message)) { + if (grepl("(column_number|ranges|line) .* did not match", failure$message)) { return(TRUE) } FALSE diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index 5822cec6e..9580af783 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -12,6 +12,7 @@ test_that("one_call_pipe_linter skips allowed usages", { expect_no_lint("x %<>% as.character()", linter) }) +# nofuzz start test_that("one_call_pipe_linter blocks simple disallowed usages", { linter <- one_call_pipe_linter() lint_msg <- rex::rex("Avoid pipe %>% for expressions with only a single call.") @@ -25,7 +26,6 @@ test_that("one_call_pipe_linter blocks simple disallowed usages", { expect_lint("x %>% inner_join(y %>% filter(is_treatment))", lint_msg, linter) }) -# nofuzz start test_that("one_call_pipe_linter skips data.table chains", { linter <- one_call_pipe_linter() lint_msg <- rex::rex("Avoid pipe %>% for expressions with only a single call.") @@ -53,7 +53,7 @@ test_that("one_call_pipe_linter treats all pipes equally", { }) test_that("multiple lints are generated correctly", { - expect_lint( + expect_lint( # nofuzz trim_some("{ a %>% b() c %$% d From 138e9cc2f87e7b84e8f8cbdf48736d1cefbe45b4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:12:35 -0800 Subject: [PATCH 033/131] tweak --- .dev/ast_fuzz_test.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 1f57bbffa..c08976976 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -123,8 +123,8 @@ valid_failure <- vapply( }, logical(1L) ) -if (!all(valid_failure)) { - failures <- failures[!valid_failure] +failures <- failures[!valid_failure] +if (length(failures) > 0L) { names(failures) <- vapply(failures, `[[`, "test", FUN.VALUE = character(1L)) cat("Some fuzzed tests failed unexpectedly!\n") print(failures) From 683c461857795f3aa9d2b12da17529a1c0f95173 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:22:14 -0800 Subject: [PATCH 034/131] another nofuzz case, attempting to reduce nofuzz requirements --- .dev/maybe_fuzz_content.R | 21 +++++++++--- tests/testthat/test-commented_code_linter.R | 36 ++++++++++----------- 2 files changed, 34 insertions(+), 23 deletions(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index e60ab4655..65ed88dfd 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -14,6 +14,14 @@ maybe_fuzz_content <- function(file, lines) { new_file } +# skip errors for e.g. Rmd files, and ignore warnings. +# We could use get_source_expressions(), but with little benefit & much slower. +# also avoid over-use of 'nofuzz' induced by some incompatible swaps, e.g. not all '%>%' can be +# swapped to '|>' (if '.' is used, or if RHS is not an allowed simple call) +error_or_parse_data <- function(f) { + tryCatch(getParseData(suppressWarnings(parse(f, keep.source = TRUE))), error = identity) +} + simple_swap_fuzzer <- function(pd_filter, replacements) { function(pd, lines) { idx <- which(pd_filter(pd)) @@ -49,18 +57,21 @@ pipe_fuzzer <- simple_swap_fuzzer( # we could also consider just passing any test where no fuzzing takes place, # i.e. letting the other GHA handle whether unfuzzed tests pass as expected. apply_fuzzers <- function(f) { - # skip errors for e.g. Rmd files, and ignore warnings. - # We could use get_source_expressions(), but with little benefit & much slower. - pd <- tryCatch(getParseData(suppressWarnings(parse(f, keep.source = TRUE))), error = identity) + pd <- error_or_parse_data(f) if (inherits(pd, "error")) { return(invisible()) } reparse <- FALSE - lines <- readLines(f) + unedited <- lines <- readLines(f) for (fuzzer in list(function_lambda_fuzzer, pipe_fuzzer)) { if (reparse) { - pd <- getParseData(parse(f, keep.source = TRUE)) + pd <- error_or_parse_data(f) + if (inherits(pd, "error")) { + # our attempted edit failed; restore & abort + writeLines(unedited, f) + return(invisible()) + } lines <- readLines(f) } updated_lines <- fuzzer(pd, lines) diff --git a/tests/testthat/test-commented_code_linter.R b/tests/testthat/test-commented_code_linter.R index 5154a5a94..a1ff0e157 100644 --- a/tests/testthat/test-commented_code_linter.R +++ b/tests/testthat/test-commented_code_linter.R @@ -1,21 +1,21 @@ test_that("commented_code_linter skips allowed usages", { linter <- commented_code_linter() - expect_lint("blah", NULL, linter) - expect_lint("#' blah <- 1", NULL, linter) - expect_lint("a <- 1\n# comment without code", NULL, linter) - expect_lint("a <- 1\n## whatever", NULL, linter) - - expect_lint("TRUE", NULL, linter) - expect_lint("#' @examples", NULL, linter) - expect_lint("#' foo(1) # list(1)", NULL, linter) # comment in roxygen block ignored - expect_lint("1+1 # gives 2", NULL, linter) - expect_lint("# Non-existent:", NULL, linter) - expect_lint("# 1-a", NULL, linter) # "-" removed from code operators - expect_lint('1+1 # for example cat("123")', NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("#' blah <- 1", linter) + expect_no_lint("a <- 1\n# comment without code", linter) + expect_no_lint("a <- 1\n## whatever", linter) + + expect_no_lint("TRUE", linter) + expect_no_lint("#' @examples", linter) + expect_no_lint("#' foo(1) # list(1)", linter) # comment in roxygen block ignored + expect_no_lint("1+1 # gives 2", linter) + expect_no_lint("# Non-existent:", linter) + expect_no_lint("# 1-a", linter) # "-" removed from code operators + expect_no_lint('1+1 # for example cat("123")', linter) # regression test for #451 - expect_lint("c('#a#' = 1)", NULL, linter) + expect_no_lint("c('#a#' = 1)", linter) }) test_that("commented_code_linter blocks disallowed usages", { @@ -87,20 +87,20 @@ test_that("commented_code_linter can detect operators in comments and lint corre "%anything%" ) + # nofuzz start for (op in test_ops) { - expect_lint(paste("i", op, "1", collapse = ""), NULL, linter) - expect_lint(paste("# something like i", op, "1", collapse = ""), NULL, linter) + expect_no_lint(paste("i", op, "1", collapse = ""), linter) + expect_no_lint(paste("# something like i", op, "1", collapse = ""), linter) expect_lint(paste("# i", op, "1", collapse = ""), lint_msg, linter) } -}) + # nofuzz end -test_that("commented_code_linter can detect operators in comments and lint correctly", { skip_if_not_r_version("4.1.0") expect_lint( "# 1:3 |> sum()", rex::rex("Remove commented code."), - commented_code_linter() + linter ) }) From 98086d48e1528f1dd0ee7610b8df10eb9518bf01 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 6 Mar 2025 23:45:00 -0800 Subject: [PATCH 035/131] fix; scale back nofuzz for an attempt --- .dev/maybe_fuzz_content.R | 20 ++++++++----------- tests/testthat/test-brace_linter.R | 2 -- tests/testthat/test-commented_code_linter.R | 2 -- .../test-implicit_assignment_linter.R | 2 +- tests/testthat/test-infix_spaces_linter.R | 2 -- tests/testthat/test-one_call_pipe_linter.R | 6 +----- tests/testthat/test-pipe_call_linter.R | 2 -- tests/testthat/test-pipe_consistency_linter.R | 2 -- .../testthat/test-pipe_continuation_linter.R | 4 ++-- tests/testthat/test-pipe_return_linter.R | 2 -- tests/testthat/test-return_linter.R | 4 +--- .../test-unnecessary_placeholder_linter.R | 2 -- tests/testthat/test-unused_import_linter.R | 2 +- 13 files changed, 14 insertions(+), 38 deletions(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 65ed88dfd..b76edca00 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -62,22 +62,18 @@ apply_fuzzers <- function(f) { return(invisible()) } - reparse <- FALSE unedited <- lines <- readLines(f) for (fuzzer in list(function_lambda_fuzzer, pipe_fuzzer)) { - if (reparse) { - pd <- error_or_parse_data(f) - if (inherits(pd, "error")) { - # our attempted edit failed; restore & abort - writeLines(unedited, f) - return(invisible()) - } - lines <- readLines(f) - } updated_lines <- fuzzer(pd, lines) - reparse <- !is.null(updated_lines) - if (!reparse) next # skip some I/O if we can + if (is.null(updated_lines)) next # skip some I/O if we can writeLines(updated_lines, f) + # check if our attempted edit introduced some error + pd <- error_or_parse_data(f) + if (inherits(pd, "error")) { + writeLines(unedited, f) + return(invisible()) + } + lines <- readLines(f) } invisible() diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index 76c475e0c..0d0532f8e 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -548,7 +548,6 @@ test_that("code with pipes is handled correctly", { linter ) - # nofuzz start expect_lint( trim_some(" x %>% @@ -580,7 +579,6 @@ test_that("code with pipes is handled correctly", { ), linter ) - # nofuzz end skip_if_not_r_version("4.1.0") diff --git a/tests/testthat/test-commented_code_linter.R b/tests/testthat/test-commented_code_linter.R index a1ff0e157..8809335de 100644 --- a/tests/testthat/test-commented_code_linter.R +++ b/tests/testthat/test-commented_code_linter.R @@ -87,13 +87,11 @@ test_that("commented_code_linter can detect operators in comments and lint corre "%anything%" ) - # nofuzz start for (op in test_ops) { expect_no_lint(paste("i", op, "1", collapse = ""), linter) expect_no_lint(paste("# something like i", op, "1", collapse = ""), linter) expect_lint(paste("# i", op, "1", collapse = ""), lint_msg, linter) } - # nofuzz end skip_if_not_r_version("4.1.0") diff --git a/tests/testthat/test-implicit_assignment_linter.R b/tests/testthat/test-implicit_assignment_linter.R index da0d9c6f7..0681b2ecd 100644 --- a/tests/testthat/test-implicit_assignment_linter.R +++ b/tests/testthat/test-implicit_assignment_linter.R @@ -316,7 +316,7 @@ test_that("implicit_assignment_linter works as expected with pipes and walrus op linter <- implicit_assignment_linter() expect_no_lint("data %>% mutate(a := b)", linter) - expect_no_lint( # nofuzz + expect_no_lint( "dt %>% .[, z := x + y]", linter ) diff --git a/tests/testthat/test-infix_spaces_linter.R b/tests/testthat/test-infix_spaces_linter.R index 9180f912b..245ac8a4e 100644 --- a/tests/testthat/test-infix_spaces_linter.R +++ b/tests/testthat/test-infix_spaces_linter.R @@ -33,7 +33,6 @@ test_that("returns the correct linting", { expect_no_lint("blah", linter) - # nofuzz start for (op in ops) { expect_no_lint(paste0("1 ", op, " 2"), linter) expect_no_lint(paste0("1 ", op, "\n2"), linter) @@ -48,7 +47,6 @@ test_that("returns the correct linting", { expect_lint(paste0("1", op, " 2"), lint_msg, linter) } - # nofuzz end expect_no_lint("b <- 2E+4", linter) expect_no_lint("a <- 1e-3", linter) diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index 9580af783..f8c1d664e 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -12,7 +12,6 @@ test_that("one_call_pipe_linter skips allowed usages", { expect_no_lint("x %<>% as.character()", linter) }) -# nofuzz start test_that("one_call_pipe_linter blocks simple disallowed usages", { linter <- one_call_pipe_linter() lint_msg <- rex::rex("Avoid pipe %>% for expressions with only a single call.") @@ -40,7 +39,6 @@ test_that("one_call_pipe_linter skips data.table chains", { expect_lint("DT %>% .[[idx]]", lint_msg, linter) }) -# nofuzz end test_that("one_call_pipe_linter treats all pipes equally", { linter <- one_call_pipe_linter() @@ -53,7 +51,7 @@ test_that("one_call_pipe_linter treats all pipes equally", { }) test_that("multiple lints are generated correctly", { - expect_lint( # nofuzz + expect_lint( trim_some("{ a %>% b() c %$% d @@ -69,7 +67,6 @@ test_that("multiple lints are generated correctly", { ) }) -# nofuzz start test_that("Native pipes are handled as well", { skip_if_not_r_version("4.1.0") @@ -114,4 +111,3 @@ test_that("one_call_pipe_linter skips data.table chains with native pipe", { expect_lint("DT |> _[[idx]]", lint_msg, linter) }) -# nofuzz end diff --git a/tests/testthat/test-pipe_call_linter.R b/tests/testthat/test-pipe_call_linter.R index 7e389878e..e15226de3 100644 --- a/tests/testthat/test-pipe_call_linter.R +++ b/tests/testthat/test-pipe_call_linter.R @@ -1,4 +1,3 @@ -# nofuzz start test_that("pipe_call_linter skips allowed usages", { linter <- pipe_call_linter() @@ -90,4 +89,3 @@ test_that("Multiple lints give custom messages", { pipe_call_linter() ) }) -# nofuzz end diff --git a/tests/testthat/test-pipe_consistency_linter.R b/tests/testthat/test-pipe_consistency_linter.R index 57c6df83b..687838405 100644 --- a/tests/testthat/test-pipe_consistency_linter.R +++ b/tests/testthat/test-pipe_consistency_linter.R @@ -1,4 +1,3 @@ -# nofuzz start test_that("pipe_consistency skips allowed usage", { skip_if_not_r_version("4.1.0") linter <- pipe_consistency_linter() @@ -161,4 +160,3 @@ test_that("pipe_consistency_linter works with other magrittr pipes", { linter ) }) -# nofuzz end diff --git a/tests/testthat/test-pipe_continuation_linter.R b/tests/testthat/test-pipe_continuation_linter.R index 7775007d1..566848505 100644 --- a/tests/testthat/test-pipe_continuation_linter.R +++ b/tests/testthat/test-pipe_continuation_linter.R @@ -65,7 +65,7 @@ test_that("pipe-continuation linter correctly handles nesting", { ) # but no lints here - expect_no_lint( # nofuzz. Not valid with '|>' + expect_no_lint( trim_some(" 1:4 %>% { (.) %>% sum() @@ -158,7 +158,7 @@ local({ test_data <- diamonds %>% head(10) %>% tail(5) }) "), "three inside test_that()", - trim_some( # nofuzz. Native pipe requires calls, not symbols. + trim_some( " { x <- a %>% b %>% c diff --git a/tests/testthat/test-pipe_return_linter.R b/tests/testthat/test-pipe_return_linter.R index 22ea6a9a2..f235edbd1 100644 --- a/tests/testthat/test-pipe_return_linter.R +++ b/tests/testthat/test-pipe_return_linter.R @@ -30,7 +30,6 @@ test_that("pipe_return_linter skips allowed usages", { expect_no_lint(nested_return_lines, linter) }) -# nofuzz start test_that("pipe_return_linter blocks simple disallowed usages", { lines <- trim_some(" pipeline <- function(x) { @@ -66,4 +65,3 @@ test_that("lints vectorize", { pipe_return_linter() ) }) -# nofuzz end diff --git a/tests/testthat/test-return_linter.R b/tests/testthat/test-return_linter.R index 6a17faca5..1a228e912 100644 --- a/tests/testthat/test-return_linter.R +++ b/tests/testthat/test-return_linter.R @@ -495,7 +495,6 @@ test_that("return_linter allows return()-less namespace hook calls", { ) }) -# nofuzz start test_that("return_linter correctly handles pipes", { linter <- return_linter(return_style = "explicit") @@ -533,13 +532,12 @@ test_that("return_linter correctly handles pipes", { linter ) }) -# nofuzz end test_that("return_linter handles pipes in control flow", { linter <- return_linter(return_style = "explicit") lint_msg <- rex::rex("All functions must have an explicit return().") - expect_no_lint( # nofuzz + expect_no_lint( trim_some(" foo <- function(x) { if (TRUE) { diff --git a/tests/testthat/test-unnecessary_placeholder_linter.R b/tests/testthat/test-unnecessary_placeholder_linter.R index ba89c8237..88b921e52 100644 --- a/tests/testthat/test-unnecessary_placeholder_linter.R +++ b/tests/testthat/test-unnecessary_placeholder_linter.R @@ -1,4 +1,3 @@ -# nofuzz start linter <- unnecessary_placeholder_linter() pipes <- pipes(exclude = "|>") @@ -54,4 +53,3 @@ test_that("lints vectorize", { unnecessary_placeholder_linter() ) }) -# nofuzz end diff --git a/tests/testthat/test-unused_import_linter.R b/tests/testthat/test-unused_import_linter.R index 4c2bac2ff..b9c52a240 100644 --- a/tests/testthat/test-unused_import_linter.R +++ b/tests/testthat/test-unused_import_linter.R @@ -7,7 +7,7 @@ test_that("unused_import_linter lints as expected", { # SYMBOL usage is detected expect_no_lint("library(dplyr)\ndo.call(tibble, args = list(a = 1))", linter) # SPECIAL usage is detected - expect_no_lint( # nofuzz + expect_no_lint( trim_some(" library(magrittr) 1:3 %>% mean() From fe88c59362fb6e2b7f6167998858a81c7f84c54a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 00:09:42 -0800 Subject: [PATCH 036/131] reinstate more legit nofuzz --- tests/testthat/test-one_call_pipe_linter.R | 8 +++++--- tests/testthat/test-pipe_consistency_linter.R | 2 ++ tests/testthat/test-unnecessary_placeholder_linter.R | 4 ++-- tests/testthat/test-unused_import_linter.R | 2 +- 4 files changed, 10 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index f8c1d664e..9cf7a60e9 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -12,6 +12,7 @@ test_that("one_call_pipe_linter skips allowed usages", { expect_no_lint("x %<>% as.character()", linter) }) +# nofuzz start test_that("one_call_pipe_linter blocks simple disallowed usages", { linter <- one_call_pipe_linter() lint_msg <- rex::rex("Avoid pipe %>% for expressions with only a single call.") @@ -24,6 +25,7 @@ test_that("one_call_pipe_linter blocks simple disallowed usages", { # nested case expect_lint("x %>% inner_join(y %>% filter(is_treatment))", lint_msg, linter) }) +# nofuzz end test_that("one_call_pipe_linter skips data.table chains", { linter <- one_call_pipe_linter() @@ -50,7 +52,7 @@ test_that("one_call_pipe_linter treats all pipes equally", { expect_no_lint('data %>% filter(type == "console") %$% obscured_id %>% unique()', linter) }) -test_that("multiple lints are generated correctly", { +test_that("multiple lints are generated correctly", { # nofuzz expect_lint( trim_some("{ a %>% b() @@ -72,7 +74,7 @@ test_that("Native pipes are handled as well", { linter <- one_call_pipe_linter() - expect_lint( + expect_lint( # nofuzz "x |> foo()", rex::rex("Avoid pipe |> for expressions with only a single call."), linter @@ -82,7 +84,7 @@ test_that("Native pipes are handled as well", { expect_no_lint("x |> foo() %>% bar()", linter) expect_no_lint("x %>% foo() |> bar()", linter) - expect_lint( + expect_lint( # nofuzz trim_some("{ a %>% b() c |> d() diff --git a/tests/testthat/test-pipe_consistency_linter.R b/tests/testthat/test-pipe_consistency_linter.R index 687838405..57c6df83b 100644 --- a/tests/testthat/test-pipe_consistency_linter.R +++ b/tests/testthat/test-pipe_consistency_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("pipe_consistency skips allowed usage", { skip_if_not_r_version("4.1.0") linter <- pipe_consistency_linter() @@ -160,3 +161,4 @@ test_that("pipe_consistency_linter works with other magrittr pipes", { linter ) }) +# nofuzz end diff --git a/tests/testthat/test-unnecessary_placeholder_linter.R b/tests/testthat/test-unnecessary_placeholder_linter.R index 88b921e52..8ee413a4b 100644 --- a/tests/testthat/test-unnecessary_placeholder_linter.R +++ b/tests/testthat/test-unnecessary_placeholder_linter.R @@ -19,7 +19,7 @@ patrick::with_parameters_test_that( pipe = pipes ) -patrick::with_parameters_test_that( +patrick::with_parameters_test_that( # nofuzz "unnecessary_placeholder_linter blocks simple disallowed usages", { expect_lint( @@ -38,7 +38,7 @@ patrick::with_parameters_test_that( pipe = pipes ) -test_that("lints vectorize", { +test_that("lints vectorize", { # nofuzz lint_msg <- rex::rex("Don't use the placeholder (`.`) when it's not needed") expect_lint( diff --git a/tests/testthat/test-unused_import_linter.R b/tests/testthat/test-unused_import_linter.R index b9c52a240..4c2bac2ff 100644 --- a/tests/testthat/test-unused_import_linter.R +++ b/tests/testthat/test-unused_import_linter.R @@ -7,7 +7,7 @@ test_that("unused_import_linter lints as expected", { # SYMBOL usage is detected expect_no_lint("library(dplyr)\ndo.call(tibble, args = list(a = 1))", linter) # SPECIAL usage is detected - expect_no_lint( + expect_no_lint( # nofuzz trim_some(" library(magrittr) 1:3 %>% mean() From 19288315511c376b929407793ac0e87725ed1629 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 18:03:42 +0000 Subject: [PATCH 037/131] general fix for issue of S4 method calls under @ --- NEWS.md | 2 ++ R/missing_argument_linter.R | 2 +- R/source_utils.R | 12 +++++++++++- tests/testthat/test-missing_argument_linter.R | 1 + 4 files changed, 15 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8ea061062..393a1e394 100644 --- a/NEWS.md +++ b/NEWS.md @@ -30,6 +30,7 @@ * `object_name_linter()` and `object_length_linter()` apply to objects assigned with `assign()` or generics created with `setGeneric()` (#1665, @MichaelChirico). * `object_usage_linter()` gains argument `interpret_extensions` to govern which false positive-prone common syntaxes should be checked for used objects (#1472, @MichaelChirico). Currently `"glue"` (renamed from earlier argument `interpret_glue`) and `"rlang"` are supported. The latter newly covers usage of the `.env` pronoun like `.env$key`, where `key` was previously missed as being a used variable. * `boolean_arithmetic_linter()` finds many more cases like `sum(x | y) == 0` where the total of a known-logical vector is compared to 0 (#1580, @MichaelChirico). +* New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico). ### New linters @@ -57,6 +58,7 @@ + `library_call_linter()` + `terminal_close_linter()` + `unnecessary_lambda_linter()` +* `missing_argument_linter()` finds S4 usage like `s4Obj@method(arg = )` (#2820, @MichaelChirico). ## Notes diff --git a/R/missing_argument_linter.R b/R/missing_argument_linter.R index 284cfa75a..749980d52 100644 --- a/R/missing_argument_linter.R +++ b/R/missing_argument_linter.R @@ -50,7 +50,7 @@ missing_argument_linter <- function(except = c("alist", "quote", "switch"), allo ") Linter(linter_level = "file", function(source_expression) { - xml_targets <- source_expression$xml_find_function_calls(NULL, keep_names = TRUE) + xml_targets <- source_expression$xml_find_function_calls(NULL, keep_names = TRUE, include_s4_slots = TRUE) xml_targets <- xml_targets[!names(xml_targets) %in% except] missing_args <- xml_find_all(xml_targets, xpath) diff --git a/R/source_utils.R b/R/source_utils.R index 427bab0fa..b558eac61 100644 --- a/R/source_utils.R +++ b/R/source_utils.R @@ -13,12 +13,22 @@ build_xml_find_function_calls <- function(xml) { function_call_cache <- xml_find_all(xml, "//SYMBOL_FUNCTION_CALL/parent::expr") names(function_call_cache) <- get_r_string(function_call_cache, "SYMBOL_FUNCTION_CALL") - function(function_names, keep_names = FALSE) { + s4_slot_cache <- xml_find_all(xml, "//SLOT/parent::expr[following-sibling::OP-LEFT-PAREN]") + names(s4_slot_cache) <- get_r_string(s4_slot_cache, "SLOT") + + function(function_names, keep_names = FALSE, include_s4_slots = FALSE) { if (is.null(function_names)) { res <- function_call_cache } else { res <- function_call_cache[names(function_call_cache) %in% function_names] } + if (include_s4_slots) { + if (is.null(function_names)) { + res <- combine_nodesets(function_call_cache, s4_slot_cache) + } else { + res <- combine_nodesets(function_call_cache, s4_slot_cache[names(s4_slot_cache) %in% function_names]) + } + } if (keep_names) res else unname(res) } } diff --git a/tests/testthat/test-missing_argument_linter.R b/tests/testthat/test-missing_argument_linter.R index 62266e628..cea51f404 100644 --- a/tests/testthat/test-missing_argument_linter.R +++ b/tests/testthat/test-missing_argument_linter.R @@ -51,6 +51,7 @@ test_that("missing_argument_linter blocks disallowed usages", { expect_lint("stats::median(1:10, a =)", lint_msga, linter) expect_lint("env$get(1:10, a =)", lint_msga, linter) + expect_lint("env@get(1:10, a =)", lint_msga, linter) # Fixes https://github.com/r-lib/lintr/issues/906 # Comments should be ignored so that missing arguments could be From 168ee65f12bad5e382b8abbef5b7f12145c06b75 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 18:09:06 +0000 Subject: [PATCH 038/131] fix missed S4 extractions looking for preamble --- R/library_call_linter.R | 5 ++++- tests/testthat/test-library_call_linter.R | 11 +++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/R/library_call_linter.R b/R/library_call_linter.R index b87297d8e..4b67851ab 100644 --- a/R/library_call_linter.R +++ b/R/library_call_linter.R @@ -97,7 +97,10 @@ library_call_linter <- function(allow_preamble = TRUE) { upfront_call_xpath <- glue(" //SYMBOL_FUNCTION_CALL[{ attach_call_cond }][last()] /preceding::expr - /SYMBOL_FUNCTION_CALL[{ unsuppressed_call_cond }][last()] + /*[ + (self::SYMBOL_FUNCTION_CALL or self::SLOT[parent::expr/following-sibling::OP-LEFT-PAREN]) + and ({ unsuppressed_call_cond }) + ][last()] /following::expr[SYMBOL_FUNCTION_CALL[{ attach_call_cond }]] /parent::expr ") diff --git a/tests/testthat/test-library_call_linter.R b/tests/testthat/test-library_call_linter.R index aca3427c0..0a6521734 100644 --- a/tests/testthat/test-library_call_linter.R +++ b/tests/testthat/test-library_call_linter.R @@ -206,6 +206,17 @@ test_that("allow_preamble applies as intended", { expect_no_lint(lines, linter_preamble) expect_lint(lines, list(list(line_number = 2L), list(line_number = 3L)), linter_no_preamble) + # allow S4 operation to precede library() as well, equivalently to other function calls + lines <- trim_some(" + opts_chunk@set(eval = FALSE) + library(dplyr) + suppressPackageStartupMessages(library(knitr)) + + print(letters) + ") + expect_no_lint(lines, linter_preamble) + expect_lint(lines, list(list(line_number = 2L), list(line_number = 3L)), linter_no_preamble) + lines <- trim_some(" fun() library(moreFun) From 413e029972608e85dc8096675e0158ad7d985caf Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 18:12:59 +0000 Subject: [PATCH 039/131] expect_no_lint --- .../test-function_left_parentheses_linter.R | 48 +++++++++---------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/tests/testthat/test-function_left_parentheses_linter.R b/tests/testthat/test-function_left_parentheses_linter.R index 9c53df662..ff119ff85 100644 --- a/tests/testthat/test-function_left_parentheses_linter.R +++ b/tests/testthat/test-function_left_parentheses_linter.R @@ -1,27 +1,27 @@ test_that("function_left_parentheses_linter skips allowed usages", { linter <- function_left_parentheses_linter() - expect_lint("blah", NULL, linter) - expect_lint("print(blah)", NULL, linter) - expect_lint('"print"(blah)', NULL, linter) - expect_lint("base::print(blah)", NULL, linter) - expect_lint('base::"print"(blah)', NULL, linter) - expect_lint("base::print(blah, fun(1))", NULL, linter) - expect_lint("blah <- function(blah) { }", NULL, linter) - expect_lint("(1 + 1)", NULL, linter) - expect_lint("( (1 + 1) )", NULL, linter) - expect_lint("if (blah) { }", NULL, linter) - expect_lint("for (i in j) { }", NULL, linter) - expect_lint("1 * (1 + 1)", NULL, linter) - expect_lint("!(1 == 1)", NULL, linter) - expect_lint("(2 - 1):(3 - 1)", NULL, linter) - expect_lint("c(1, 2, 3)[(2 - 1)]", NULL, linter) - expect_lint("list(1, 2, 3)[[(2 - 1)]]", NULL, linter) - expect_lint("range(10)[(2 - 1):(10 - 1)]", NULL, linter) - expect_lint("function(){function(){}}()()", NULL, linter) - expect_lint("c(function(){})[1]()", NULL, linter) - expect_lint("function(x) (mean(x) + 3)", NULL, linter) - expect_lint("\"blah (1)\"", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("print(blah)", linter) + expect_no_lint('"print"(blah)', linter) + expect_no_lint("base::print(blah)", linter) + expect_no_lint('base::"print"(blah)', linter) + expect_no_lint("base::print(blah, fun(1))", linter) + expect_no_lint("blah <- function(blah) { }", linter) + expect_no_lint("(1 + 1)", linter) + expect_no_lint("( (1 + 1) )", linter) + expect_no_lint("if (blah) { }", linter) + expect_no_lint("for (i in j) { }", linter) + expect_no_lint("1 * (1 + 1)", linter) + expect_no_lint("!(1 == 1)", linter) + expect_no_lint("(2 - 1):(3 - 1)", linter) + expect_no_lint("c(1, 2, 3)[(2 - 1)]", linter) + expect_no_lint("list(1, 2, 3)[[(2 - 1)]]", linter) + expect_no_lint("range(10)[(2 - 1):(10 - 1)]", linter) + expect_no_lint("function(){function(){}}()()", linter) + expect_no_lint("c(function(){})[1]()", linter) + expect_no_lint("function(x) (mean(x) + 3)", linter) + expect_no_lint('"blah (1)"', linter) }) test_that("function_left_parentheses_linter blocks disallowed usages", { @@ -168,7 +168,7 @@ test_that("it doesn't produce invalid lints", { test_that("newline in character string doesn't trigger false positive (#1963)", { linter <- function_left_parentheses_linter() - expect_lint('foo("\n")$bar()', NULL, linter) + expect_no_lint('foo("\n")$bar()', linter) # also corrected the lint metadata for similar cases expect_lint( trim_some(' @@ -189,7 +189,7 @@ test_that("shorthand functions are handled", { linter <- function_left_parentheses_linter() fun_lint_msg <- rex::rex("Remove spaces before the left parenthesis in a function definition.") - expect_lint("blah <- \\(blah) { }", NULL, linter) - expect_lint("\\(){\\(){}}()()", NULL, linter) + expect_no_lint("blah <- \\(blah) { }", linter) + expect_no_lint("\\(){\\(){}}()()", linter) expect_lint("test <- \\ (x) { }", fun_lint_msg, linter) }) From c7cc8ac254e09337cb0e705f98117f91d4796b59 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 18:16:48 +0000 Subject: [PATCH 040/131] handle @ equivalency --- R/function_left_parentheses_linter.R | 2 +- .../test-function_left_parentheses_linter.R | 13 +++++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/R/function_left_parentheses_linter.R b/R/function_left_parentheses_linter.R index 07e4ee438..de0d9a41d 100644 --- a/R/function_left_parentheses_linter.R +++ b/R/function_left_parentheses_linter.R @@ -47,7 +47,7 @@ function_left_parentheses_linter <- function() { # nolint: object_length. # because it allows the xpath to be the same for both FUNCTION and SYMBOL_FUNCTION_CALL. # Further, write 4 separate XPaths because the 'range_end_xpath' differs for these two nodes. bad_line_fun_xpath <- "(//FUNCTION | //OP-LAMBDA)[@line1 != following-sibling::OP-LEFT-PAREN/@line1]" - bad_line_call_xpath <- "//SYMBOL_FUNCTION_CALL[@line1 != parent::expr/following-sibling::OP-LEFT-PAREN/@line1]" + bad_line_call_xpath <- "(//SYMBOL_FUNCTION_CALL | //SLOT)[@line1 != parent::expr/following-sibling::OP-LEFT-PAREN/@line1]" bad_col_fun_xpath <- "(//FUNCTION | //OP-LAMBDA)[ @line1 = following-sibling::OP-LEFT-PAREN/@line1 and @col2 != following-sibling::OP-LEFT-PAREN/@col1 - 1 diff --git a/tests/testthat/test-function_left_parentheses_linter.R b/tests/testthat/test-function_left_parentheses_linter.R index ff119ff85..e45b1b7b0 100644 --- a/tests/testthat/test-function_left_parentheses_linter.R +++ b/tests/testthat/test-function_left_parentheses_linter.R @@ -182,6 +182,19 @@ test_that("newline in character string doesn't trigger false positive (#1963)", list(line_number = 3L, column_number = 6L), linter ) + + expect_lint( + trim_some(' + ( + foo(" + ")@bar + () + ) + '), + # attach to 'b' in '@bar' + list(line_number = 3L, column_number = 6L), + linter + ) }) test_that("shorthand functions are handled", { From 4d3ff4fca896c5cc246ca471322de538cab07039 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 18:42:34 +0000 Subject: [PATCH 041/131] fix an equivalency issue in indentation_linter --- R/indentation_linter.R | 4 ++-- tests/testthat/test-indentation_linter.R | 19 +++++++++++++++++++ 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/R/indentation_linter.R b/R/indentation_linter.R index 9c57b5c74..e09b01fae 100644 --- a/R/indentation_linter.R +++ b/R/indentation_linter.R @@ -161,7 +161,7 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al glue("self::{paren_tokens_left}/following-sibling::{paren_tokens_right}/preceding-sibling::*[1]/@line2"), glue(" self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))}] - /following-sibling::SYMBOL_FUNCTION_CALL + /following-sibling::*[self::SYMBOL_FUNCTION_CALL or self::SLOT] /parent::expr /following-sibling::expr[1] /@line2 @@ -169,7 +169,7 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al glue(" self::*[ {xp_and(paste0('not(self::', paren_tokens_left, ')'))} - and not(following-sibling::SYMBOL_FUNCTION_CALL) + and not(following-sibling::*[self::SYMBOL_FUNCTION_CALL or self::SLOT]) ] /following-sibling::*[not(self::COMMENT)][1] /@line2 diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R index 229f78cbe..fdb8e5477 100644 --- a/tests/testthat/test-indentation_linter.R +++ b/tests/testthat/test-indentation_linter.R @@ -579,6 +579,25 @@ test_that("combined hanging and block indent works", { "), linter ) + + # S4 equivalence + expect_no_lint( + trim_some(" + http_head(url, ...)@ + then(function(res) { + if (res$status_code < 300) { + cli_alert_success() + } else { + cli_alert_danger() + } + })@ + catch(error = function(err) { + e <- if (grepl('timed out', err$message)) 'timed out' else 'error' + cli_alert_danger() + }) + "), + linter + ) }) test_that("hanging_indent_stlye works", { From 1d8869f232cfda75868d8fadd2d1f5e8e9cfbebb Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 19:01:41 +0000 Subject: [PATCH 042/131] new simple swap fuzzer, some nofuzz --- .dev/maybe_fuzz_content.R | 11 ++++++++--- tests/testthat/test-any_duplicated_linter.R | 2 ++ tests/testthat/test-object_usage_linter.R | 2 +- 3 files changed, 11 insertions(+), 4 deletions(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index b76edca00..8daf63fe2 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -9,7 +9,7 @@ maybe_fuzz_content <- function(file, lines) { file.copy(file, new_file, copy.mode = FALSE) } - apply_fuzzers(new_file) + apply_fuzzers(new_file, list(function_lambda_fuzzer, pipe_fuzzer, dollar_at_fuzzer)) new_file } @@ -54,16 +54,21 @@ pipe_fuzzer <- simple_swap_fuzzer( replacements = c("%>%", "|>") ) +dollar_at_fuzzer <- simple_swap_fuzzer( + \(pd) pd$token %in% c("'$'", "'@'"), + replacements = c("$", "@") +) + # we could also consider just passing any test where no fuzzing takes place, # i.e. letting the other GHA handle whether unfuzzed tests pass as expected. -apply_fuzzers <- function(f) { +apply_fuzzers <- function(f, fuzzers) { pd <- error_or_parse_data(f) if (inherits(pd, "error")) { return(invisible()) } unedited <- lines <- readLines(f) - for (fuzzer in list(function_lambda_fuzzer, pipe_fuzzer)) { + for (fuzzer in fuzzers) { updated_lines <- fuzzer(pd, lines) if (is.null(updated_lines)) next # skip some I/O if we can writeLines(updated_lines, f) diff --git a/tests/testthat/test-any_duplicated_linter.R b/tests/testthat/test-any_duplicated_linter.R index 22100b1cf..15038b0b5 100644 --- a/tests/testthat/test-any_duplicated_linter.R +++ b/tests/testthat/test-any_duplicated_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("any_duplicated_linter skips allowed usages", { linter <- any_duplicated_linter() @@ -80,3 +81,4 @@ test_that("any_duplicated_linter catches expression with two types of lint", { linter ) }) +# nofuzz end diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index d2c58371e..88bb4a1ac 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -866,7 +866,7 @@ test_that("dplyr's .env-specified objects are marked as 'used'", { skip_if_not_installed("rlang") linter <- object_usage_linter() - expect_lint( + expect_lint( # nofuzz trim_some(" foo <- function(df) { source <- 1 From 3d106d73511b506878a45649438bd0eb2f23ce40 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 19:14:25 +0000 Subject: [PATCH 043/131] add some vectorization to make debugging easier --- R/indentation_linter.R | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/R/indentation_linter.R b/R/indentation_linter.R index e09b01fae..f59e0145e 100644 --- a/R/indentation_linter.R +++ b/R/indentation_linter.R @@ -237,20 +237,19 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al is_hanging <- logical(length(indent_levels)) indent_changes <- xml_find_all(xml, xp_indent_changes) - for (change in indent_changes) { - change_type <- find_indent_type(change) - change_begin <- as.integer(xml_attr(change, "line1")) + 1L - change_end <- xml_find_num(change, xp_block_ends) - if (isTRUE(change_begin <= change_end)) { - to_indent <- seq(from = change_begin, to = change_end) - expected_indent_levels[to_indent] <- find_new_indent( - current_indent = expected_indent_levels[to_indent], - change_type = change_type, - indent = indent, - hanging_indent = as.integer(xml_attr(change, "col2")) - ) - is_hanging[to_indent] <- change_type == "hanging" - } + change_types <- vapply(indent_changes, find_indent_type, character(1L)) + change_begins <- as.integer(xml_attr(indent_changes, "line1")) + 1L + change_ends <- xml_find_num(indent_changes, xp_block_ends) + col2s <- as.integer(xml_attr(indent_changes, "col2")) + for (ii in which(change_begins <= change_ends)) { + to_indent <- seq(from = change_begins[ii], to = change_ends[ii]) + expected_indent_levels[to_indent] <- find_new_indent( + current_indent = expected_indent_levels[to_indent], + change_type = change_types[ii], + indent = indent, + hanging_indent = col2s[ii] + ) + is_hanging[to_indent] <- change_types[ii] == "hanging" } in_str_const <- logical(length(indent_levels)) From 1d196875a6ddca3c9dfa9b7f7d72cc3e8dc252da Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 19:25:38 +0000 Subject: [PATCH 044/131] another indentation inconsistency --- R/indentation_linter.R | 10 ++++++++-- tests/testthat/test-indentation_linter.R | 9 +++++++++ 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/R/indentation_linter.R b/R/indentation_linter.R index f59e0145e..3533eac39 100644 --- a/R/indentation_linter.R +++ b/R/indentation_linter.R @@ -161,7 +161,10 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al glue("self::{paren_tokens_left}/following-sibling::{paren_tokens_right}/preceding-sibling::*[1]/@line2"), glue(" self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))}] - /following-sibling::*[self::SYMBOL_FUNCTION_CALL or self::SLOT] + /following-sibling::*[ + self::SYMBOL_FUNCTION_CALL + or self::SLOT[parent::expr/following-sibling::OP-LEFT-PAREN] + ] /parent::expr /following-sibling::expr[1] /@line2 @@ -169,7 +172,10 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al glue(" self::*[ {xp_and(paste0('not(self::', paren_tokens_left, ')'))} - and not(following-sibling::*[self::SYMBOL_FUNCTION_CALL or self::SLOT]) + and not(following-sibling::*[ + self::SYMBOL_FUNCTION_CALL + or self::SLOT[parent::expr/following-sibling::OP-LEFT-PAREN] + ]) ] /following-sibling::*[not(self::COMMENT)][1] /@line2 diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R index fdb8e5477..a4e1f6a55 100644 --- a/tests/testthat/test-indentation_linter.R +++ b/tests/testthat/test-indentation_linter.R @@ -403,6 +403,15 @@ test_that("indentation with operators works", { "), linter ) + + expect_no_lint( + trim_some(" + abc@ + def@ + ghi + "), + linter + ) }) test_that("indentation with bracket works", { From dbfaf5ccda42e6a646213ba12f0740c638baf719 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 19:40:24 +0000 Subject: [PATCH 045/131] nofuzz'ing --- tests/testthat/test-is_numeric_linter.R | 6 +++++- tests/testthat/test-keyword_quote_linter.R | 4 ++-- tests/testthat/test-undesirable_operator_linter.R | 2 +- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-is_numeric_linter.R b/tests/testthat/test-is_numeric_linter.R index af61203c7..d0026e1f7 100644 --- a/tests/testthat/test-is_numeric_linter.R +++ b/tests/testthat/test-is_numeric_linter.R @@ -28,7 +28,11 @@ test_that("is_numeric_linter blocks disallowed usages involving ||", { expect_lint("is.integer(x) || is.numeric(x)", lint_msg, linter) # identical expressions match too - expect_lint("is.integer(DT$x) || is.numeric(DT$x)", lint_msg, linter) + expect_lint( # nofuzz + "is.integer(DT$x) || is.numeric(DT$x)", + lint_msg, + linter + ) # line breaks don't matter lines <- trim_some(" diff --git a/tests/testthat/test-keyword_quote_linter.R b/tests/testthat/test-keyword_quote_linter.R index a8610439b..12b53b696 100644 --- a/tests/testthat/test-keyword_quote_linter.R +++ b/tests/testthat/test-keyword_quote_linter.R @@ -113,7 +113,7 @@ test_that("keyword_quote_linter blocks quoted assignment targets", { expect_lint('1 -> "a b"', backtick_msg, linter) }) -test_that("keyword_quote_linter blocks quoted $, @ extractions", { +test_that("keyword_quote_linter blocks quoted $, @ extractions", { # nofuzz linter <- keyword_quote_linter() backtick_msg <- rex::rex("Use backticks to create non-syntactic names, not quotes.") dollar_msg <- rex::rex("Only quote targets of extraction with $ if necessary") @@ -135,7 +135,7 @@ test_that("keyword_quote_linter blocks quoted $, @ extractions", { expect_lint("x@`foo` = 1", at_msg, linter) }) -test_that("multiple lints are generated correctly", { +test_that("multiple lints are generated correctly", { # nofuzz linter <- keyword_quote_linter() expect_lint( diff --git a/tests/testthat/test-undesirable_operator_linter.R b/tests/testthat/test-undesirable_operator_linter.R index 2cd9ca483..67a3e9ac5 100644 --- a/tests/testthat/test-undesirable_operator_linter.R +++ b/tests/testthat/test-undesirable_operator_linter.R @@ -10,7 +10,7 @@ test_that("linter returns correct linting", { list(message = msg_assign, line_number = 1L, column_number = 3L), linter ) - expect_lint( + expect_lint( # nofuzz "data$parsed == c(1, 2)", list(message = msg_dollar, line_number = 1L, column_number = 5L), linter From 88117cbccef74f515f7c8f3d7e4d57834cccb435 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 19:48:33 +0000 Subject: [PATCH 046/131] complete NEWS --- NEWS.md | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 393a1e394..af6d69e88 100644 --- a/NEWS.md +++ b/NEWS.md @@ -58,7 +58,11 @@ + `library_call_linter()` + `terminal_close_linter()` + `unnecessary_lambda_linter()` -* `missing_argument_linter()` finds S4 usage like `s4Obj@method(arg = )` (#2820, @MichaelChirico). +* More consistency on handling `@` extractions (#2820, @MichaelChirico). + + `function_left_parentheses_linter()` + + `indentation_linter()` + + `library_call_linter()` + + `missing_argument_linter()` ## Notes From ee611cbe2b280dfa0a9f564b8db1b2546c8eccd5 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 19:50:18 +0000 Subject: [PATCH 047/131] more expect_no_lint --- tests/testthat/test-keyword_quote_linter.R | 50 ++++++++++------------ 1 file changed, 23 insertions(+), 27 deletions(-) diff --git a/tests/testthat/test-keyword_quote_linter.R b/tests/testthat/test-keyword_quote_linter.R index 12b53b696..b562a9ac5 100644 --- a/tests/testthat/test-keyword_quote_linter.R +++ b/tests/testthat/test-keyword_quote_linter.R @@ -2,30 +2,26 @@ test_that("keyword_quote_linter skips allowed usages", { linter <- keyword_quote_linter() # main use case: c() - expect_lint("x <- c(1, 2, 4, 5)", NULL, linter) - expect_lint("x <- c(a = 1, 2)", NULL, linter) - expect_lint("x <- c(a = 1, b = 2)", NULL, linter) - expect_lint("y <- c(`a b` = 1, `c d` = 2)", NULL, linter) - expect_lint('y <- c("a b" = 1, "c d" = 2)', NULL, linter) - expect_lint("z <- c('a b' = 1, c = 2)", NULL, linter) + expect_no_lint("x <- c(1, 2, 4, 5)", linter) + expect_no_lint("x <- c(a = 1, 2)", linter) + expect_no_lint("x <- c(a = 1, b = 2)", linter) + expect_no_lint("y <- c(`a b` = 1, `c d` = 2)", linter) + expect_no_lint('y <- c("a b" = 1, "c d" = 2)', linter) + expect_no_lint("z <- c('a b' = 1, c = 2)", linter) # don't catch strings as arguments - expect_lint('c(A = "a")', NULL, linter) + expect_no_lint('c(A = "a")', linter) # don't catch unnamed arguments - expect_lint('c(1, 2, "a")', NULL, linter) + expect_no_lint('c(1, 2, "a")', linter) # don't get thrown off by missing arguments - expect_lint("alist(`a b` =)", NULL, linter) + expect_no_lint("alist(`a b` =)", linter) # other use cases: switch() and list() - expect_lint("list(a = 1, b = list(c = 2))", NULL, linter) - expect_lint("list(`a b` = 1, c = 2:6)", NULL, linter) + expect_no_lint("list(a = 1, b = list(c = 2))", linter) + expect_no_lint("list(`a b` = 1, c = 2:6)", linter) - expect_lint("switch(x, a = 1, b = 2)", NULL, linter) - expect_lint( - "switch(x, `a b` = 1, c = 2:6)", - NULL, - linter - ) + expect_no_lint("switch(x, a = 1, b = 2)", linter) + expect_no_lint("switch(x, `a b` = 1, c = 2:6)", linter) }) test_that("keyword_quote_linter blocks simple disallowed usages", { @@ -59,9 +55,9 @@ test_that("keyword_quote_linter blocks simple disallowed usages", { test_that("keyword_quote_linter skips quoting on reserved words", { linter <- keyword_quote_linter() - expect_lint("c(`next` = 1, `while` = 2)", NULL, linter) - expect_lint("switch(x, `for` = 3, `TRUE` = 4)", NULL, linter) - expect_lint("list('NA' = 5, 'Inf' = 6)", NULL, linter) + expect_no_lint("c(`next` = 1, `while` = 2)", linter) + expect_no_lint("switch(x, `for` = 3, `TRUE` = 4)", linter) + expect_no_lint("list('NA' = 5, 'Inf' = 6)", linter) }) test_that("keyword_quote_linter works on more common functions", { @@ -91,16 +87,16 @@ test_that("keyword_quote_linter blocks quoted assignment targets", { expect_lint('"foo bar" <- 1', backtick_msg, linter) expect_lint("'foo bar' = 1", backtick_msg, linter) # valid choice: use backticks - expect_lint("`foo bar` = 1", NULL, linter) + expect_no_lint("`foo bar` = 1", linter) expect_lint('"foo" <- 1', assign_msg, linter) expect_lint("'foo' = 1", assign_msg, linter) expect_lint("`foo` = 1", assign_msg, linter) # don't include data.table assignments - expect_lint('DT[, "a" := 1]', NULL, linter) - expect_lint("DT[, 'a' := 1]", NULL, linter) - expect_lint("DT[, `a` := 1]", NULL, linter) + expect_no_lint('DT[, "a" := 1]', linter) + expect_no_lint("DT[, 'a' := 1]", linter) + expect_no_lint("DT[, `a` := 1]", linter) # include common use cases: [<-/$ methods and infixes expect_lint('"$.my_class" <- function(x, key) { }', backtick_msg, linter) @@ -109,7 +105,7 @@ test_that("keyword_quote_linter blocks quoted assignment targets", { # right assignment expect_lint('1 -> "foo"', assign_msg, linter) - expect_lint("1 -> foo", NULL, linter) + expect_no_lint("1 -> foo", linter) expect_lint('1 -> "a b"', backtick_msg, linter) }) @@ -124,8 +120,8 @@ test_that("keyword_quote_linter blocks quoted $, @ extractions", { # nofuzz expect_lint('x@"foo bar" <- 1', backtick_msg, linter) expect_lint("x@'foo bar' = 1", backtick_msg, linter) # valid choice: non-syntactic name with backticks - expect_lint("x@`foo bar` <- 1", NULL, linter) - expect_lint("x@`foo bar` = 1", NULL, linter) + expect_no_lint("x@`foo bar` <- 1", linter) + expect_no_lint("x@`foo bar` = 1", linter) expect_lint('x$"foo" <- 1', dollar_msg, linter) expect_lint("x$'foo' = 1", dollar_msg, linter) From aa756e6c70ae3cff2a02e148f4ada6e366fa129f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 19:53:34 +0000 Subject: [PATCH 048/131] more expect_no_lint --- tests/testthat/test-object_usage_linter.R | 150 +++++++++++----------- 1 file changed, 76 insertions(+), 74 deletions(-) diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index 88bb4a1ac..cd9172619 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -2,20 +2,19 @@ test_that("returns the correct linting", { linter <- object_usage_linter() local_var_msg <- rex::rex("local variable", anything, "assigned but may not be used") - expect_lint("blah", NULL, linter) + expect_no_lint("blah", linter) - expect_lint( + expect_no_lint( trim_some(" function() { a <- 1 a } "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" fun <- function(x) { fun(1) @@ -24,7 +23,6 @@ test_that("returns the correct linting", { fun2(2) } "), - NULL, linter ) @@ -154,22 +152,20 @@ test_that("replace_functions_stripped", { }) test_that("eval errors are ignored", { - expect_lint( + expect_no_lint( trim_some(' setMethod("[[<-", c("stampedEnv", "character", "missing"), function(x) { x }) '), - NULL, object_usage_linter() ) }) test_that("calls with top level function definitions are ignored", { - expect_lint( + expect_no_lint( 'tryCatch("foo", error = function(e) e)', - NULL, object_usage_linter() ) }) @@ -191,7 +187,7 @@ test_that("object-usage line-numbers are relative to start-of-file", { test_that("used symbols are detected correctly", { # From #666 - expect_lint( + expect_no_lint( trim_some(' foo <- data.frame(0) foo$bar <- 1 @@ -200,7 +196,6 @@ test_that("used symbols are detected correctly", { } message(zero()) '), - NULL, object_usage_linter() ) @@ -217,7 +212,7 @@ test_that("used symbols are detected correctly", { ) # Also test deeper nesting - expect_lint( + expect_no_lint( trim_some(' foo <- list(0) foo$bar$baz$goo <- 1 @@ -229,12 +224,11 @@ test_that("used symbols are detected correctly", { } message(zero()) '), - NULL, object_usage_linter() ) # Test alternative assignment and access methods - expect_lint( + expect_no_lint( trim_some(' foo <- list(0) foo[["bar"]][["baz"]][["goo"]] <- 1 @@ -249,14 +243,13 @@ test_that("used symbols are detected correctly", { } message(zero()) '), - NULL, object_usage_linter() ) # regression #1322 - expect_silent(expect_lint("assign('x', 42)", NULL, object_usage_linter())) + expect_silent(expect_no_lint("assign('x', 42)", object_usage_linter())) }) test_that("object_usage_linter finds lints spanning multiple lines", { @@ -312,7 +305,7 @@ test_that("global variable detection works", { utils::globalVariables("global_function", package = globalenv()) on.exit(utils::globalVariables(old_globals, package = globalenv(), add = FALSE)) - expect_lint( + expect_no_lint( trim_some(" foo <- function() { if (global_function()) NULL @@ -322,7 +315,6 @@ test_that("global variable detection works", { } } "), - NULL, object_usage_linter() ) }) @@ -335,9 +327,8 @@ test_that("package detection works", { }) test_that("robust against errors", { - expect_lint( + expect_no_lint( 'assign("x", unknown_function)', - NULL, object_usage_linter() ) }) @@ -345,47 +336,62 @@ test_that("robust against errors", { test_that("interprets glue expressions", { linter <- object_usage_linter() - expect_lint(trim_some(" - fun <- function() { - local_var <- 42 - glue::glue('The answer is {local_var}.') - } - "), NULL, linter) + expect_no_lint( + trim_some(" + fun <- function() { + local_var <- 42 + glue::glue('The answer is {local_var}.') + } + "), + linter + ) # no need for namespace-qualification - expect_lint(trim_some(" - glue <- glue::glue # imitate this being an @import - fun <- function() { - local_var <- 42 - glue('The answer is {local_var}.') - } - "), NULL, linter) + expect_no_lint( + trim_some(" + glue <- glue::glue # imitate this being an @import + fun <- function() { + local_var <- 42 + glue('The answer is {local_var}.') + } + "), + linter + ) # multiple variables in different interpolations - expect_lint(trim_some(" - fun <- function() { - local_key <- 'a' - local_value <- 123 - glue::glue('Key-value pair: {local_key}={local_value}.') - } - "), NULL, linter) + expect_no_lint( + trim_some(" + fun <- function() { + local_key <- 'a' + local_value <- 123 + glue::glue('Key-value pair: {local_key}={local_value}.') + } + "), + linter + ) # multiple variables in single interpolation - expect_lint(trim_some(" - fun <- function() { - local_str1 <- 'a' - local_str2 <- 'b' - glue::glue('With our powers combined: {paste(local_str1, local_str2)}.') - } - "), NULL, linter) + expect_no_lint( + trim_some(" + fun <- function() { + local_str1 <- 'a' + local_str2 <- 'b' + glue::glue('With our powers combined: {paste(local_str1, local_str2)}.') + } + "), + linter + ) # Check non-standard .open and .close - expect_lint(trim_some(" - fun <- function() { - local_var <- 42 - glue::glue('The answer is $[local_var].', .open = '$[', .close = ']') - } - "), NULL, linter) + expect_no_lint( + trim_some(" + fun <- function() { + local_var <- 42 + glue::glue('The answer is $[local_var].', .open = '$[', .close = ']') + } + "), + linter + ) # Steer clear of custom .transformer and .envir constructs expect_lint(trim_some(" @@ -434,13 +440,16 @@ test_that("interprets glue expressions", { ) # ditto infix operator - expect_lint(trim_some(" - glue <- glue::glue # imitate this being an @import - foo <- function() { - `%++%` <- `+` - glue('{x %++% y}') - } - "), NULL, linter) + expect_no_lint( + trim_some(" + glue <- glue::glue # imitate this being an @import + foo <- function() { + `%++%` <- `+` + glue('{x %++% y}') + } + "), + linter + ) }) test_that("errors/edge cases in glue syntax don't fail lint()", { @@ -448,7 +457,7 @@ test_that("errors/edge cases in glue syntax don't fail lint()", { # no lint & no error, despite glue error expect_warning( - expect_lint( + expect_no_lint( trim_some(" fun <- function() { a <- 2 @@ -456,7 +465,6 @@ test_that("errors/edge cases in glue syntax don't fail lint()", { glue::glue('The answer is {a') } "), - NULL, linter ), "Evaluating glue expression.*failed: Expecting '\\}'.*Please ensure correct glue syntax" @@ -490,19 +498,18 @@ test_that("errors/edge cases in glue syntax don't fail lint()", { ) # empty glue expression {} - expect_lint( + expect_no_lint( trim_some(" fun <- function() { a <- 2 glue::glue('The answer is {}: {a}') } "), - NULL, linter ) # comment inside glue range (#1919) - expect_lint( + expect_no_lint( trim_some(" fun <- function() { a <- 2 @@ -511,7 +518,6 @@ test_that("errors/edge cases in glue syntax don't fail lint()", { ) } "), - NULL, linter ) }) @@ -539,7 +545,7 @@ test_that("backtick'd names in glue are handled", { # reported as #1088 test_that("definitions below top level are ignored (for now)", { - expect_lint( + expect_no_lint( trim_some(" local({ x <- 1 @@ -548,7 +554,6 @@ test_that("definitions below top level are ignored (for now)", { } }) "), - NULL, object_usage_linter() ) }) @@ -567,7 +572,7 @@ test_that("package imports are detected if present in file", { object_usage_linter() ) - expect_lint( + expect_no_lint( trim_some(" library(xml2) @@ -576,7 +581,6 @@ test_that("package imports are detected if present in file", { a } "), - NULL, object_usage_linter() ) }) @@ -640,7 +644,7 @@ test_that("respects `skip_with` argument for `with()` expressions", { }) test_that("missing libraries don't cause issue", { - expect_lint( + expect_no_lint( trim_some(" library(a.a.a.z.z.z) foo <- function() { @@ -648,7 +652,6 @@ test_that("missing libraries don't cause issue", { a } "), - NULL, object_usage_linter() ) }) @@ -842,7 +845,7 @@ test_that("messages without location info are repaired", { test_that("globals in scripts are found regardless of assignment operator", { linter <- object_usage_linter() - expect_lint( + expect_no_lint( trim_some(" library(dplyr) @@ -856,7 +859,6 @@ test_that("globals in scripts are found regardless of assignment operator", { mutate(power = global_const_eq + global_const_ra + global_const_la) } "), - NULL, linter ) }) From c3a99ce41c419a5f9f4141efac4c83d8aed36a27 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 21:05:29 +0000 Subject: [PATCH 049/131] add tests of include_s4_slots --- tests/testthat/test-get_source_expressions.R | 41 ++++++++++++++------ 1 file changed, 29 insertions(+), 12 deletions(-) diff --git a/tests/testthat/test-get_source_expressions.R b/tests/testthat/test-get_source_expressions.R index bbda9d362..975a152a2 100644 --- a/tests/testthat/test-get_source_expressions.R +++ b/tests/testthat/test-get_source_expressions.R @@ -255,7 +255,14 @@ test_that("returned data structure is complete", { }) test_that("xml_find_function_calls works as intended", { - lines <- c("foo()", "bar()", "foo()", "{ foo(); foo(); bar() }") + lines <- c( + "foo()", + "bar()", + "foo()", + "s4Obj@baz()", + "{ foo(); foo(); bar(); s4Obj@baz() }", + NULL + ) temp_file <- withr::local_tempfile(lines = lines) exprs <- get_source_expressions(temp_file) @@ -270,30 +277,40 @@ test_that("xml_find_function_calls works as intended", { expect_length(exprs$expressions[[2L]]$xml_find_function_calls("foo"), 0L) expect_length(exprs$expressions[[2L]]$xml_find_function_calls("bar"), 1L) - expect_length(exprs$expressions[[4L]]$xml_find_function_calls("foo"), 2L) - expect_length(exprs$expressions[[4L]]$xml_find_function_calls("bar"), 1L) - expect_length(exprs$expressions[[4L]]$xml_find_function_calls(c("foo", "bar")), 3L) + expect_length(exprs$expressions[[5L]]$xml_find_function_calls("foo"), 2L) + expect_length(exprs$expressions[[5L]]$xml_find_function_calls("bar"), 1L) + expect_length(exprs$expressions[[5L]]$xml_find_function_calls(c("foo", "bar")), 3L) # file-level source expression contains all function calls - expect_length(exprs$expressions[[5L]]$xml_find_function_calls("foo"), 4L) - expect_length(exprs$expressions[[5L]]$xml_find_function_calls("bar"), 2L) - expect_length(exprs$expressions[[5L]]$xml_find_function_calls(c("foo", "bar")), 6L) + expect_length(exprs$expressions[[6L]]$xml_find_function_calls("foo"), 4L) + expect_length(exprs$expressions[[6L]]$xml_find_function_calls("bar"), 2L) + expect_length(exprs$expressions[[6L]]$xml_find_function_calls(c("foo", "bar")), 6L) # Also check order is retained: expect_identical( - exprs$expressions[[5L]]$xml_find_function_calls(c("foo", "bar")), - xml_find_all(exprs$expressions[[5L]]$full_xml_parsed_content, "//SYMBOL_FUNCTION_CALL/parent::expr") + exprs$expressions[[6L]]$xml_find_function_calls(c("foo", "bar")), + xml_find_all(exprs$expressions[[6L]]$full_xml_parsed_content, "//SYMBOL_FUNCTION_CALL/parent::expr") ) # Check naming and full cache expect_identical( - exprs$expressions[[5L]]$xml_find_function_calls(NULL), - exprs$expressions[[5L]]$xml_find_function_calls(c("foo", "bar")) + exprs$expressions[[6L]]$xml_find_function_calls(NULL), + exprs$expressions[[6L]]$xml_find_function_calls(c("foo", "bar")) ) expect_named( - exprs$expressions[[4L]]$xml_find_function_calls(c("foo", "bar"), keep_names = TRUE), + exprs$expressions[[5L]]$xml_find_function_calls(c("foo", "bar"), keep_names = TRUE), c("foo", "foo", "bar") ) + + # include_s4_slots + expect_identical( + exprs$expressions[[6L]]$xml_find_function_calls(NULL, include_s4_slots = TRUE), + exprs$expressions[[6L]]$xml_find_function_calls(c("foo", "bar", "baz"), include_s4_slots = TRUE) + ) + expect_named( + exprs$expressions[[5L]]$xml_find_function_calls(NULL, keep_names = TRUE, include_s4_slots = TRUE), + c("foo", "foo", "bar", "baz") + ) }) test_that("#1262: xml_parsed_content gets returned as missing even if there's no parsed_content", { From 5893b8c390fa73440c8dc34c145349662da649e8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:03:33 +0000 Subject: [PATCH 050/131] initial try, let's see --- .dev/maybe_fuzz_content.R | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 8daf63fe2..77457cc25 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -9,7 +9,7 @@ maybe_fuzz_content <- function(file, lines) { file.copy(file, new_file, copy.mode = FALSE) } - apply_fuzzers(new_file, list(function_lambda_fuzzer, pipe_fuzzer, dollar_at_fuzzer)) + apply_fuzzers(new_file, list(function_lambda_fuzzer, pipe_fuzzer, dollar_at_fuzzer, comment_injection_fuzzer)) new_file } @@ -59,6 +59,27 @@ dollar_at_fuzzer <- simple_swap_fuzzer( replacements = c("$", "@") ) +comment_injection_fuzzer <- function(pd, lines) { + terminal_token_idx <- which(pd$terminal & !pd$token == "COMMENT") + injection_count <- sample(0:length(terminal_token_idx), 1L) + + if (injection_count == 0L) { + return(invisible()) + } + + terminal_token_idx <- sort(sample(terminal_token_idx, injection_count)) + + for (ii in rev(terminal_token_idx)) { + line <- lines[pd$line2[ii]] + lines[pd$line2[ii]] <- paste0( + substr(line, 1L, pd$col2[ii]), + "# INJECTED COMMENT\n", + substr(line, pd$col2[ii] + 1L, nchar(line)) + ) + } + lines +} + # we could also consider just passing any test where no fuzzing takes place, # i.e. letting the other GHA handle whether unfuzzed tests pass as expected. apply_fuzzers <- function(f, fuzzers) { From 8a83c01e9215541f0b00e995829ff4bb00bc2a8f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:09:16 +0000 Subject: [PATCH 051/131] adversarial comment protection --- R/vector_logic_linter.R | 2 +- tests/testthat/test-vector_logic_linter.R | 102 +++++++++++++--------- 2 files changed, 60 insertions(+), 44 deletions(-) diff --git a/R/vector_logic_linter.R b/R/vector_logic_linter.R index adc17d9ab..689a9e477 100644 --- a/R/vector_logic_linter.R +++ b/R/vector_logic_linter.R @@ -100,7 +100,7 @@ vector_logic_linter <- function() { and not(preceding-sibling::OP-LEFT-BRACKET) and not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB and text() = 'circular']) ] - /*[2] + /*[not(self::COMMENT)][2] " Linter(linter_level = "expression", function(source_expression) { diff --git a/tests/testthat/test-vector_logic_linter.R b/tests/testthat/test-vector_logic_linter.R index 6afaafbd4..d9d5d2f20 100644 --- a/tests/testthat/test-vector_logic_linter.R +++ b/tests/testthat/test-vector_logic_linter.R @@ -1,30 +1,31 @@ test_that("vector_logic_linter skips allowed usages", { linter <- vector_logic_linter() - expect_lint("if (TRUE) 5 else if (TRUE) 2", NULL, linter) - expect_lint("if (TRUE || FALSE) 1; while (TRUE && FALSE) 2", NULL, linter) + expect_no_lint("if (TRUE) 5 else if (TRUE) 2", linter) + expect_no_lint("if (TRUE || FALSE) 1; while (TRUE && FALSE) 2", linter) # function calls and extractions may aggregate to scalars -- only catch # usages at the highest logical level - expect_lint("if (agg_function(x & y)) 1", NULL, linter) - expect_lint("if (DT[x | y, cond]) 1", NULL, linter) + expect_no_lint("if (agg_function(x & y)) 1", linter) + expect_no_lint("if (DT[x | y, cond]) 1", linter) # don't match potentially OK usages nested within calls - expect_lint("if (TRUE && any(TRUE | FALSE)) 4", NULL, linter) + expect_no_lint("if (TRUE && any(TRUE | FALSE)) 4", linter) # even if the usage is nested in those calls (b/181915948) - expect_lint("if (TRUE && any(TRUE | FALSE | TRUE)) 4", NULL, linter) + expect_no_lint("if (TRUE && any(TRUE | FALSE | TRUE)) 4", linter) # don't match potentially OK usages in the branch itself - lines <- trim_some(" - if (TRUE) { - x | y - } - ") - expect_lint(lines, NULL, linter) - + expect_no_lint( + trim_some(" + if (TRUE) { + x | y + } + "), + linter + ) # valid nested usage within aggregator - expect_lint("testthat::expect_false(any(TRUE | TRUE))", NULL, linter) + expect_no_lint("testthat::expect_false(any(TRUE | TRUE))", linter) }) test_that("vector_logic_linter blocks simple disallowed usages", { @@ -63,7 +64,7 @@ test_that("vector_logic_linter catches usages in expect_true()/expect_false()", }) test_that("vector_logic_linter doesn't get mixed up from complex usage", { - expect_lint( + expect_no_lint( trim_some(" if (a) { expect_true(ok) @@ -71,7 +72,6 @@ test_that("vector_logic_linter doesn't get mixed up from complex usage", { a | b } "), - NULL, vector_logic_linter() ) }) @@ -79,25 +79,25 @@ test_that("vector_logic_linter doesn't get mixed up from complex usage", { test_that("vector_logic_linter recognizes some false positves around bitwise &/|", { linter <- vector_logic_linter() - expect_lint("if (info & as.raw(12)) { }", NULL, linter) - expect_lint("if (as.raw(12) & info) { }", NULL, linter) - expect_lint("if (info | as.raw(12)) { }", NULL, linter) - expect_lint("if (info & as.octmode('100')) { }", NULL, linter) - expect_lint("if (info | as.octmode('011')) { }", NULL, linter) - expect_lint("if (info & as.hexmode('100')) { }", NULL, linter) - expect_lint("if (info | as.hexmode('011')) { }", NULL, linter) + expect_no_lint("if (info & as.raw(12)) { }", linter) + expect_no_lint("if (as.raw(12) & info) { }", linter) + expect_no_lint("if (info | as.raw(12)) { }", linter) + expect_no_lint("if (info & as.octmode('100')) { }", linter) + expect_no_lint("if (info | as.octmode('011')) { }", linter) + expect_no_lint("if (info & as.hexmode('100')) { }", linter) + expect_no_lint("if (info | as.hexmode('011')) { }", linter) # implicit as.octmode() coercion - expect_lint("if (info & '100') { }", NULL, linter) - expect_lint("if (info | '011') { }", NULL, linter) - expect_lint("if ('011' | info) { }", NULL, linter) + expect_no_lint("if (info & '100') { }", linter) + expect_no_lint("if (info | '011') { }", linter) + expect_no_lint("if ('011' | info) { }", linter) # further nesting - expect_lint("if ((info & as.raw(12)) == as.raw(12)) { }", NULL, linter) - expect_lint("if ((info | as.raw(12)) == as.raw(12)) { }", NULL, linter) - expect_lint('if ((mode & "111") != as.octmode("111")) { }', NULL, linter) - expect_lint('if ((mode | "111") != as.octmode("111")) { }', NULL, linter) - expect_lint('if ((mode & "111") != as.hexmode("111")) { }', NULL, linter) - expect_lint('if ((mode | "111") != as.hexmode("111")) { }', NULL, linter) + expect_no_lint("if ((info & as.raw(12)) == as.raw(12)) { }", linter) + expect_no_lint("if ((info | as.raw(12)) == as.raw(12)) { }", linter) + expect_no_lint('if ((mode & "111") != as.octmode("111")) { }', linter) + expect_no_lint('if ((mode | "111") != as.octmode("111")) { }', linter) + expect_no_lint('if ((mode & "111") != as.hexmode("111")) { }', linter) + expect_no_lint('if ((mode | "111") != as.hexmode("111")) { }', linter) }) test_that("incorrect subset/filter usage is caught", { @@ -128,10 +128,29 @@ test_that("subsetting logic handles nesting", { expect_lint("filter(x, a & b || c)", or_msg, linter) expect_lint("filter(x, a && b | c)", and_msg, linter) + # adversarial commenting + expect_lint( + trim_some(" + filter(x, a #comment + && b | c) + "), + and_msg, + linter + ) + + expect_lint( + trim_some(" + filter(x, a && #comment + b | c) + "), + and_msg, + linter + ) + # but not valid usage - expect_lint("filter(x, y < mean(y, na.rm = AA && BB))", NULL, linter) - expect_lint("subset(x, y < mean(y, na.rm = AA && BB) & y > 0)", NULL, linter) - expect_lint("subset(x, y < x[y > 0, drop = AA && BB, y])", NULL, linter) + expect_no_lint("filter(x, y < mean(y, na.rm = AA && BB))", linter) + expect_no_lint("subset(x, y < mean(y, na.rm = AA && BB) & y > 0)", linter) + expect_no_lint("subset(x, y < x[y > 0, drop = AA && BB, y])", linter) }) test_that("filter() handling is conservative about stats::filter()", { @@ -139,35 +158,32 @@ test_that("filter() handling is conservative about stats::filter()", { and_msg <- rex::rex("Use `&` in subsetting expressions") # NB: this should be invalid, filter= is a vector argument - expect_lint("stats::filter(x, y && z)", NULL, linter) + expect_no_lint("stats::filter(x, y && z)", linter) # The only logical argument to stats::filter(), exclude by keyword - expect_lint("filter(x, circular = y && z)", NULL, linter) + expect_no_lint("filter(x, circular = y && z)", linter) # But presence of circular= doesn't invalidate lint expect_lint("filter(x, circular = TRUE, y && z)", and_msg, linter) expect_lint("filter(x, y && z, circular = TRUE)", and_msg, linter) - expect_lint( + expect_no_lint( trim_some(" filter(x, circular # comment = y && z) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" filter(x, circular = # comment y && z) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" filter(x, circular # comment = # comment y && z) "), - NULL, linter ) }) From 836bf31f1395be2b5863f121fb97d37f49716ecb Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:48:18 +0000 Subject: [PATCH 052/131] expect_no_lint --- tests/testthat/test-unreachable_code_linter.R | 65 ++++++++----------- 1 file changed, 26 insertions(+), 39 deletions(-) diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index b54d3b11e..26d84bc5b 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -4,7 +4,7 @@ test_that("unreachable_code_linter works in simple function", { return(bar) } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) test_that("unreachable_code_linter works in sub expressions", { @@ -70,7 +70,7 @@ test_that("unreachable_code_linter works in sub expressions", { } ") - expect_lint(lines, NULL, linter) + expect_no_lint(lines, linter) lines <- trim_some(" foo <- function(bar) { @@ -163,7 +163,7 @@ test_that("unreachable_code_linter works with next and break in sub expressions" } ") - expect_lint(lines, NULL, linter) + expect_no_lint(lines, linter) lines <- trim_some(" foo <- function(bar) { @@ -198,11 +198,11 @@ test_that("unreachable_code_linter works with next and break in sub expressions" }) test_that("unreachable_code_linter ignores expressions that aren't functions", { - expect_lint("x + 1", NULL, unreachable_code_linter()) + expect_no_lint("x + 1", unreachable_code_linter()) }) test_that("unreachable_code_linter ignores anonymous/inline functions", { - expect_lint("lapply(rnorm(10), function(x) x + 1)", NULL, unreachable_code_linter()) + expect_no_lint("lapply(rnorm(10), function(x) x + 1)", unreachable_code_linter()) }) test_that("unreachable_code_linter passes on multi-line functions", { @@ -212,7 +212,7 @@ test_that("unreachable_code_linter passes on multi-line functions", { return(y) } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) test_that("unreachable_code_linter ignores comments on the same expression", { @@ -223,7 +223,7 @@ test_that("unreachable_code_linter ignores comments on the same expression", { ) # y^3 } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) test_that("unreachable_code_linter ignores comments on the same line", { @@ -232,7 +232,7 @@ test_that("unreachable_code_linter ignores comments on the same line", { return(y^2) # y^3 } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) test_that("unreachable_code_linter identifies simple unreachable code", { @@ -349,7 +349,7 @@ test_that("unreachable_code_linter finds code after stop()", { test_that("unreachable_code_linter ignores code after foo$stop(), which might be stopping a subprocess, for example", { linter <- unreachable_code_linter() - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { bar <- get_process() @@ -357,10 +357,9 @@ test_that("unreachable_code_linter ignores code after foo$stop(), which might be TRUE } "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { bar <- get_process() @@ -368,7 +367,6 @@ test_that("unreachable_code_linter ignores code after foo$stop(), which might be TRUE } "), - NULL, linter ) }) @@ -381,7 +379,7 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { lintr.exclude_end = "#\\s*TestNoLintEnd" )) - expect_lint( + expect_no_lint( trim_some(" foo <- function() { do_something @@ -391,11 +389,10 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { # TestNoLintEnd } "), - NULL, list(linter, one_linter = assignment_linter()) ) - expect_lint( + expect_no_lint( trim_some(" foo <- function() { do_something @@ -405,7 +402,6 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { # TestNoLintEnd } "), - NULL, linter ) }) @@ -593,14 +589,14 @@ test_that("function shorthand is handled", { test_that("Do not lint inline else after stop", { - expect_lint("if (x > 3L) stop() else x + 3", NULL, unreachable_code_linter()) + expect_no_lint("if (x > 3L) stop() else x + 3", unreachable_code_linter()) }) test_that("Do not lint inline else after stop in inline function", { linter <- unreachable_code_linter() - expect_lint("function(x) if (x > 3L) stop() else x + 3", NULL, linter) - expect_lint("function(x) if (x > 3L) { stop() } else {x + 3}", NULL, linter) + expect_no_lint("function(x) if (x > 3L) stop() else x + 3", linter) + expect_no_lint("function(x) if (x > 3L) { stop() } else {x + 3}", linter) }) test_that("Do not lint inline else after stop in inline lambda function", { @@ -608,8 +604,8 @@ test_that("Do not lint inline else after stop in inline lambda function", { linter <- unreachable_code_linter() - expect_lint("\\(x) if (x > 3L) stop() else x + 3", NULL, linter) - expect_lint("\\(x){ if (x > 3L) stop() else x + 3 }", NULL, linter) + expect_no_lint("\\(x) if (x > 3L) stop() else x + 3", linter) + expect_no_lint("\\(x){ if (x > 3L) stop() else x + 3 }", linter) }) test_that("allow_comment_regex= works", { @@ -619,18 +615,17 @@ test_that("allow_comment_regex= works", { linter_xxxx <- unreachable_code_linter(allow_comment_regex = "#.*xxxx") linter_x1x2 <- unreachable_code_linter(allow_comment_regex = c("#x", "#y")) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # nocov end } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -638,22 +633,20 @@ test_that("allow_comment_regex= works", { # nocov end } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # ABCDxxxx } "), - NULL, linter_xxxx ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -661,22 +654,20 @@ test_that("allow_comment_regex= works", { # ABCDxxxx } "), - NULL, linter_xxxx ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) #x } "), - NULL, linter_x1x2 ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -684,12 +675,11 @@ test_that("allow_comment_regex= works", { #yDEF } "), - NULL, linter_x1x2 ) # might contain capture groups, #2678 - expect_lint( + expect_no_lint( trim_some(" function() { stop('a') @@ -697,7 +687,6 @@ test_that("allow_comment_regex= works", { # ab } "), - NULL, unreachable_code_linter(allow_comment_regex = "#\\s*(a|ab|abc)") ) }) @@ -710,18 +699,17 @@ test_that("allow_comment_regex= obeys covr's custom exclusion when set", { linter_covr <- unreachable_code_linter() - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # TestNoCovEnd } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -729,7 +717,6 @@ test_that("allow_comment_regex= obeys covr's custom exclusion when set", { # TestNoCovEnd } "), - NULL, linter_covr ) }) From f0974d9f4e1b14f4de2292047aea7e01538d4780 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:53:50 +0000 Subject: [PATCH 053/131] caught true false positive --- R/unnecessary_placeholder_linter.R | 2 +- tests/testthat/test-unnecessary_placeholder_linter.R | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/R/unnecessary_placeholder_linter.R b/R/unnecessary_placeholder_linter.R index c032fc591..d270dfb72 100644 --- a/R/unnecessary_placeholder_linter.R +++ b/R/unnecessary_placeholder_linter.R @@ -45,7 +45,7 @@ unnecessary_placeholder_linter <- function() { ] /expr[2][ SYMBOL[text() = '.'] - and not(preceding-sibling::*[1][self::EQ_SUB]) + and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) ] ") diff --git a/tests/testthat/test-unnecessary_placeholder_linter.R b/tests/testthat/test-unnecessary_placeholder_linter.R index 8ee413a4b..d69cbf3ed 100644 --- a/tests/testthat/test-unnecessary_placeholder_linter.R +++ b/tests/testthat/test-unnecessary_placeholder_linter.R @@ -53,3 +53,13 @@ test_that("lints vectorize", { # nofuzz unnecessary_placeholder_linter() ) }) + +test_that("logic survives adversarial commenting", { + expect_no_lint( + trim_some(" + x %T>% foo(arg = # comment + .) + "), + unnecessary_placeholder_linter() + ) +}) From a0dc171f836049b377480b2921fb4fc1caf9651b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:54:05 +0000 Subject: [PATCH 054/131] some nofuzz --- R/vector_logic_linter.R | 2 +- tests/testthat/test-unreachable_code_linter.R | 70 ++++++++++--------- 2 files changed, 37 insertions(+), 35 deletions(-) diff --git a/R/vector_logic_linter.R b/R/vector_logic_linter.R index 689a9e477..029b23a33 100644 --- a/R/vector_logic_linter.R +++ b/R/vector_logic_linter.R @@ -77,7 +77,7 @@ vector_logic_linter <- function() { and preceding-sibling::*[ self::IF or self::WHILE - or self::expr[SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'expect_false']] + or self::expr/SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'expect_false'] ] ] and not(ancestor::expr[ diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index 26d84bc5b..0b62e1b96 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -55,22 +55,23 @@ test_that("unreachable_code_linter works in sub expressions", { linter ) - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - return(bar) # Test comment - } - while (bar) { - return(bar) # 5 + 3 - } - repeat { - return(bar) # Test comment - } - - } - ") + expect_no_lint( # nofuzz + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar) # Test comment + } + while (bar) { + return(bar) # 5 + 3 + } + repeat { + return(bar) # Test comment + } - expect_no_lint(lines, linter) + } + "), + linter + ) lines <- trim_some(" foo <- function(bar) { @@ -144,26 +145,27 @@ test_that("unreachable_code_linter works with next and break in sub expressions" linter ) - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - break # Test comment - } else { - next # Test comment - } - while (bar) { - next # 5 + 3 - } - repeat { - next # Test comment - } - for(i in 1:3) { - break # 5 + 4 + expect_no_lint( # nofuzz + trim_some(" + foo <- function(bar) { + if (bar) { + break # Test comment + } else { + next # Test comment + } + while (bar) { + next # 5 + 3 + } + repeat { + next # Test comment + } + for(i in 1:3) { + break # 5 + 4 + } } - } - ") - - expect_no_lint(lines, linter) + "), + linter + ) lines <- trim_some(" foo <- function(bar) { From 4fc370d03632f58ce0d0cca1464b82cdc0a48e2e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:54:19 +0000 Subject: [PATCH 055/131] don't break up calls; report the actual content --- .dev/ast_fuzz_test.R | 27 ++++++++++++++++++++++++++- .dev/maybe_fuzz_content.R | 4 +++- 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index c08976976..3494d4549 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -34,6 +34,30 @@ writeLines( ), expect_lint_file ) + +# Ensure the fuzzed contents are always visible to facilitate backing out which fuzzed content is at issue +contents <- readLines(expect_lint_file) +wrong_number_def_idx <- grep('wrong_number_fmt <- "got %d lints instead of %d%s"', contents, fixed = TRUE) +wrong_number_use_idx <- grep("sprintf(wrong_number_fmt,", contents, fixed = TRUE) +if ( + length(wrong_number_def_idx) != 1L || + length(wrong_number_use_idx) == 0L || + # these lines should be self-contained & have no comments + !all(endsWith(contents[wrong_number_use_idx], ")")) || + inherits(tryCatch(parse(text = contents[wrong_number_use_idx]), error = identity), "error") +) { + stop(sprintf( + "Please update this workflow -- need wrong_number_fmt to be easily replaced in file '%s'.", + expect_lint_file + )) +} + +contents[wrong_number_def_idx] <- + 'wrong_number_fmt <- "got %d lints instead of %d%s\\nFile contents:\\n%s"' +contents[wrong_number_use_idx] <- + gsub("\\)$", ", readChar(file, file.size(file)))", contents[wrong_number_use_idx]) +writeLines(contents, expect_lint_file) + # Not useful in CI but good when running locally. withr::defer({ writeLines(original, expect_lint_file) @@ -116,7 +140,8 @@ failures <- reporter$failures$as_list() valid_failure <- vapply( failures, function(failure) { - if (grepl("(column_number|ranges|line) .* did not match", failure$message)) { + # line_number is for the comment injection fuzzer, which adds newlines. + if (grepl("(column_number|ranges|line|line_number) .* did not match", failure$message)) { return(TRUE) } FALSE diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 77457cc25..97c6e8599 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -60,7 +60,9 @@ dollar_at_fuzzer <- simple_swap_fuzzer( ) comment_injection_fuzzer <- function(pd, lines) { - terminal_token_idx <- which(pd$terminal & !pd$token == "COMMENT") + # injecting comment before a call often structurally breaks parsing + # (SYMBOL_FUNCTION_CALL-->SYMBOL), so avoid + terminal_token_idx <- which(pd$terminal & !pd$token %in% c("COMMENT", "SYMBOL_FUNCTION_CALL", "SLOT")) injection_count <- sample(0:length(terminal_token_idx), 1L) if (injection_count == 0L) { From c130bf48b1e699728f9d03e41cc7588a36bc56e9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 23:45:09 +0000 Subject: [PATCH 056/131] nofuzz --- tests/testthat/test-unnecessary_nesting_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-unnecessary_nesting_linter.R b/tests/testthat/test-unnecessary_nesting_linter.R index c48383e64..5bfa80528 100644 --- a/tests/testthat/test-unnecessary_nesting_linter.R +++ b/tests/testthat/test-unnecessary_nesting_linter.R @@ -758,7 +758,7 @@ patrick::with_parameters_test_that( ) ) -test_that("allow_functions= works", { +test_that("allow_functions= works", { # nofuzz '})' break-up by comment linter_default <- unnecessary_nesting_linter() linter_foo <- unnecessary_nesting_linter(allow_functions = "foo") expect_lint("foo(x, {y}, z)", "Reduce the nesting of this statement", linter_default) From fc097ba1420459f3d339b1e6e0dbb2d4dcd42df0 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 23:49:40 +0000 Subject: [PATCH 057/131] fix another one --- R/unnecessary_lambda_linter.R | 7 ++++++- tests/testthat/test-unnecessary_lambda_linter.R | 9 +++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index f2f62232d..5d9db8898 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -143,7 +143,12 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { purrr_fun_xpath <- glue(" following-sibling::expr[ OP-TILDE - and expr[OP-LEFT-PAREN/following-sibling::expr[1][not(preceding-sibling::*[2][self::SYMBOL_SUB])]/{purrr_symbol}] + and expr + /OP-LEFT-PAREN + /following-sibling::expr[1][ + not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB]) + ] + /{purrr_symbol} and not(expr/OP-LEFT-PAREN/following-sibling::expr[position() > 1]//{purrr_symbol}) ]") diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 44655b44b..0faed9021 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -185,6 +185,15 @@ test_that("purrr-style anonymous functions are also caught", { rex::rex("Pass foo directly as a symbol to map_vec()"), linter ) + + # adversarial comment + expect_no_lint( + trim_some(" + map_dbl(x, ~foo(bar = # comment + .x)) + "), + linter + ) }) test_that("cases with braces are caught", { From 092f98e5a80aa76dac691aba6dd5bd59d21489ec Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:00:04 +0000 Subject: [PATCH 058/131] fix another one --- R/unnecessary_lambda_linter.R | 6 +++++- tests/testthat/test-unnecessary_lambda_linter.R | 10 ++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index 5d9db8898..e5ea2d18e 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -128,7 +128,11 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { and not(preceding-sibling::*[1][self::EQ_SUB]) and not(parent::expr[ preceding-sibling::expr[not(SYMBOL_FUNCTION_CALL)] - or following-sibling::*[not(self::OP-RIGHT-PAREN or self::OP-RIGHT-BRACE)] + or following-sibling::*[not( + self::OP-RIGHT-PAREN + or self::OP-RIGHT-BRACE + or self::COMMENT + )] ]) ]/SYMBOL ] diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 0faed9021..ada809368 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -255,6 +255,16 @@ test_that("cases with braces are caught", { # false positives like #2231, #2247 are avoided with braces too expect_no_lint("lapply(x, function(xi) { foo(xi)$bar })", linter) expect_no_lint("lapply(x, function(xi) { foo(xi) - 1 })", linter) + + expect_lint( + trim_some(" + lapply(y, function(yi) { + print(yi) # comment + }) + "), + lint_msg, + linter + ) }) test_that("function shorthand is handled", { From 4c08d49d327ba755cf0093b0b94a2da39e4105ab Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:25:37 +0000 Subject: [PATCH 059/131] another real fix --- R/brace_linter.R | 2 +- tests/testthat/test-brace_linter.R | 20 ++++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/R/brace_linter.R b/R/brace_linter.R index 4c7add043..474b29a32 100644 --- a/R/brace_linter.R +++ b/R/brace_linter.R @@ -122,7 +122,7 @@ brace_linter <- function(allow_single_line = FALSE, { xp_cond_closed } and ( (@line1 = preceding-sibling::*[1][not(self::OP-LEFT-BRACE)]/@line2) - or (@line1 = parent::expr/following-sibling::*[1][not(self::ELSE)]/@line1) + or (@line1 = parent::expr/following-sibling::*[not(self::COMMENT)][1][not(self::ELSE)]/@line1) ) ]") diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index 0d0532f8e..e2ee4063a 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -119,6 +119,22 @@ test_that("brace_linter lints braces correctly", { linter ) + # a comment after '}' is allowed + expect_no_lint( + trim_some(" + switch( + x, + 'a' = do_something(x), + 'b' = do_another(x), + { + do_first(x) + do_second(x) + } # comment + ) + "), + brace_linter() + ) + expect_no_lint( trim_some(" fun( @@ -312,10 +328,12 @@ test_that("brace_linter lints function expressions correctly", { expect_no_lint(lines, linter_not_inline) expect_no_lint(lines, linter_never) + # nofuzz start expect_lint("function(x) { x + 4 }", msgs_open_close, linter_always) expect_lint("function(x) { x + 4 }", msgs_open_close, linter_multi_line) expect_lint("function(x) { x + 4 }", msgs_open_close, linter_not_inline) expect_lint("function(x) { x + 4 }", msgs_open_close, linter_never) + # nofuzz end # function_bodies = "always" should only prohibit inline functions with allow_single_line = FALSE (the default): expect_no_lint( "function(x) { x + 4 }", @@ -346,6 +364,7 @@ test_that("brace_linter lints function expressions correctly", { expect_no_lint(lines, linter_never) # missing newline after opening brace; closing brace not on sep line + # nofuzz start lines <- trim_some(" foo <- function(x) { x + 4 } @@ -354,6 +373,7 @@ test_that("brace_linter lints function expressions correctly", { expect_lint(lines, msgs_open_close, linter_multi_line) expect_lint(lines, msgs_open_close, linter_not_inline) expect_lint(lines, msgs_open_close, linter_never) + # nofuzz end # fn body wrapped in additional unneeded parentheses lines <- trim_some(" From 7b2a16dc52810a9da5c0b78750c86b5014d36f6b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:25:48 +0000 Subject: [PATCH 060/131] nofuzz --- tests/testthat/test-assignment_linter.R | 2 +- tests/testthat/test-indentation_linter.R | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index 84f1ea606..e67e6e182 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -66,7 +66,7 @@ test_that("arguments handle <<- and ->/->> correctly", { ) }) -test_that("arguments handle trailing assignment operators correctly", { +test_that("arguments handle trailing assignment operators correctly", { # nofuzz linter_default <- assignment_linter() linter_no_trailing <- assignment_linter(allow_trailing = FALSE) expect_no_lint("x <- y", linter_no_trailing) diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R index a4e1f6a55..19a78b520 100644 --- a/tests/testthat/test-indentation_linter.R +++ b/tests/testthat/test-indentation_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("indentation linter flags unindented expressions", { linter <- indentation_linter(indent = 2L) @@ -912,3 +913,4 @@ test_that("for loop gets correct linting", { linter ) }) +# nofuzz end From 78bdc1291000bc388b5df492afa0e5a76a2ea058 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:34:59 +0000 Subject: [PATCH 061/131] no hope for brace_linter; use a space before comment for infix_spaces --- .dev/ast_fuzz_test.R | 1 + .dev/maybe_fuzz_content.R | 2 +- tests/testthat/test-brace_linter.R | 6 ++---- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 3494d4549..0d09f5e45 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -131,6 +131,7 @@ withr::defer(for (restoration in test_restorations) writeLines(restoration$lines # the best approach but documentation was not very helpful. reporter <- testthat::SummaryReporter$new() testthat::test_local(reporter = reporter, stop_on_failure = FALSE) +# testthat::test_file('tests/testthat/test-brace_linter.R') failures <- reporter$failures$as_list() # ignore any test that failed for expected reasons, e.g. some known lint metadata changes diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 97c6e8599..950bd4e18 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -75,7 +75,7 @@ comment_injection_fuzzer <- function(pd, lines) { line <- lines[pd$line2[ii]] lines[pd$line2[ii]] <- paste0( substr(line, 1L, pd$col2[ii]), - "# INJECTED COMMENT\n", + " # INJECTED COMMENT\n", substr(line, pd$col2[ii] + 1L, nchar(line)) ) } diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index e2ee4063a..2257dc49f 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("brace_linter lints braces correctly", { open_curly_msg <- rex::rex( "Opening curly braces should never go on their own line" @@ -328,12 +329,10 @@ test_that("brace_linter lints function expressions correctly", { expect_no_lint(lines, linter_not_inline) expect_no_lint(lines, linter_never) - # nofuzz start expect_lint("function(x) { x + 4 }", msgs_open_close, linter_always) expect_lint("function(x) { x + 4 }", msgs_open_close, linter_multi_line) expect_lint("function(x) { x + 4 }", msgs_open_close, linter_not_inline) expect_lint("function(x) { x + 4 }", msgs_open_close, linter_never) - # nofuzz end # function_bodies = "always" should only prohibit inline functions with allow_single_line = FALSE (the default): expect_no_lint( "function(x) { x + 4 }", @@ -364,7 +363,6 @@ test_that("brace_linter lints function expressions correctly", { expect_no_lint(lines, linter_never) # missing newline after opening brace; closing brace not on sep line - # nofuzz start lines <- trim_some(" foo <- function(x) { x + 4 } @@ -373,7 +371,6 @@ test_that("brace_linter lints function expressions correctly", { expect_lint(lines, msgs_open_close, linter_multi_line) expect_lint(lines, msgs_open_close, linter_not_inline) expect_lint(lines, msgs_open_close, linter_never) - # nofuzz end # fn body wrapped in additional unneeded parentheses lines <- trim_some(" @@ -637,3 +634,4 @@ test_that("function shorthand is treated like 'full' function", { linter ) }) +# nofuzz end From 6446bbbdd5437c5cf1f6d775d7661d8a581e9da2 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:39:23 +0000 Subject: [PATCH 062/131] another real fix --- R/nzchar_linter.R | 5 +++-- tests/testthat/test-nzchar_linter.R | 17 +++++++++++++---- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/R/nzchar_linter.R b/R/nzchar_linter.R index 6e44b804e..e525f2977 100644 --- a/R/nzchar_linter.R +++ b/R/nzchar_linter.R @@ -112,8 +112,9 @@ nzchar_linter <- function() { # its "opposite" (not inverse) if the bad usage is on the RHS, # e.g. 0 < nchar(x) has to be treated as nchar(x) > 0. op_for_msg <- function(expr, const) { - op <- xml_name(xml_find_first(expr, "*[2]")) - maybe_needs_flip <- !is.na(xml_find_first(expr, sprintf("*[1][%s]", const))) + op <- xml_name(xml_find_first(expr, "*[not(self::COMMENT)][2]")) + maybe_needs_flip <- + !is.na(xml_find_first(expr, sprintf("*[not(self::COMMENT)][1][%s]", const))) ordered_ops <- c("GT", "GE", "LE", "LT") ordered_idx <- match(op, ordered_ops) diff --git a/tests/testthat/test-nzchar_linter.R b/tests/testthat/test-nzchar_linter.R index a034f8a26..774fb8afa 100644 --- a/tests/testthat/test-nzchar_linter.R +++ b/tests/testthat/test-nzchar_linter.R @@ -33,13 +33,22 @@ test_that("nzchar_linter skips as appropriate for other nchar args", { test_that("nzchar_linter blocks simple disallowed usages", { linter <- nzchar_linter() - lint_msg_quote <- rex::rex('Use !nzchar(x) instead of x == ""') - lint_msg_nchar <- rex::rex("Use nzchar() instead of comparing nchar(x) to 0") + lint_msg <- rex::rex("Use !nzchar(x) instead of nchar(x) == 0") - expect_lint("which(x == '')", lint_msg_quote, linter) + expect_lint("which(x == '')", rex::rex('Use !nzchar(x) instead of x == ""'), linter) expect_lint("any(nchar(x) >= 0)", rex::rex("nchar(x) >= 0 is always true, maybe you want nzchar(x)?"), linter) - expect_lint("all(nchar(x) == 0L)", rex::rex("Use !nzchar(x) instead of nchar(x) == 0"), linter) + expect_lint("all(nchar(x) == 0L)", lint_msg, linter) expect_lint("sum(0.0 < nchar(x))", rex::rex("Use nzchar(x) instead of nchar(x) > 0"), linter) + + # adversarial comment + expect_lint( + trim_some(" + all(nchar(x) #comment + == 0L) + "), + lint_msg, + linter + ) }) test_that("nzchar_linter skips comparison to '' in if/while statements", { From d256ccbb169f44e9fee16a85554e8a3ae6a31712 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:41:00 +0000 Subject: [PATCH 063/131] expect_no_lint --- tests/testthat/test-comparison_negation_linter.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-comparison_negation_linter.R b/tests/testthat/test-comparison_negation_linter.R index 8fd32a256..4480f63b5 100644 --- a/tests/testthat/test-comparison_negation_linter.R +++ b/tests/testthat/test-comparison_negation_linter.R @@ -2,16 +2,16 @@ test_that("comparison_negation_linter skips allowed usages", { linter <- comparison_negation_linter() # doesn't apply to joint statements - expect_lint("!(x == y | y == z)", NULL, linter) + expect_no_lint("!(x == y | y == z)", linter) # don't force de Morgan's laws - expect_lint("!(x & y)", NULL, linter) + expect_no_lint("!(x & y)", linter) # naive xpath will include !foo(x) cases - expect_lint("!any(x > y)", NULL, linter) + expect_no_lint("!any(x > y)", linter) # ditto for tidyeval cases - expect_lint("!!target == 1 ~ 'target'", NULL, linter) + expect_no_lint("!!target == 1 ~ 'target'", linter) # ditto for !x[f == g] - expect_lint("!passes.test[stage == 1]", NULL, linter) + expect_no_lint("!passes.test[stage == 1]", linter) }) local({ From f4e53cb55e88873e5100a9c23367d33bb0d457f8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:44:25 +0000 Subject: [PATCH 064/131] another real fix --- R/comparison_negation_linter.R | 4 ++-- tests/testthat/test-comparison_negation_linter.R | 11 +++++++++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/R/comparison_negation_linter.R b/R/comparison_negation_linter.R index 37ae8e697..6a5fa4ec1 100644 --- a/R/comparison_negation_linter.R +++ b/R/comparison_negation_linter.R @@ -65,13 +65,13 @@ comparison_negation_linter <- function() { bad_expr <- xml_find_all(xml, xpath) - comparator_node <- xml_find_first(bad_expr, "expr/expr/*[2]") + comparator_node <- xml_find_first(bad_expr, "expr/expr/*[not(self::COMMENT)][2]") comparator_name <- xml_name(comparator_node) # "typical" case is assumed to be !(x == y), so try that first, and back # up to the less nested case. there may be a cleaner way to do this... unnested <- !comparator_name %in% names(comparator_inverses) - comparator_node[unnested] <- xml_find_first(bad_expr[unnested], "expr/*[2]") + comparator_node[unnested] <- xml_find_first(bad_expr[unnested], "expr/*[not(self::COMMENT)][2]") comparator_name[unnested] <- xml_name(comparator_node[unnested]) comparator_text <- xml_text(comparator_node) diff --git a/tests/testthat/test-comparison_negation_linter.R b/tests/testthat/test-comparison_negation_linter.R index 4480f63b5..1867f2ea7 100644 --- a/tests/testthat/test-comparison_negation_linter.R +++ b/tests/testthat/test-comparison_negation_linter.R @@ -61,3 +61,14 @@ test_that("Lints vectorize", { comparison_negation_linter() ) }) + +test_that("logic survives adversarial comments", { + expect_lint( + trim_some(" + !(x # + > y) + "), + rex::rex("Use x <= y, not !(x > y)"), + comparison_negation_linter() + ) +}) From f817c77754d18a13822c86bd9b3e088653e23493 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:50:27 +0000 Subject: [PATCH 065/131] expect_no_lint --- tests/testthat/test-commas_linter.R | 58 ++++++++++++++--------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index fb8a4e4f3..ec058f397 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -3,12 +3,12 @@ test_that("returns the correct linting (with default parameters)", { msg_after <- rex::rex("Put a space after a comma.") msg_before <- rex::rex("Remove spaces before a comma.") - expect_lint("blah", NULL, linter) - expect_lint("fun(1, 1)", NULL, linter) - expect_lint("fun(1,\n 1)", NULL, linter) - expect_lint("fun(1,\n1)", NULL, linter) - expect_lint("fun(1\n,\n1)", NULL, linter) - expect_lint("fun(1\n ,\n1)", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("fun(1, 1)", linter) + expect_no_lint("fun(1,\n 1)", linter) + expect_no_lint("fun(1,\n1)", linter) + expect_no_lint("fun(1\n,\n1)", linter) + expect_no_lint("fun(1\n ,\n1)", linter) expect_lint("fun(1\n,1)", msg_after, linter) expect_lint("fun(1,1)", msg_after, linter) @@ -25,14 +25,14 @@ test_that("returns the correct linting (with default parameters)", { linter ) - expect_lint("\"fun(1 ,1)\"", NULL, linter) - expect_lint("a[1, , 2]", NULL, linter) - expect_lint("a[1, , 2, , 3]", NULL, linter) + expect_no_lint("\"fun(1 ,1)\"", linter) + expect_no_lint("a[1, , 2]", linter) + expect_no_lint("a[1, , 2, , 3]", linter) - expect_lint("switch(op, x = foo, y = bar)", NULL, linter) - expect_lint("switch(op, x = , y = bar)", NULL, linter) - expect_lint("switch(op, \"x\" = , y = bar)", NULL, linter) - expect_lint("switch(op, x = ,\ny = bar)", NULL, linter) + expect_no_lint("switch(op, x = foo, y = bar)", linter) + expect_no_lint("switch(op, x = , y = bar)", linter) + expect_no_lint("switch(op, \"x\" = , y = bar)", linter) + expect_no_lint("switch(op, x = ,\ny = bar)", linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) @@ -67,14 +67,14 @@ test_that("returns the correct linting (with 'allow_trailing' set)", { msg_after <- rex::rex("Put a space after a comma.") msg_before <- rex::rex("Remove spaces before a comma.") - expect_lint("blah", NULL, linter) - expect_lint("fun(1, 1)", NULL, linter) - expect_lint("fun(1,\n 1)", NULL, linter) - expect_lint("fun(1,\n1)", NULL, linter) - expect_lint("fun(1\n,\n1)", NULL, linter) - expect_lint("fun(1\n ,\n1)", NULL, linter) - expect_lint("a[1,]", NULL, linter) - expect_lint("a(1,)", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("fun(1, 1)", linter) + expect_no_lint("fun(1,\n 1)", linter) + expect_no_lint("fun(1,\n1)", linter) + expect_no_lint("fun(1\n,\n1)", linter) + expect_no_lint("fun(1\n ,\n1)", linter) + expect_no_lint("a[1,]", linter) + expect_no_lint("a(1,)", linter) expect_lint("fun(1\n,1)", msg_after, linter) expect_lint("fun(1,1)", msg_after, linter) @@ -88,15 +88,15 @@ test_that("returns the correct linting (with 'allow_trailing' set)", { linter ) - expect_lint("\"fun(1 ,1)\"", NULL, linter) - expect_lint("a[1, , 2]", NULL, linter) - expect_lint("a[1, , 2, , 3]", NULL, linter) - expect_lint("a[[1,]]", NULL, linter) + expect_no_lint('"fun(1 ,1)"', linter) + expect_no_lint("a[1, , 2]", linter) + expect_no_lint("a[1, , 2, , 3]", linter) + expect_no_lint("a[[1,]]", linter) - expect_lint("switch(op, x = foo, y = bar)", NULL, linter) - expect_lint("switch(op, x = , y = bar)", NULL, linter) - expect_lint("switch(op, \"x\" = , y = bar)", NULL, linter) - expect_lint("switch(op, x = ,\ny = bar)", NULL, linter) + expect_no_lint("switch(op, x = foo, y = bar)", linter) + expect_no_lint("switch(op, x = , y = bar)", linter) + expect_no_lint('switch(op, "x" = , y = bar)', linter) + expect_no_lint("switch(op, x = ,\ny = bar)", linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) From 3f817a7be5648e770c3e237438f6c7acfc814152 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:55:43 +0000 Subject: [PATCH 066/131] expect_no_lint, stylistic touch-up --- tests/testthat/test-commas_linter.R | 6 +- tests/testthat/test-spaces_inside_linter.R | 68 +++++++++++----------- 2 files changed, 37 insertions(+), 37 deletions(-) diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index ec058f397..9a7681611 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("returns the correct linting (with default parameters)", { linter <- commas_linter() msg_after <- rex::rex("Put a space after a comma.") @@ -25,13 +26,13 @@ test_that("returns the correct linting (with default parameters)", { linter ) - expect_no_lint("\"fun(1 ,1)\"", linter) + expect_no_lint('"fun(1 ,1)"', linter) expect_no_lint("a[1, , 2]", linter) expect_no_lint("a[1, , 2, , 3]", linter) expect_no_lint("switch(op, x = foo, y = bar)", linter) expect_no_lint("switch(op, x = , y = bar)", linter) - expect_no_lint("switch(op, \"x\" = , y = bar)", linter) + expect_no_lint('switch(op, "x" = , y = bar)', linter) expect_no_lint("switch(op, x = ,\ny = bar)", linter) expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) @@ -113,3 +114,4 @@ test_that("returns the correct linting (with 'allow_trailing' set)", { linter ) }) +# nofuzz end diff --git a/tests/testthat/test-spaces_inside_linter.R b/tests/testthat/test-spaces_inside_linter.R index ff0981ab5..a7fe8cecb 100644 --- a/tests/testthat/test-spaces_inside_linter.R +++ b/tests/testthat/test-spaces_inside_linter.R @@ -1,36 +1,34 @@ test_that("spaces_inside_linter skips allowed usages", { linter <- spaces_inside_linter() - expect_lint("blah", NULL, linter) - expect_lint("print(blah)", NULL, linter) - expect_lint("base::print(blah)", NULL, linter) - expect_lint("a[, ]", NULL, linter) - expect_lint("a[1]", NULL, linter) - expect_lint("fun(\na[1]\n )", NULL, linter) - expect_lint("a(, )", NULL, linter) - expect_lint("a(,)", NULL, linter) - expect_lint("a(1)", NULL, linter) - expect_lint('"a( 1 )"', NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("print(blah)", linter) + expect_no_lint("base::print(blah)", linter) + expect_no_lint("a[, ]", linter) + expect_no_lint("a[1]", linter) + expect_no_lint("fun(\na[1]\n )", linter) + expect_no_lint("a(, )", linter) + expect_no_lint("a(,)", linter) + expect_no_lint("a(1)", linter) + expect_no_lint('"a( 1 )"', linter) # trailing comments are OK (#636) - expect_lint( + expect_no_lint( trim_some(" or( #code x, y ) "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" fun( # this is another comment a = 42, # because 42 is always the answer b = Inf ) "), - NULL, linter ) }) @@ -41,7 +39,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a[1 ]", list( - message = "Do not place spaces before square brackets", + "Do not place spaces before square brackets", line_number = 1L, column_number = 4L, type = "style" @@ -52,7 +50,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a[[1 ]]", list( - message = "Do not place spaces before square brackets", + "Do not place spaces before square brackets", line_number = 1L, column_number = 5L, type = "style" @@ -63,7 +61,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "\n\na[ 1]", list( - message = "Do not place spaces after square brackets", + "Do not place spaces after square brackets", line_number = 3L, column_number = 3L, type = "style" @@ -75,13 +73,13 @@ test_that("spaces_inside_linter blocks diallowed usages", { "a[ 1 ]", list( list( - message = "Do not place spaces after square brackets", + "Do not place spaces after square brackets", line_number = 1L, column_number = 3L, type = "style" ), list( - message = "Do not place spaces before square brackets", + "Do not place spaces before square brackets", line_number = 1L, column_number = 5L, type = "style" @@ -93,7 +91,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a(1 )", list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 4L, type = "style" @@ -104,7 +102,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a[[ 1]]", list( - message = "Do not place spaces after square brackets", + "Do not place spaces after square brackets", line_number = 1L, column_number = 4L, type = "style" @@ -115,7 +113,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { expect_lint( "a( 1)", list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 3L, type = "style" @@ -127,13 +125,13 @@ test_that("spaces_inside_linter blocks diallowed usages", { "x[[ 1L ]]", list( list( - message = "Do not place spaces after square brackets", + "Do not place spaces after square brackets", line_number = 1L, column_number = 4L, type = "style" ), list( - message = "Do not place spaces before square brackets", + "Do not place spaces before square brackets", line_number = 1L, column_number = 7L, type = "style" @@ -146,13 +144,13 @@ test_that("spaces_inside_linter blocks diallowed usages", { "a( 1 )", list( list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 3L, type = "style" ), list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 5L, type = "style" @@ -166,14 +164,14 @@ test_that("spaces_inside_linter blocks diallowed usages", { "a( blah )", list( list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 3L, ranges = list(c(3L, 4L)), type = "style" ), list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 9L, ranges = list(c(9L, 10L)), @@ -191,8 +189,8 @@ test_that("multi-line expressions have good markers", { y ) "), list( - list(line_number = 1L, ranges = list(c(2L, 2L)), message = "Do not place spaces after parentheses"), - list(line_number = 2L, ranges = list(c(4L, 4L)), message = "Do not place spaces before parentheses") + list("Do not place spaces after parentheses", line_number = 1L, ranges = list(c(2L, 2L))), + list("Do not place spaces before parentheses", line_number = 2L, ranges = list(c(4L, 4L))) ), spaces_inside_linter() ) @@ -207,13 +205,13 @@ test_that("spaces_inside_linter blocks disallowed usages with a pipe", { "letters[1:3] %>% paste0( )", list( list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 25L, type = "style" ), list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 25L, type = "style" @@ -226,13 +224,13 @@ test_that("spaces_inside_linter blocks disallowed usages with a pipe", { "letters[1:3] |> paste0( )", list( list( - message = "Do not place spaces after parentheses", + "Do not place spaces after parentheses", line_number = 1L, column_number = 24L, type = "style" ), list( - message = "Do not place spaces before parentheses", + "Do not place spaces before parentheses", line_number = 1L, column_number = 24L, type = "style" @@ -243,5 +241,5 @@ test_that("spaces_inside_linter blocks disallowed usages with a pipe", { }) test_that("terminal missing keyword arguments are OK", { - expect_lint("alist(missing_arg = )", NULL, spaces_inside_linter()) + expect_no_lint("alist(missing_arg = )", spaces_inside_linter()) }) From 0fa564779348d61e81c2e258e16e2681775afd1d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:56:06 +0000 Subject: [PATCH 067/131] style touch-up (no message=) --- tests/testthat/test-commas_linter.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index 9a7681611..8ef94955b 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -56,8 +56,8 @@ test_that("returns the correct linting (with default parameters)", { expect_lint( "fun(op ,bar)", list( - list(message = msg_before, column_number = 7L, ranges = list(c(7L, 10L))), - list(message = msg_after, column_number = 12L, ranges = list(c(12L, 12L))) + list(msg_before, column_number = 7L, ranges = list(c(7L, 10L))), + list(msg_after, column_number = 12L, ranges = list(c(12L, 12L))) ), linter ) @@ -108,8 +108,8 @@ test_that("returns the correct linting (with 'allow_trailing' set)", { expect_lint( "fun(op ,bar)", list( - list(message = msg_before, column_number = 7L, ranges = list(c(7L, 10L))), - list(message = msg_after, column_number = 12L, ranges = list(c(12L, 12L))) + list(msg_before, column_number = 7L, ranges = list(c(7L, 10L))), + list(msg_after, column_number = 12L, ranges = list(c(12L, 12L))) ), linter ) From c2b18cabf84673d72ffaf04955d2e9f615072555 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:58:14 +0000 Subject: [PATCH 068/131] nofuzz --- tests/testthat/test-spaces_inside_linter.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-spaces_inside_linter.R b/tests/testthat/test-spaces_inside_linter.R index a7fe8cecb..e8078ac66 100644 --- a/tests/testthat/test-spaces_inside_linter.R +++ b/tests/testthat/test-spaces_inside_linter.R @@ -36,7 +36,7 @@ test_that("spaces_inside_linter skips allowed usages", { test_that("spaces_inside_linter blocks diallowed usages", { linter <- spaces_inside_linter() - expect_lint( + expect_lint( # nofuzz "a[1 ]", list( "Do not place spaces before square brackets", @@ -47,7 +47,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { linter ) - expect_lint( + expect_lint( # nofuzz "a[[1 ]]", list( "Do not place spaces before square brackets", @@ -69,7 +69,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { linter ) - expect_lint( + expect_lint( # nofuzz "a[ 1 ]", list( list( @@ -88,7 +88,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { linter ) - expect_lint( + expect_lint( # nofuzz "a(1 )", list( "Do not place spaces before parentheses", @@ -121,6 +121,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { linter ) + # nofuzz start expect_lint( "x[[ 1L ]]", list( @@ -180,10 +181,11 @@ test_that("spaces_inside_linter blocks diallowed usages", { ), linter ) + # nofuzz end }) test_that("multi-line expressions have good markers", { - expect_lint( + expect_lint( # nofuzz trim_some(" ( x | y ) @@ -196,7 +198,7 @@ test_that("multi-line expressions have good markers", { ) }) -test_that("spaces_inside_linter blocks disallowed usages with a pipe", { +test_that("spaces_inside_linter blocks disallowed usages with a pipe", { # nofuzz skip_if_not_r_version("4.1.0") linter <- spaces_inside_linter() From 24f32a487f3b46fa4767d6de4a09d1bab631837f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 00:59:32 +0000 Subject: [PATCH 069/131] expect_no_lint --- .../testthat/test-strings_as_factors_linter.R | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-strings_as_factors_linter.R b/tests/testthat/test-strings_as_factors_linter.R index a45624b80..22a9b85d1 100644 --- a/tests/testthat/test-strings_as_factors_linter.R +++ b/tests/testthat/test-strings_as_factors_linter.R @@ -1,22 +1,22 @@ test_that("strings_as_factors_linter skips allowed usages", { linter <- strings_as_factors_linter() - expect_lint("data.frame(1:3)", NULL, linter) - expect_lint("data.frame(x = 1:3)", NULL, linter) + expect_no_lint("data.frame(1:3)", linter) + expect_no_lint("data.frame(x = 1:3)", linter) - expect_lint("data.frame(x = 'a', stringsAsFactors = TRUE)", NULL, linter) - expect_lint("data.frame(x = 'a', stringsAsFactors = FALSE)", NULL, linter) - expect_lint("data.frame(x = c('a', 'b'), stringsAsFactors = FALSE)", NULL, linter) + expect_no_lint("data.frame(x = 'a', stringsAsFactors = TRUE)", linter) + expect_no_lint("data.frame(x = 'a', stringsAsFactors = FALSE)", linter) + expect_no_lint("data.frame(x = c('a', 'b'), stringsAsFactors = FALSE)", linter) # strings in argument names to c() don't get linted - expect_lint("data.frame(x = c('a b' = 1L, 'b c' = 2L))", NULL, linter) + expect_no_lint("data.frame(x = c('a b' = 1L, 'b c' = 2L))", linter) # characters supplied to row.names are not affected - expect_lint("data.frame(x = 1:3, row.names = c('a', 'b', 'c'))", NULL, linter) + expect_no_lint("data.frame(x = 1:3, row.names = c('a', 'b', 'c'))", linter) # ambiguous cases passes - expect_lint("data.frame(x = c(xx, 'a'))", NULL, linter) - expect_lint("data.frame(x = c(foo(y), 'a'))", NULL, linter) + expect_no_lint("data.frame(x = c(xx, 'a'))", linter) + expect_no_lint("data.frame(x = c(foo(y), 'a'))", linter) }) test_that("strings_as_factors_linter blocks simple disallowed usages", { @@ -44,8 +44,8 @@ test_that("strings_as_factors_linters catches rep(char) usages", { expect_lint("data.frame(rep(c('a', 'b'), 10L))", lint_msg, linter) # literal char, not mixed or non-char - expect_lint("data.frame(rep(1L, 10L))", NULL, linter) - expect_lint("data.frame(rep(c(x, 'a'), 10L))", NULL, linter) + expect_no_lint("data.frame(rep(1L, 10L))", linter) + expect_no_lint("data.frame(rep(c(x, 'a'), 10L))", linter) # however, type promotion of literals is caught expect_lint("data.frame(rep(c(TRUE, 'a'), 10L))", lint_msg, linter) }) @@ -59,7 +59,7 @@ test_that("strings_as_factors_linter catches character(), as.character() usages" expect_lint("data.frame(a = as.character(x))", lint_msg, linter) # but not for row.names - expect_lint("data.frame(a = 1:10, row.names = as.character(1:10))", NULL, linter) + expect_no_lint("data.frame(a = 1:10, row.names = as.character(1:10))", linter) }) test_that("strings_as_factors_linter catches more functions with string output", { @@ -74,7 +74,7 @@ test_that("strings_as_factors_linter catches more functions with string output", expect_lint("data.frame(a = toString(x))", lint_msg, linter) expect_lint("data.frame(a = encodeString(x))", lint_msg, linter) # but not for row.names - expect_lint("data.frame(a = 1:10, row.names = paste(1:10))", NULL, linter) + expect_no_lint("data.frame(a = 1:10, row.names = paste(1:10))", linter) }) test_that("lints vectorize", { From c7530e64f7b8ab637cc2cc64296b60e204776915 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 01:02:26 +0000 Subject: [PATCH 070/131] more true fixes --- R/strings_as_factors_linter.R | 4 ++-- tests/testthat/test-strings_as_factors_linter.R | 12 ++++++++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/R/strings_as_factors_linter.R b/R/strings_as_factors_linter.R index 6c8ef3f46..0e33419c3 100644 --- a/R/strings_as_factors_linter.R +++ b/R/strings_as_factors_linter.R @@ -66,7 +66,7 @@ strings_as_factors_linter <- local({ parent::expr[ expr[ ( - STR_CONST[not(following-sibling::*[1][self::EQ_SUB])] + STR_CONST[not(following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])] or ( {c_combine_strings} ) or expr[1][ SYMBOL_FUNCTION_CALL[text() = 'rep'] @@ -74,7 +74,7 @@ strings_as_factors_linter <- local({ ] or expr[1][SYMBOL_FUNCTION_CALL[ {xp_text_in_table(known_character_funs)} ]] ) - and not(preceding-sibling::*[2][self::SYMBOL_SUB and text() = 'row.names']) + and not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB and text() = 'row.names']) ] and not(SYMBOL_SUB[text() = 'stringsAsFactors']) ]") diff --git a/tests/testthat/test-strings_as_factors_linter.R b/tests/testthat/test-strings_as_factors_linter.R index 22a9b85d1..5883c2bf9 100644 --- a/tests/testthat/test-strings_as_factors_linter.R +++ b/tests/testthat/test-strings_as_factors_linter.R @@ -17,6 +17,18 @@ test_that("strings_as_factors_linter skips allowed usages", { # ambiguous cases passes expect_no_lint("data.frame(x = c(xx, 'a'))", linter) expect_no_lint("data.frame(x = c(foo(y), 'a'))", linter) + + # adversarial comments + expect_no_lint( + trim_some(" + data.frame( + x = 1:3, + row.names # INJECTED COMMENT + = c('a', 'b', 'c') + ) + "), + strings_as_factors_linter() + ) }) test_that("strings_as_factors_linter blocks simple disallowed usages", { From 0ed031d9921d82c27a4cb777d29658738da78a8a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 01:02:44 +0000 Subject: [PATCH 071/131] tidy --- tests/testthat/test-strings_as_factors_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-strings_as_factors_linter.R b/tests/testthat/test-strings_as_factors_linter.R index 5883c2bf9..54edbba1d 100644 --- a/tests/testthat/test-strings_as_factors_linter.R +++ b/tests/testthat/test-strings_as_factors_linter.R @@ -27,7 +27,7 @@ test_that("strings_as_factors_linter skips allowed usages", { = c('a', 'b', 'c') ) "), - strings_as_factors_linter() + linter ) }) From ccc0f8993c6f2bf859cebc15e8982672e6df8181 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 01:03:18 +0000 Subject: [PATCH 072/131] tidy2 --- tests/testthat/test-strings_as_factors_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-strings_as_factors_linter.R b/tests/testthat/test-strings_as_factors_linter.R index 54edbba1d..52c570510 100644 --- a/tests/testthat/test-strings_as_factors_linter.R +++ b/tests/testthat/test-strings_as_factors_linter.R @@ -23,7 +23,7 @@ test_that("strings_as_factors_linter skips allowed usages", { trim_some(" data.frame( x = 1:3, - row.names # INJECTED COMMENT + row.names # comment = c('a', 'b', 'c') ) "), From 6c090b747a1a22068c5e564b5abccae942344a75 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 20:20:38 -0800 Subject: [PATCH 073/131] nofuzz, expect_no_lint --- tests/testthat/test-literal_coercion_linter.R | 34 +++++++++---------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R index aa5f752fb..4ce2c9585 100644 --- a/tests/testthat/test-literal_coercion_linter.R +++ b/tests/testthat/test-literal_coercion_linter.R @@ -2,42 +2,42 @@ test_that("literal_coercion_linter skips allowed usages", { linter <- literal_coercion_linter() # naive xpath includes the "_f0" here as a literal - expect_lint('as.numeric(x$"_f0")', NULL, linter) - expect_lint('as.numeric(x@"_f0")', NULL, linter) + expect_no_lint('as.numeric(x$"_f0")', linter) + expect_no_lint('as.numeric(x@"_f0")', linter) # only examine the first method for as. methods - expect_lint("as.character(as.Date(x), '%Y%m%d')", NULL, linter) + expect_no_lint("as.character(as.Date(x), '%Y%m%d')", linter) # we are as yet agnostic on whether to prefer literals over coerced vectors - expect_lint("as.integer(c(1, 2, 3))", NULL, linter) + expect_no_lint("as.integer(c(1, 2, 3))", 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, linter) + expect_no_lint("as.character(c(1, 2, 3))", linter) # not possible to declare raw literals - expect_lint("as.raw(c(1, 2, 3))", NULL, linter) + expect_no_lint("as.raw(c(1, 2, 3))", linter) # also not taking a stand on as.complex(0) vs. 0 + 0i - expect_lint("as.complex(0)", NULL, linter) + expect_no_lint("as.complex(0)", linter) # ditto for as.integer(1e6) vs. 1000000L - expect_lint("as.integer(1e6)", NULL, linter) + expect_no_lint("as.integer(1e6)", linter) # ditto for as.numeric(1:3) vs. c(1, 2, 3) - expect_lint("as.numeric(1:3)", NULL, linter) + expect_no_lint("as.numeric(1:3)", linter) }) test_that("literal_coercion_linter skips allowed rlang usages", { linter <- literal_coercion_linter() - expect_lint("int(1, 2.0, 3)", NULL, linter) - expect_lint("chr('e', 'ab', 'xyz')", NULL, linter) - expect_lint("lgl(0, 1)", NULL, linter) - expect_lint("lgl(0L, 1)", NULL, linter) - expect_lint("dbl(1.2, 1e5, 3L, 2E4)", NULL, linter) + expect_no_lint("int(1, 2.0, 3)", linter) + expect_no_lint("chr('e', 'ab', 'xyz')", linter) + expect_no_lint("lgl(0, 1)", linter) + expect_no_lint("lgl(0L, 1)", linter) + expect_no_lint("dbl(1.2, 1e5, 3L, 2E4)", linter) # make sure using namespace (`rlang::`) doesn't create problems - expect_lint("rlang::int(1, 2, 3)", NULL, linter) + expect_no_lint("rlang::int(1, 2, 3)", linter) # even if scalar, carve out exceptions for the following - expect_lint("int(1.0e6)", NULL, linter) + expect_no_lint("int(1.0e6)", linter) }) test_that("literal_coercion_linter skips quoted keyword arguments", { - expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter()) + expect_no_lint("as.numeric(foo('a' = 1))", literal_coercion_linter()) }) test_that("no warnings surfaced by running coercion", { From cd7052be3ed71c06098b7e6aa91db2db5ace0419 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 21:13:26 -0800 Subject: [PATCH 074/131] a real bear here, fixed --- R/literal_coercion_linter.R | 3 ++ R/xml_utils.R | 12 +++++++ tests/testthat/test-literal_coercion_linter.R | 32 ++++++++++++++++++- .../testthat/test-pipe_continuation_linter.R | 2 +- 4 files changed, 47 insertions(+), 2 deletions(-) diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index 12b8cf39c..15dee2557 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -89,6 +89,9 @@ literal_coercion_linter <- function() { ) # nocov end } else { + # Delete COMMENT nodes, being careful that xml2 objects are mutable + bad_expr <- clone_xml_(bad_expr) + for (comment in xml_find_all(bad_expr, ".//COMMENT")) xml2::xml_remove(comment) # duplicate, unless we add 'rlang::' and it wasn't there originally coercion_str <- report_str <- xml_text(bad_expr) if (any(is_rlang_coercer) && !("package:rlang" %in% search())) { diff --git a/R/xml_utils.R b/R/xml_utils.R index 3b0546da6..f09ce379d 100644 --- a/R/xml_utils.R +++ b/R/xml_utils.R @@ -12,6 +12,18 @@ xml2lang <- function(x) { str2lang(paste(xml_text(x_strip_comments), collapse = " ")) } +# TODO(r-lib/xml2#341): Use xml_clone() instead. +clone_xml_ <- function(x) { + tmp_doc <- tempfile() + on.exit(unlink(tmp_doc)) + + doc <- xml2::xml_new_root("root") + for (ii in seq_along(x)) { + xml2::write_xml(x[[ii]], tmp_doc) + xml2::xml_add_child(doc, xml2::read_xml(tmp_doc)) + } + xml_find_all(doc, "*") +} safe_parse_to_xml <- function(parsed_content) { if (is.null(parsed_content)) { diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R index 4ce2c9585..b8277929a 100644 --- a/tests/testthat/test-literal_coercion_linter.R +++ b/tests/testthat/test-literal_coercion_linter.R @@ -50,6 +50,18 @@ test_that("no warnings surfaced by running coercion", { expect_no_warning( expect_lint("as.integer(2147483648)", "Use NA_integer_", linter) ) + + expect_no_warning( + expect_lint( + trim_some(" + as.double( + NA # comment + ) + "), + "Use NA_real_", + linter + ) + ) }) skip_if_not_installed("tibble") @@ -81,6 +93,7 @@ patrick::with_parameters_test_that( skip_if_not_installed("rlang") test_that("multiple lints return custom messages", { + linter <- literal_coercion_linter() expect_lint( trim_some("{ as.integer(1) @@ -90,7 +103,24 @@ test_that("multiple lints return custom messages", { list(rex::rex("Use 1L instead of as.integer(1)"), line_number = 2L), list(rex::rex("Use TRUE instead of lgl(1L)"), line_number = 3L) ), - literal_coercion_linter() + linter + ) + + # also ensure comment remove logic works across several lints + expect_lint( + trim_some("{ + as.integer( # comment + 1 # comment + ) # comment + lgl( # comment + 1L # comment + ) # comment + }"), + list( + list(rex::rex("Use 1L instead of as.integer(1)"), line_number = 2L), + list(rex::rex("Use TRUE instead of lgl(1L)"), line_number = 5L) + ), + linter ) }) diff --git a/tests/testthat/test-pipe_continuation_linter.R b/tests/testthat/test-pipe_continuation_linter.R index 566848505..1e28c1c61 100644 --- a/tests/testthat/test-pipe_continuation_linter.R +++ b/tests/testthat/test-pipe_continuation_linter.R @@ -191,7 +191,7 @@ local({ cases <- within(cases, { .test_name <- sprintf("(%s, %s)", pipe1, pipe2) }) - patrick::with_parameters_test_that( + patrick::with_parameters_test_that( # nofuzz "Various pipes are linted correctly", expect_lint( sprintf("a %s b() %s\n c()", pipe1, pipe2), From 4326789ca30d07a0d5256640028f60d188f80126 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:17:35 -0800 Subject: [PATCH 075/131] another true fix --- R/implicit_assignment_linter.R | 2 +- tests/testthat/test-implicit_assignment_linter.R | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/R/implicit_assignment_linter.R b/R/implicit_assignment_linter.R index 70dfd3376..e7be487ed 100644 --- a/R/implicit_assignment_linter.R +++ b/R/implicit_assignment_linter.R @@ -82,7 +82,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" xpath <- glue(" ({assignments}) /parent::expr[ - preceding-sibling::*[2][self::IF or self::WHILE] + preceding-sibling::*[not(self::COMMENT)][2][self::IF or self::WHILE] or parent::forcond or preceding-sibling::expr/{xpath_exceptions} or parent::expr/*[1][self::OP-LEFT-PAREN] diff --git a/tests/testthat/test-implicit_assignment_linter.R b/tests/testthat/test-implicit_assignment_linter.R index 0681b2ecd..9c17e727c 100644 --- a/tests/testthat/test-implicit_assignment_linter.R +++ b/tests/testthat/test-implicit_assignment_linter.R @@ -214,6 +214,22 @@ test_that("implicit_assignment_linter blocks disallowed usages in simple conditi expect_lint("while (0L -> x) FALSE", lint_message, linter) expect_lint("for (x in y <- 1:10) print(x)", lint_message, linter) expect_lint("for (x in 1:10 -> y) print(x)", lint_message, linter) + + # adversarial commenting + expect_lint( + trim_some(" + while # comment + (x <- 0L) FALSE + + while ( # comment + x <- 0L) FALSE + "), + list( + list(lint_message, line_number = 2L), + list(lint_message, line_number = 5L) + ), + linter + ) }) test_that("implicit_assignment_linter blocks disallowed usages in nested conditional statements", { From 35e77086371b41e6d0680bf3cab1be2658c3c442 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:22:25 -0800 Subject: [PATCH 076/131] bug fix --- R/length_test_linter.R | 6 +++++- tests/testthat/test-length_test_linter.R | 24 +++++++++++++++++++++++- 2 files changed, 28 insertions(+), 2 deletions(-) diff --git a/R/length_test_linter.R b/R/length_test_linter.R index 1a984ef66..0a00117d1 100644 --- a/R/length_test_linter.R +++ b/R/length_test_linter.R @@ -29,7 +29,11 @@ length_test_linter <- function() { xml_calls <- source_expression$xml_find_function_calls("length") bad_expr <- xml_find_all(xml_calls, xpath) - expr_parts <- vapply(lapply(bad_expr, xml_find_all, "expr[2]/*"), xml_text, character(3L)) + expr_parts <- vapply( + lapply(bad_expr, xml_find_all, "expr[2]/*[not(self::COMMENT)]"), + xml_text, + character(3L) + ) lint_message <- sprintf( "Checking the length of a logical vector is likely a mistake. Did you mean `length(%s) %s %s`?", expr_parts[1L, ], expr_parts[2L, ], expr_parts[3L, ] diff --git a/tests/testthat/test-length_test_linter.R b/tests/testthat/test-length_test_linter.R index b60557c12..e9bb9bd75 100644 --- a/tests/testthat/test-length_test_linter.R +++ b/tests/testthat/test-length_test_linter.R @@ -32,6 +32,8 @@ local({ }) test_that("lints vectorize", { + linter <- length_test_linter() + expect_lint( trim_some("{ length(x == y) @@ -41,6 +43,26 @@ test_that("lints vectorize", { list(rex::rex("length(x) == y"), line_number = 2L), list(rex::rex("length(y) == z"), line_number = 3L) ), - length_test_linter() + linter + ) + + expect_lint( + trim_some("{ + length( # comment + x # comment + == # comment + y # comment + ) # comment + length( # comment + y # comment + == # comment + z # comment + ) + }"), + list( + list(rex::rex("length(x) == y"), line_number = 2L), + list(rex::rex("length(y) == z"), line_number = 7L) + ), + linter ) }) From 218e656dfdafd5ddb0d2ae643d49be085fd724a4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:36:45 -0800 Subject: [PATCH 077/131] more nofuzz, another true fix --- R/unnecessary_nesting_linter.R | 2 +- tests/testthat/test-paren_body_linter.R | 2 ++ tests/testthat/test-pipe_continuation_linter.R | 4 +++- tests/testthat/test-trailing_whitespace_linter.R | 2 ++ tests/testthat/test-unnecessary_nesting_linter.R | 15 +++++++++++++++ 5 files changed, 23 insertions(+), 2 deletions(-) diff --git a/R/unnecessary_nesting_linter.R b/R/unnecessary_nesting_linter.R index 3490f9409..71e7b432e 100644 --- a/R/unnecessary_nesting_linter.R +++ b/R/unnecessary_nesting_linter.R @@ -234,7 +234,7 @@ unnecessary_nesting_linter <- function( # catch if (cond) { if (other_cond) { ... } } # count(*): only OP-LEFT-BRACE, one , and OP-RIGHT-BRACE. # Note that third node could be . - "following-sibling::expr[OP-LEFT-BRACE and count(*) = 3]/expr[IF and not(ELSE)]" + "following-sibling::expr[OP-LEFT-BRACE and count(*) - count(COMMENT) = 3]/expr[IF and not(ELSE)]" ), collapse = " | " ) diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R index dac02cae4..44965af29 100644 --- a/tests/testthat/test-paren_body_linter.R +++ b/tests/testthat/test-paren_body_linter.R @@ -1,3 +1,4 @@ +# nofuzz start testthat::test_that("paren_body_linter returns correct lints", { linter <- paren_body_linter() lint_msg <- rex::rex("Put a space between a right parenthesis and a body expression.") @@ -95,3 +96,4 @@ test_that("function shorthand is handled", { expect_lint("\\()test", lint_msg, linter) }) +# nofuzz end diff --git a/tests/testthat/test-pipe_continuation_linter.R b/tests/testthat/test-pipe_continuation_linter.R index 1e28c1c61..470ae9c5d 100644 --- a/tests/testthat/test-pipe_continuation_linter.R +++ b/tests/testthat/test-pipe_continuation_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("pipe-continuation correctly handles stand-alone expressions", { linter <- pipe_continuation_linter() lint_msg <- rex::rex("Put a space before `%>%` and a new line after it,") @@ -191,7 +192,7 @@ local({ cases <- within(cases, { .test_name <- sprintf("(%s, %s)", pipe1, pipe2) }) - patrick::with_parameters_test_that( # nofuzz + patrick::with_parameters_test_that( "Various pipes are linted correctly", expect_lint( sprintf("a %s b() %s\n c()", pipe1, pipe2), @@ -201,3 +202,4 @@ local({ .cases = cases ) }) +# nofuzz end diff --git a/tests/testthat/test-trailing_whitespace_linter.R b/tests/testthat/test-trailing_whitespace_linter.R index 329f5a24f..514287e58 100644 --- a/tests/testthat/test-trailing_whitespace_linter.R +++ b/tests/testthat/test-trailing_whitespace_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("returns the correct linting", { linter <- trailing_whitespace_linter() lint_msg <- rex::rex("Remove trailing whitespace.") @@ -68,3 +69,4 @@ test_that("also handles trailing whitespace in string constants", { trailing_whitespace_linter(allow_in_strings = FALSE) ) }) +# nofuzz end diff --git a/tests/testthat/test-unnecessary_nesting_linter.R b/tests/testthat/test-unnecessary_nesting_linter.R index 5bfa80528..64c09855a 100644 --- a/tests/testthat/test-unnecessary_nesting_linter.R +++ b/tests/testthat/test-unnecessary_nesting_linter.R @@ -496,6 +496,21 @@ test_that("unnecessary_nesting_linter skips allowed usages", { linter ) + # but comments are irrelevant (they should be moved to another anchor) + expect_lint( + trim_some(" + if (x && a) { + # comment1 + if (y || b) { + 1L + } + # comment2 + } + "), + "Combine this `if` statement with the one found at line 1", + linter + ) + expect_no_lint( trim_some(" if (x) { From 29a6232f354faca99717abd0a0dbb66bf7d54365 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 22:54:20 -0800 Subject: [PATCH 078/131] another nofuzz, another true fix --- R/shared_constants.R | 2 +- tests/testthat/test-nested_pipe_linter.R | 2 +- tests/testthat/test-object_length_linter.R | 10 ++++++++++ tests/testthat/test-object_name_linter.R | 10 ++++++++++ 4 files changed, 22 insertions(+), 2 deletions(-) diff --git a/R/shared_constants.R b/R/shared_constants.R index 20c054c11..dbad48dcb 100644 --- a/R/shared_constants.R +++ b/R/shared_constants.R @@ -220,7 +220,7 @@ object_name_xpath <- local({ ]" # either an argument supplied positionally, i.e., not like 'arg = val', or the call - not_kwarg_cond <- "not(preceding-sibling::*[1][self::EQ_SUB])" + not_kwarg_cond <- "not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])" glue(xp_strip_comments(" //SYMBOL[ {sprintf(xp_assignment_target_fmt, 'ancestor', '')} ] diff --git a/tests/testthat/test-nested_pipe_linter.R b/tests/testthat/test-nested_pipe_linter.R index 1e1679238..0155f5cd8 100644 --- a/tests/testthat/test-nested_pipe_linter.R +++ b/tests/testthat/test-nested_pipe_linter.R @@ -133,7 +133,7 @@ test_that("Native pipes are handled as well", { linter_inline <- nested_pipe_linter(allow_inline = FALSE) lint_msg <- rex::rex("Don't nest pipes inside other calls.") - expect_lint( + expect_lint( # nofuzz "bind_rows(a |> select(b), c |> select(b))", NULL, linter diff --git a/tests/testthat/test-object_length_linter.R b/tests/testthat/test-object_length_linter.R index 240c86192..051c6bf2f 100644 --- a/tests/testthat/test-object_length_linter.R +++ b/tests/testthat/test-object_length_linter.R @@ -104,4 +104,14 @@ test_that("literals in assign() and setGeneric() are checked", { expect_lint("assign(x = 'badBadBadBadName', 2, env)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', 'badBadBadBadName', 2)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', x = 'badBadBadBadName', 2)", lint_msg, linter) + + # adversarial comments + expect_lint( + trim_some(" + assign(envir = # comment + 'good_env_name', 'badBadBadBadName', 2) + "), + lint_msg, + linter + ) }) diff --git a/tests/testthat/test-object_name_linter.R b/tests/testthat/test-object_name_linter.R index 75fdcb00d..dc520efe1 100644 --- a/tests/testthat/test-object_name_linter.R +++ b/tests/testthat/test-object_name_linter.R @@ -308,6 +308,16 @@ test_that("literals in assign() and setGeneric() are checked", { expect_lint("assign(x = 'badName', 2, env)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', 'badName', 2)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', x = 'badName', 2)", lint_msg, linter) + + # adversarial comments + expect_lint( + trim_some(" + assign(envir = # comment + 'good_env_name', 'badName', 2) + "), + lint_msg, + linter + ) }) test_that("generics assigned with '=' or <<- are registered", { From 85fd53ebd93aa2bf09a5ef397cb6f5cdde118103 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 23:10:21 -0800 Subject: [PATCH 079/131] another case requiring stripping comments, more nofuzz --- R/literal_coercion_linter.R | 4 +--- R/sort_linter.R | 4 +++- R/xml_utils.R | 11 +++++++++++ tests/testthat/test-if_switch_linter.R | 2 +- tests/testthat/test-sort_linter.R | 16 ++++++++++++++++ .../test-spaces_left_parentheses_linter.R | 2 ++ 6 files changed, 34 insertions(+), 5 deletions(-) diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index 15dee2557..b5a8c340c 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -89,9 +89,7 @@ literal_coercion_linter <- function() { ) # nocov end } else { - # Delete COMMENT nodes, being careful that xml2 objects are mutable - bad_expr <- clone_xml_(bad_expr) - for (comment in xml_find_all(bad_expr, ".//COMMENT")) xml2::xml_remove(comment) + bad_expr <- strip_comments_from_subtree(bad_expr) # duplicate, unless we add 'rlang::' and it wasn't there originally coercion_str <- report_str <- xml_text(bad_expr) if (any(is_rlang_coercer) && !("package:rlang" %in% search())) { diff --git a/R/sort_linter.R b/R/sort_linter.R index aa66ece89..424ac5c41 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -69,7 +69,7 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export sort_linter <- function() { - non_keyword_arg <- "expr[not(preceding-sibling::*[1][self::EQ_SUB])]" + non_keyword_arg <- "expr[not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])]" order_xpath <- glue(" //OP-LEFT-BRACKET /following-sibling::expr[1][ @@ -106,6 +106,8 @@ sort_linter <- function() { ".//SYMBOL_FUNCTION_CALL[text() = 'order']/parent::expr[1]/following-sibling::expr[1]" )) + order_expr <- strip_comments_from_subtree(order_expr) + orig_call <- sprintf("%s[%s]", variable, get_r_string(order_expr)) # Reconstruct new argument call for each expression separately diff --git a/R/xml_utils.R b/R/xml_utils.R index f09ce379d..a4fe98e9b 100644 --- a/R/xml_utils.R +++ b/R/xml_utils.R @@ -25,6 +25,17 @@ clone_xml_ <- function(x) { xml_find_all(doc, "*") } +# caveat: whether this is a copy or not is inconsistent. assume the output is read-only! +strip_comments_from_subtree <- function(expr) { + comments <- xml_find_all(expr, ".//COMMENT") + if (length(comments) == 0L) { + return(expr) + } + expr <- clone_xml_(expr) + for (comment in xml_find_all(expr, ".//COMMENT")) xml2::xml_remove(comment) + expr +} + safe_parse_to_xml <- function(parsed_content) { if (is.null(parsed_content)) { return(xml2::xml_missing()) diff --git a/tests/testthat/test-if_switch_linter.R b/tests/testthat/test-if_switch_linter.R index e6b3e5fe5..1325fdcf4 100644 --- a/tests/testthat/test-if_switch_linter.R +++ b/tests/testthat/test-if_switch_linter.R @@ -217,7 +217,7 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { expect_lint(five_expr_three_lines_lines, NULL, max_expr4_linter) }) -test_that("max_branch_lines= and max_branch_expressions= block over-complex switch() too", { +test_that("max_branch_lines= and max_branch_expressions= block over-complex switch() too", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_lines4_linter <- if_switch_linter(max_branch_lines = 4L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) diff --git a/tests/testthat/test-sort_linter.R b/tests/testthat/test-sort_linter.R index 15d8ab209..3a819a773 100644 --- a/tests/testthat/test-sort_linter.R +++ b/tests/testthat/test-sort_linter.R @@ -62,6 +62,22 @@ test_that("sort_linter produces customized warning message", { rex::rex("sort(f(), na.last = TRUE) is better than f()[order(f())]"), linter ) + + expect_lint( + trim_some(" + x[ # comment + order( # comment + x # comment + , # comment + na.last # comment + = # comment + FALSE # comment + ) # comment + ] + "), + rex::rex("sort(x, na.last = FALSE)"), + linter + ) }) test_that("sort_linter works with multiple lints in a single expression", { diff --git a/tests/testthat/test-spaces_left_parentheses_linter.R b/tests/testthat/test-spaces_left_parentheses_linter.R index ce854828c..cc808354b 100644 --- a/tests/testthat/test-spaces_left_parentheses_linter.R +++ b/tests/testthat/test-spaces_left_parentheses_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("spaces_left_parentheses_linter skips allowed usages", { linter <- spaces_left_parentheses_linter() @@ -111,3 +112,4 @@ test_that("lints vectorize", { spaces_left_parentheses_linter() ) }) +# nofuzz end From 7ae65525c0df0b7bd6de67efeb4ec4fd7ee50658 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 23:19:44 -0800 Subject: [PATCH 080/131] fix yet another, nofuzz --- R/unnecessary_concatenation_linter.R | 2 +- tests/testthat/test-infix_spaces_linter.R | 2 +- tests/testthat/test-nested_pipe_linter.R | 2 +- tests/testthat/test-unnecessary_concatenation_linter.R | 10 ++++++++++ 4 files changed, 13 insertions(+), 3 deletions(-) diff --git a/R/unnecessary_concatenation_linter.R b/R/unnecessary_concatenation_linter.R index 271d2ece6..519662a91 100644 --- a/R/unnecessary_concatenation_linter.R +++ b/R/unnecessary_concatenation_linter.R @@ -66,7 +66,7 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # pipes <- setdiff(magrittr_pipes, "%$%") to_pipe_xpath <- glue(" - ./preceding-sibling::*[1][ + ./preceding-sibling::*[not(self::COMMENT)][1][ self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }] ] diff --git a/tests/testthat/test-infix_spaces_linter.R b/tests/testthat/test-infix_spaces_linter.R index 245ac8a4e..289e9665f 100644 --- a/tests/testthat/test-infix_spaces_linter.R +++ b/tests/testthat/test-infix_spaces_linter.R @@ -121,7 +121,7 @@ test_that("assignment cases return the correct linting", { expect_lint("blah =1", lint_msg, linter) }) -test_that("infix_spaces_linter can allow >1 spaces optionally", { +test_that("infix_spaces_linter can allow >1 spaces optionally", { # nofuzz linter <- infix_spaces_linter(allow_multiple_spaces = FALSE) lint_msg <- rex::rex("Put exactly one space on each side of infix operators.") diff --git a/tests/testthat/test-nested_pipe_linter.R b/tests/testthat/test-nested_pipe_linter.R index 0155f5cd8..7f2857c85 100644 --- a/tests/testthat/test-nested_pipe_linter.R +++ b/tests/testthat/test-nested_pipe_linter.R @@ -156,7 +156,7 @@ test_that("Native pipes are handled as well", { ) }) -test_that("lints vectorize", { +test_that("lints vectorize", { # nofuzz lint_msg <- rex::rex("Don't nest pipes inside other calls.") lines <- trim_some("{ diff --git a/tests/testthat/test-unnecessary_concatenation_linter.R b/tests/testthat/test-unnecessary_concatenation_linter.R index 55abd21b0..d8cae3f6b 100644 --- a/tests/testthat/test-unnecessary_concatenation_linter.R +++ b/tests/testthat/test-unnecessary_concatenation_linter.R @@ -63,6 +63,16 @@ local({ ) }) +test_that("logic survives adversarial comments", { + expect_no_lint( + trim_some(' + "a" %T>% # comment + c("b") + '), + unnecessary_concatenation_linter() + ) +}) + test_that("symbolic expressions are allowed, except by request", { linter <- unnecessary_concatenation_linter() linter_strict <- unnecessary_concatenation_linter(allow_single_expression = FALSE) From c7500799201ccc15631d140e7c30e260d298555e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 23:22:17 -0800 Subject: [PATCH 081/131] another fix --- R/expect_comparison_linter.R | 2 +- tests/testthat/test-expect_comparison_linter.R | 9 +++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/R/expect_comparison_linter.R b/R/expect_comparison_linter.R index 6f8b35577..fdd8b1911 100644 --- a/R/expect_comparison_linter.R +++ b/R/expect_comparison_linter.R @@ -65,7 +65,7 @@ expect_comparison_linter <- function() { xml_calls <- source_expression$xml_find_function_calls("expect_true") bad_expr <- xml_find_all(xml_calls, xpath) - comparator <- xml_find_chr(bad_expr, "string(expr[2]/*[2])") + comparator <- xml_find_chr(bad_expr, "string(expr[2]/*[not(self::COMMENT)][2])") expectation <- comparator_expectation_map[comparator] lint_message <- sprintf("%s(x, y) is better than expect_true(x %s y).", expectation, comparator) xml_nodes_to_lints(bad_expr, source_expression, lint_message = lint_message, type = "warning") diff --git a/tests/testthat/test-expect_comparison_linter.R b/tests/testthat/test-expect_comparison_linter.R index cf1a349aa..f4a6b9bd0 100644 --- a/tests/testthat/test-expect_comparison_linter.R +++ b/tests/testthat/test-expect_comparison_linter.R @@ -49,6 +49,15 @@ test_that("expect_comparison_linter blocks simple disallowed usages", { rex::rex("expect_identical(x, y) is better than expect_true(x == y)."), linter ) + + expect_lint( + trim_some(" + expect_true(x # comment + == (y == 2)) + "), + rex::rex("expect_identical(x, y) is better than expect_true(x == y)."), + expect_comparison_linter() + ) }) test_that("lints vectorize", { From 7cede8e94016d4aec73e5594752968f672b1445f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 23:23:50 -0800 Subject: [PATCH 082/131] closer & closer: another --- R/empty_assignment_linter.R | 2 +- tests/testthat/test-empty_assignment_linter.R | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/R/empty_assignment_linter.R b/R/empty_assignment_linter.R index 2ea602763..e5bd8aecf 100644 --- a/R/empty_assignment_linter.R +++ b/R/empty_assignment_linter.R @@ -33,7 +33,7 @@ empty_assignment_linter <- make_linter_from_xpath( # for some reason, the parent in the `=` case is , not , hence parent::expr xpath = " - //OP-LEFT-BRACE[following-sibling::*[1][self::OP-RIGHT-BRACE]] + //OP-LEFT-BRACE[following-sibling::*[not(self::COMMENT)][1][self::OP-RIGHT-BRACE]] /parent::expr[ preceding-sibling::LEFT_ASSIGN or preceding-sibling::EQ_ASSIGN diff --git a/tests/testthat/test-empty_assignment_linter.R b/tests/testthat/test-empty_assignment_linter.R index 8bf39b34a..1cc4d9618 100644 --- a/tests/testthat/test-empty_assignment_linter.R +++ b/tests/testthat/test-empty_assignment_linter.R @@ -24,6 +24,7 @@ test_that("empty_assignment_linter blocks disallowed usages", { # newlines also don't matter expect_lint("x <- {\n}", lint_msg, linter) + expect_lint("x <- { # comment\n}", lint_msg, linter) # LHS of assignment doesn't matter expect_lint("env$obj <- {}", lint_msg, linter) From bacce087bb13b4c74c4eaf1ffdf463852ec3cefb Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Mar 2025 23:55:48 -0800 Subject: [PATCH 083/131] found the MRE, not fixed yet --- R/object_usage_linter.R | 4 ++-- R/utils.R | 5 ++--- tests/testthat/test-object_usage_linter.R | 15 +++++++++++++++ 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 70ebe76c1..9cfe80c07 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -178,8 +178,8 @@ get_assignment_symbols <- function(xml) { expr[RIGHT_ASSIGN]/expr[2]/SYMBOL[1] | equal_assign/expr[1]/SYMBOL[1] | expr_or_assign_or_help/expr[1]/SYMBOL[1] | - expr[expr[1][SYMBOL_FUNCTION_CALL/text()='assign']]/expr[2]/* | - expr[expr[1][SYMBOL_FUNCTION_CALL/text()='setMethod']]/expr[2]/* + expr[expr[1][SYMBOL_FUNCTION_CALL/text() = 'assign']]/expr[2]/* | + expr[expr[1][SYMBOL_FUNCTION_CALL/text() = 'setMethod']]/expr[2]/* " )) } diff --git a/R/utils.R b/R/utils.R index 748a73658..285602f64 100644 --- a/R/utils.R +++ b/R/utils.R @@ -91,10 +91,9 @@ get_content <- function(lines, info) { lines[is.na(lines)] <- "" if (!missing(info)) { + # put in data.frame-like format if (is_node(info)) { - info <- lapply(stats::setNames(nm = c("col1", "col2", "line1", "line2")), function(attr) { - as.integer(xml_attr(info, attr)) - }) + info <- lapply(xml2::xml_attrs(info), as.integer) } lines <- lines[seq(info$line1, info$line2)] diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index cd9172619..3bb9cbbb9 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -750,6 +750,21 @@ test_that("symbols in formulas aren't treated as 'undefined global'", { ), linter ) + + # native lambda requires being in an expression to support a comment immediately after + expect_lint( + trim_some(" + foo <- \\ # comment + (x) { + lm( + y(w) ~ z, + data = x[!is.na(y)] + ) + } + "), + "no visible", + linter + ) }) test_that("NSE-ish symbols after $/@ are ignored as sources for lints", { From edfe6d3e658140beb2d8b8828c312666a37e0feb Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 14:30:07 -0800 Subject: [PATCH 084/131] what eldritch horrors... --- R/object_usage_linter.R | 26 ++++++++++++++++++-------- R/utils.R | 3 ++- 2 files changed, 20 insertions(+), 9 deletions(-) diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 9cfe80c07..b41211633 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -61,13 +61,21 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( # NB: the repeated expr[2][FUNCTION] XPath has no performance impact, so the different direct assignment XPaths are # split for better readability, see PR#1197 # TODO(#1106): use //[...] to capture assignments in more scopes - xpath_function_assignment <- " - expr[LEFT_ASSIGN or EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | expr_or_assign_or_help[EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | equal_assign[EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | //SYMBOL_FUNCTION_CALL[text() = 'assign']/parent::expr/following-sibling::expr[2][FUNCTION or OP-LAMBDA] - | //SYMBOL_FUNCTION_CALL[text() = 'setMethod']/parent::expr/following-sibling::expr[3][FUNCTION or OP-LAMBDA] - " + fun_node <- "FUNCTION or OP-LAMBDA" + xpath_function_assignment <- glue(" + expr[LEFT_ASSIGN or EQ_ASSIGN]/expr[2][{fun_node}] + | expr_or_assign_or_help[EQ_ASSIGN]/expr[2][{fun_node}] + | equal_assign[EQ_ASSIGN]/expr[2][{fun_node}] + | //SYMBOL_FUNCTION_CALL[text() = 'assign']/parent::expr/following-sibling::expr[2][{fun_node}] + | //SYMBOL_FUNCTION_CALL[text() = 'setMethod']/parent::expr/following-sibling::expr[3][{fun_node}] + ") + + # code like:content + # foo <- \ #comment + # (x) x + # is technically valid, but won't parse unless the lambda is in a bigger expression (here '<-'). + # the same doesn't apply to 'function'. + xpath_unsafe_lambda <- "OP-LAMBDA[@line1 = following-sibling::*[1][self::COMMENT]/@line1]" # not all instances of linted symbols are potential sources for the observed violations -- see #1914 symbol_exclude_cond <- "preceding-sibling::OP-DOLLAR or preceding-sibling::OP-AT or ancestor::expr[OP-TILDE]" @@ -91,7 +99,9 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( fun_assignments <- xml_find_all(xml, xpath_function_assignment) lapply(fun_assignments, function(fun_assignment) { - code <- get_content(lines = source_expression$content, fun_assignment) + # this will mess with the source line numbers. but I don't think anybody cares. + known_safe <- is.na(xml_find_first(fun_assignment, xpath_unsafe_lambda)) + code <- get_content(lines = source_expression$content, fun_assignment, known_safe = known_safe) fun <- try_silently(eval( envir = env, parse( diff --git a/R/utils.R b/R/utils.R index 285602f64..65271d74e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -87,7 +87,7 @@ names2 <- function(x) { names(x) %|||% rep("", length(x)) } -get_content <- function(lines, info) { +get_content <- function(lines, info, known_safe = TRUE) { lines[is.na(lines)] <- "" if (!missing(info)) { @@ -100,6 +100,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])) } + if (!known_safe) lines <- c("{", lines, "}") paste(lines, collapse = "\n") } From 06b20473f0c5a6cf5616837de95e615c691684e9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 14:40:41 -0800 Subject: [PATCH 085/131] the easier fixes continue --- R/matrix_apply_linter.R | 1 + tests/testthat/test-matrix_apply_linter.R | 27 +++++++++-------------- 2 files changed, 12 insertions(+), 16 deletions(-) diff --git a/R/matrix_apply_linter.R b/R/matrix_apply_linter.R index 6691bc00f..2a99100d4 100644 --- a/R/matrix_apply_linter.R +++ b/R/matrix_apply_linter.R @@ -97,6 +97,7 @@ matrix_apply_linter <- function() { Linter(linter_level = "expression", function(source_expression) { xml_calls <- source_expression$xml_find_function_calls("apply") bad_expr <- xml_find_all(xml_calls, xpath) + bad_expr <- strip_comments_from_subtree(bad_expr) variable <- xml_text(xml_find_all(bad_expr, variable_xpath)) diff --git a/tests/testthat/test-matrix_apply_linter.R b/tests/testthat/test-matrix_apply_linter.R index 0a30b3ce1..b896c54e7 100644 --- a/tests/testthat/test-matrix_apply_linter.R +++ b/tests/testthat/test-matrix_apply_linter.R @@ -26,53 +26,49 @@ test_that("matrix_apply_linter is not implemented for complex MARGIN values", { expect_lint("apply(x, m, sum)", NULL, linter) expect_lint("apply(x, 1 + 2:4, sum)", NULL, linter) - }) test_that("matrix_apply_linter simple disallowed usages", { linter <- matrix_apply_linter() - lint_message <- rex::rex("rowSums(x)") + lint_message <- rex::rex("rowSums(x)") expect_lint("apply(x, 1, sum)", lint_message, linter) - expect_lint("apply(x, MARGIN = 1, FUN = sum)", lint_message, linter) - expect_lint("apply(x, 1L, sum)", lint_message, linter) - expect_lint("apply(x, 1:4, sum)", rex::rex("rowSums(x, dims = 4)"), linter) - expect_lint("apply(x, 2, sum)", rex::rex("rowSums(colSums(x))"), linter) - expect_lint("apply(x, 2:4, sum)", rex::rex("rowSums(colSums(x), dims = 3)"), linter) lint_message <- rex::rex("rowMeans") - expect_lint("apply(x, 1, mean)", lint_message, linter) - expect_lint("apply(x, MARGIN = 1, FUN = mean)", lint_message, linter) # Works with extra args in mean() expect_lint("apply(x, 1, mean, na.rm = TRUE)", lint_message, linter) lint_message <- rex::rex("colMeans") - expect_lint("apply(x, 2, mean)", lint_message, linter) - expect_lint("apply(x, 2:4, mean)", lint_message, linter) + # adversarial comments + expect_lint( + trim_some(" + apply(x, 2, #comment + mean) + "), + lint_message, + linter + ) }) test_that("matrix_apply_linter recommendation includes na.rm if present in original call", { linter <- matrix_apply_linter() - lint_message <- rex::rex("na.rm = TRUE") + lint_message <- rex::rex("na.rm = TRUE") expect_lint("apply(x, 1, sum, na.rm = TRUE)", lint_message, linter) - expect_lint("apply(x, 2, sum, na.rm = TRUE)", lint_message, linter) - expect_lint("apply(x, 1, mean, na.rm = TRUE)", lint_message, linter) - expect_lint("apply(x, 2, mean, na.rm = TRUE)", lint_message, linter) lint_message <- rex::rex("rowSums(x)") @@ -80,7 +76,6 @@ test_that("matrix_apply_linter recommendation includes na.rm if present in origi lint_message <- rex::rex("na.rm = foo") expect_lint("apply(x, 1, sum, na.rm = foo)", lint_message, linter) - }) test_that("matrix_apply_linter works with multiple lints in a single expression", { From de0bf4a7a317e8a1b1fcb77fa1b3e0f51edbd18b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 14:54:07 -0800 Subject: [PATCH 086/131] modernize the test file first to apply nofuzz next --- tests/testthat/test-semicolon_linter.R | 127 +++++++++++++++++-------- 1 file changed, 88 insertions(+), 39 deletions(-) diff --git a/tests/testthat/test-semicolon_linter.R b/tests/testthat/test-semicolon_linter.R index 8a72da509..3d75e0ef5 100644 --- a/tests/testthat/test-semicolon_linter.R +++ b/tests/testthat/test-semicolon_linter.R @@ -1,64 +1,91 @@ -test_that("Lint all semicolons", { +test_that("semicolon_linter skips allowed usages", { linter <- semicolon_linter() - trail_msg <- rex::rex("Remove trailing semicolons.") - comp_msg <- rex::rex("Replace compound semicolons by a newline.") - # No semicolon - expect_lint("", NULL, linter) - expect_lint("a <- 1", NULL, linter) - expect_lint("function() {a <- 1}", NULL, linter) - expect_lint("a <- \"foo;bar\"", NULL, linter) - expect_lint("function() {a <- \"foo;bar\"}", NULL, linter) - expect_lint("a <- FALSE # ok; cool!", NULL, linter) - expect_lint("function() {\na <- FALSE # ok; cool!\n}", NULL, linter) + expect_no_lint("", linter) + expect_no_lint("a <- 1", linter) + expect_no_lint("function() {a <- 1}", linter) + expect_no_lint('a <- "foo;bar"', linter) + expect_no_lint('function() {a <- "foo;bar"}', linter) + expect_no_lint("a <- FALSE # ok; cool!", linter) + expect_no_lint( + trim_some(" + function() { + a <- FALSE # ok; cool! + } + "), + linter + ) +}) + +test_that("semicolon_linter handles trailing semicolons", { + linter <- semicolon_linter() + lint_msg <- rex::rex("Remove trailing semicolons.") - # Trailing semicolons expect_lint( "a <- 1;", - list(message = trail_msg, line_number = 1L, column_number = 7L), + list(lint_msg, line_number = 1L, column_number = 7L), linter ) expect_lint( "function(){a <- 1;}", - list(message = trail_msg, line_number = 1L, column_number = 18L), + list(lint_msg, line_number = 1L, column_number = 18L), linter ) expect_lint( - "a <- 1; \n", - list(message = trail_msg, line_number = 1L, column_number = 7L), - linter - ) - expect_lint( - "function(){a <- 1; \n}", - list(message = trail_msg, line_number = 1L, column_number = 18L), + trim_some(" + function() { + a <- 1; + }" + ), + list(lint_msg, line_number = 1L, column_number = 18L), linter ) +}) + +test_that("semicolon_linter handles compound semicolons", { + linter <- semicolon_linter() + lint_msg <- rex::rex("Replace compound semicolons by a newline.") - # Compound semicolons expect_lint( "a <- 1;b <- 2", - list(message = comp_msg, line_number = 1L, column_number = 7L), + list(comp_msg, line_number = 1L, column_number = 7L), linter ) expect_lint( - "function() {a <- 1;b <- 2}\n", - list(message = comp_msg, line_number = 1L, column_number = 19L), + "function() {a <- 1;b <- 2}", + list(comp_msg, line_number = 1L, column_number = 19L), linter ) expect_lint( - "foo <-\n 1 ; foo <- 1.23", - list(message = comp_msg, line_number = 2L, column_number = 6L), + trim_some(" + foo <- + 1 ; foo <- 1.23 + "), + list(comp_msg, line_number = 2L, column_number = 6L), linter ) expect_lint( - "function(){\nfoo <-\n 1 ; foo <- 1.23\n}", - list(message = comp_msg, line_number = 3L, column_number = 6L), + trim_some(" + function() { + foo <- + 1 ; foo <- 1.23 + } + "), + list(comp_msg, line_number = 3L, column_number = 6L), linter ) +}) + +test_that("semicolon_linter handles multiple/mixed semicolons", { + linter <- semicolon_linter() + trail_msg <- rex::rex("Remove trailing semicolons.") + comp_msg <- rex::rex("Replace compound semicolons by a newline.") - # Multiple, mixed semicolons", { expect_lint( - "a <- 1 ; b <- 2;\nc <- 3;", + trim_some(" + a <- 1 ; b <- 2; + c <- 3; + "), list( list(message = comp_msg, line_number = 1L, column_number = 8L), list(message = trail_msg, line_number = 1L, column_number = 16L), @@ -67,7 +94,10 @@ test_that("Lint all semicolons", { linter ) expect_lint( - "function() { a <- 1 ; b <- 2;\nc <- 3;}", + trim_some(" + function() { a <- 1 ; b <- 2; + c <- 3;} + "), list( list(message = comp_msg, line_number = 1L, column_number = 21L), list(message = trail_msg, line_number = 1L, column_number = 29L), @@ -80,19 +110,38 @@ test_that("Lint all semicolons", { test_that("Compound semicolons only", { linter <- semicolon_linter(allow_trailing = TRUE) - expect_lint("a <- 1;", NULL, linter) - expect_lint("function(){a <- 1;}", NULL, linter) - expect_lint("a <- 1; \n", NULL, linter) - expect_lint("function(){a <- 1; \n}", NULL, linter) + expect_no_lint("a <- 1;", linter) + expect_no_lint("function(){a <- 1;}", linter) + expect_no_lint( + trim_some(" + function(){a <- 1; + } + "), + linter + ) }) test_that("Trailing semicolons only", { linter <- semicolon_linter(allow_compound = TRUE) expect_lint("a <- 1;b <- 2", NULL, linter) - expect_lint("function() {a <- 1;b <- 2}\n", NULL, linter) - expect_lint("f <-\n 1 ;f <- 1.23", NULL, linter) - expect_lint("function(){\nf <-\n 1 ;f <- 1.23\n}", NULL, linter) + expect_no_lint("function() {a <- 1;b <- 2}", linter) + expect_no_lint( + trim_some(" + f <- + 1 ;f <- 1.23 + "), + linter + ) + expect_no_lint( + trim_some(" + function(){ + f <- + 1 ;f <- 1.23 + } + "), + linter + ) }) From 15d3a5014c5d0fca7f9f2cf7330ff96de97476ed Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 14:57:20 -0800 Subject: [PATCH 087/131] further tweak, nofuzz --- tests/testthat/test-semicolon_linter.R | 27 +++++++++++++------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/tests/testthat/test-semicolon_linter.R b/tests/testthat/test-semicolon_linter.R index 3d75e0ef5..1d8fb66c7 100644 --- a/tests/testthat/test-semicolon_linter.R +++ b/tests/testthat/test-semicolon_linter.R @@ -33,27 +33,26 @@ test_that("semicolon_linter handles trailing semicolons", { ) expect_lint( trim_some(" - function() { - a <- 1; + function() { a <- 1; }" ), - list(lint_msg, line_number = 1L, column_number = 18L), + list(lint_msg, line_number = 1L, column_number = 20L), linter ) }) -test_that("semicolon_linter handles compound semicolons", { +test_that("semicolon_linter handles compound semicolons", { # nofuzz linter <- semicolon_linter() lint_msg <- rex::rex("Replace compound semicolons by a newline.") expect_lint( "a <- 1;b <- 2", - list(comp_msg, line_number = 1L, column_number = 7L), + list(lint_msg, line_number = 1L, column_number = 7L), linter ) expect_lint( "function() {a <- 1;b <- 2}", - list(comp_msg, line_number = 1L, column_number = 19L), + list(lint_msg, line_number = 1L, column_number = 19L), linter ) expect_lint( @@ -61,22 +60,22 @@ test_that("semicolon_linter handles compound semicolons", { foo <- 1 ; foo <- 1.23 "), - list(comp_msg, line_number = 2L, column_number = 6L), + list(lint_msg, line_number = 2L, column_number = 6L), linter ) expect_lint( trim_some(" function() { foo <- - 1 ; foo <- 1.23 + 1 ; foo <- 1.23 } "), - list(comp_msg, line_number = 3L, column_number = 6L), + list(lint_msg, line_number = 3L, column_number = 6L), linter ) }) -test_that("semicolon_linter handles multiple/mixed semicolons", { +test_that("semicolon_linter handles multiple/mixed semicolons", { # nofuzz linter <- semicolon_linter() trail_msg <- rex::rex("Remove trailing semicolons.") comp_msg <- rex::rex("Replace compound semicolons by a newline.") @@ -101,14 +100,14 @@ test_that("semicolon_linter handles multiple/mixed semicolons", { list( list(message = comp_msg, line_number = 1L, column_number = 21L), list(message = trail_msg, line_number = 1L, column_number = 29L), - list(message = trail_msg, line_number = 2L, column_number = 7L) + list(message = trail_msg, line_number = 2L, column_number = 9L) ), linter ) }) -test_that("Compound semicolons only", { +test_that("Compound semicolons only", { # nofuzz linter <- semicolon_linter(allow_trailing = TRUE) expect_no_lint("a <- 1;", linter) expect_no_lint("function(){a <- 1;}", linter) @@ -145,9 +144,9 @@ test_that("Trailing semicolons only", { }) -test_that("Compound semicolons only", { +test_that("Compound semicolons only", { # nofuzz expect_error( - lint(text = "a <- 1;", linters = semicolon_linter(allow_trailing = TRUE, allow_compound = TRUE)), + semicolon_linter(allow_trailing = TRUE, allow_compound = TRUE), "At least one of `allow_compound` or `allow_trailing` must be `FALSE`", fixed = TRUE ) From 7699a7c3e0981abf293c7bdef86324e713b806de Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 15:01:48 -0800 Subject: [PATCH 088/131] ban the '*' --- R/ifelse_censor_linter.R | 2 +- tests/testthat/test-ifelse_censor_linter.R | 22 ++++++++++++++++------ 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/R/ifelse_censor_linter.R b/R/ifelse_censor_linter.R index fd9d1e9a5..87bba6102 100644 --- a/R/ifelse_censor_linter.R +++ b/R/ifelse_censor_linter.R @@ -49,7 +49,7 @@ ifelse_censor_linter <- function() { bad_expr <- xml_find_all(ifelse_calls, xpath) matched_call <- xp_call_name(bad_expr) - operator <- xml_find_chr(bad_expr, "string(expr[2]/*[2])") + operator <- xml_find_chr(bad_expr, "string(expr[2]/*[not(self::COMMENT)][2])") match_first <- !is.na(xml_find_first(bad_expr, "expr[2][expr[1] = following-sibling::expr[1]]")) optimizer <- ifelse((operator %in% c("<", "<=")) == match_first, "pmin", "pmax") first_var <- rep_len("x", length(match_first)) diff --git a/tests/testthat/test-ifelse_censor_linter.R b/tests/testthat/test-ifelse_censor_linter.R index 581a4081f..9aedd752c 100644 --- a/tests/testthat/test-ifelse_censor_linter.R +++ b/tests/testthat/test-ifelse_censor_linter.R @@ -56,13 +56,23 @@ test_that("ifelse_censor_linter blocks simple disallowed usages", { ) # more complicated expression still matches - lines <- trim_some(" - ifelse(2 + p + 104 + 1 > ncols, - ncols, 2 + p + 104 + 1 - ) - ") expect_lint( - lines, + trim_some(" + ifelse(2 + p + 104 + 1 > ncols, + ncols, 2 + p + 104 + 1 + ) + "), + rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"), + linter + ) + + # including with comments + expect_lint( + trim_some(" + ifelse(2 + p + 104 + 1 #comment + > ncols, ncols, 2 + p + 104 + 1 + ) + "), rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"), linter ) From 4c38b9005262af8241e0b64e3ee70b2486b1fc5c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 15:24:49 -0800 Subject: [PATCH 089/131] node equality tests are going to be a pain... --- NAMESPACE | 1 + R/lintr-package.R | 3 ++- R/regex_subset_linter.R | 26 +++++++++++------------ tests/testthat/test-regex_subset_linter.R | 10 +++++++++ 4 files changed, 25 insertions(+), 15 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8c20f1f68..ba4e2f0b1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -192,4 +192,5 @@ importFrom(xml2,xml_find_first) importFrom(xml2,xml_find_lgl) importFrom(xml2,xml_find_num) importFrom(xml2,xml_name) +importFrom(xml2,xml_parent) importFrom(xml2,xml_text) diff --git a/R/lintr-package.R b/R/lintr-package.R index cd0b9bd5d..c9a36b58f 100644 --- a/R/lintr-package.R +++ b/R/lintr-package.R @@ -15,7 +15,8 @@ #' @importFrom tools R_user_dir #' @importFrom utils capture.output getParseData globalVariables head relist tail #' @importFrom xml2 as_list -#' xml_attr xml_children xml_find_all xml_find_chr xml_find_lgl xml_find_num xml_find_first xml_name xml_text +#' xml_attr xml_children xml_find_all xml_find_chr xml_find_lgl xml_find_num +#' xml_find_first xml_name xml_parent xml_text ## lintr namespace: end NULL diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index b6471e72f..1102880f4 100644 --- a/R/regex_subset_linter.R +++ b/R/regex_subset_linter.R @@ -47,25 +47,20 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export regex_subset_linter <- function() { - # parent::expr for LEFT_ASSIGN and RIGHT_ASSIGN, but, strangely, - # parent::equal_assign for EQ_ASSIGN. So just use * as a catchall. - # See https://www.w3.org/TR/1999/REC-xpath-19991116/#booleans; - # equality of nodes is based on the string value of the nodes, which - # is basically what we need, i.e., whatever expression comes in - # [grepl(pattern, )] matches exactly, e.g. names(x)[grepl(ptn, names(x))]. xpath_fmt <- " - parent::expr[ - parent::expr[ - OP-LEFT-BRACKET - and not(parent::*[LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN]) - ] - and expr[position() = {arg_pos} ] = parent::expr/expr[1] + self::*[ + OP-LEFT-BRACKET + and not(parent::*[LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN]) + and expr[1] = expr/expr[position() = {arg_pos} ] ]" grep_xpath <- glue(xpath_fmt, arg_pos = 3L) stringr_xpath <- glue(xpath_fmt, arg_pos = 2L) Linter(linter_level = "expression", function(source_expression) { - grep_calls <- source_expression$xml_find_function_calls(c("grepl", "grep")) + grep_calls <- xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("grepl", "grep")) + )) + grep_calls <- strip_comments_from_subtree(grep_calls) grep_expr <- xml_find_all(grep_calls, grep_xpath) grep_lints <- xml_nodes_to_lints( @@ -76,7 +71,10 @@ regex_subset_linter <- function() { type = "warning" ) - stringr_calls <- source_expression$xml_find_function_calls(c("str_detect", "str_which")) + stringr_calls <- xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("str_detect", "str_which")) + )) + stringr_calls <- strip_comments_from_subtree(stringr_calls) stringr_expr <- xml_find_all(stringr_calls, stringr_xpath) stringr_lints <- xml_nodes_to_lints( diff --git a/tests/testthat/test-regex_subset_linter.R b/tests/testthat/test-regex_subset_linter.R index 27303ee40..dce6ee60a 100644 --- a/tests/testthat/test-regex_subset_linter.R +++ b/tests/testthat/test-regex_subset_linter.R @@ -10,6 +10,16 @@ test_that("regex_subset_linter blocks simple disallowed usages", { expect_lint("x[grep(ptn, x)]", lint_msg, linter) expect_lint("names(y)[grepl(ptn, names(y), perl = TRUE)]", lint_msg, linter) expect_lint("names(foo(y))[grepl(ptn, names(foo(y)), fixed = TRUE)]", lint_msg, linter) + + # adversarial commenting + expect_lint( + trim_some(" + names(y #comment + )[grepl(ptn, names(y), perl = TRUE)] + "), + lint_msg, + linter + ) }) test_that("regex_subset_linter skips grep/grepl subassignment", { From 68ab08df77e1c97e7c9347f114fa4d9d96967202 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 15:34:48 -0800 Subject: [PATCH 090/131] another one requiring a tree copy --- R/length_test_linter.R | 1 + tests/testthat/test-length_test_linter.R | 10 ++++++++++ 2 files changed, 11 insertions(+) diff --git a/R/length_test_linter.R b/R/length_test_linter.R index 0a00117d1..4524a6866 100644 --- a/R/length_test_linter.R +++ b/R/length_test_linter.R @@ -28,6 +28,7 @@ length_test_linter <- function() { Linter(linter_level = "expression", function(source_expression) { xml_calls <- source_expression$xml_find_function_calls("length") bad_expr <- xml_find_all(xml_calls, xpath) + bad_expr <- strip_comments_from_subtree(bad_expr) expr_parts <- vapply( lapply(bad_expr, xml_find_all, "expr[2]/*[not(self::COMMENT)]"), diff --git a/tests/testthat/test-length_test_linter.R b/tests/testthat/test-length_test_linter.R index e9bb9bd75..824cb9e7d 100644 --- a/tests/testthat/test-length_test_linter.R +++ b/tests/testthat/test-length_test_linter.R @@ -12,6 +12,16 @@ test_that("blocks simple disallowed usages", { expect_lint("length(x == 0)", rex::rex(lint_msg_stub, "`length(x) == 0`?"), linter) expect_lint("length(x == y)", rex::rex(lint_msg_stub, "`length(x) == y`?"), linter) expect_lint("length(x + y == 2)", rex::rex(lint_msg_stub, "`length(x+y) == 2`?"), linter) + + # adversarial comments + expect_lint( + trim_some(" + length(x + # + y == 2) + "), + rex::rex(lint_msg_stub, "`length(x+y) == 2`?"), + linter + ) }) local({ From aad82de32ee2e324cb19debec3bde3676344d662 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 15:40:23 -0800 Subject: [PATCH 091/131] nofuzz --- tests/testthat/test-infix_spaces_linter.R | 4 +++- tests/testthat/test-trailing_blank_lines_linter.R | 2 ++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-infix_spaces_linter.R b/tests/testthat/test-infix_spaces_linter.R index 289e9665f..ba7182f83 100644 --- a/tests/testthat/test-infix_spaces_linter.R +++ b/tests/testthat/test-infix_spaces_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("returns the correct linting", { ops <- c( "+", @@ -121,7 +122,7 @@ test_that("assignment cases return the correct linting", { expect_lint("blah =1", lint_msg, linter) }) -test_that("infix_spaces_linter can allow >1 spaces optionally", { # nofuzz +test_that("infix_spaces_linter can allow >1 spaces optionally", { linter <- infix_spaces_linter(allow_multiple_spaces = FALSE) lint_msg <- rex::rex("Put exactly one space on each side of infix operators.") @@ -235,3 +236,4 @@ test_that("lints vectorize", { infix_spaces_linter() ) }) +# nofuzz end diff --git a/tests/testthat/test-trailing_blank_lines_linter.R b/tests/testthat/test-trailing_blank_lines_linter.R index 5b6f89511..9b12e5943 100644 --- a/tests/testthat/test-trailing_blank_lines_linter.R +++ b/tests/testthat/test-trailing_blank_lines_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("trailing_blank_lines_linter doesn't block allowed usages", { linter <- trailing_blank_lines_linter() @@ -158,3 +159,4 @@ test_that("blank lines in knitr chunks produce lints", { linters = linter ) }) +# nofuzz end From 9a508b1173ad36ce6d0dd13ad4944b0ba2c8519e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 15:44:01 -0800 Subject: [PATCH 092/131] *[2] --- R/redundant_equals_linter.R | 2 +- tests/testthat/test-redundant_equals_linter.R | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/R/redundant_equals_linter.R b/R/redundant_equals_linter.R index d986dc184..232deea71 100644 --- a/R/redundant_equals_linter.R +++ b/R/redundant_equals_linter.R @@ -58,7 +58,7 @@ redundant_equals_linter <- function() { xml <- source_expression$xml_parsed_content bad_expr <- xml_find_all(xml, xpath) - op <- xml_text(xml_find_first(bad_expr, "*[2]")) + op <- xml_text(xml_find_first(bad_expr, "*[not(self::COMMENT)][2]")) xml_nodes_to_lints( bad_expr, diff --git a/tests/testthat/test-redundant_equals_linter.R b/tests/testthat/test-redundant_equals_linter.R index 541237f83..5b830e867 100644 --- a/tests/testthat/test-redundant_equals_linter.R +++ b/tests/testthat/test-redundant_equals_linter.R @@ -40,3 +40,14 @@ patrick::with_parameters_test_that( "!=, FALSE", "!=", "FALSE" ) ) + +test_that("logic survives adversarial comments", { + expect_lint( + trim_some(" + list(x # + == TRUE) + "), + "==", + redundant_equals_linter() + ) +}) From 0ad134c834e6d16255fefb3091123cc19754bbf9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Mar 2025 15:49:08 -0800 Subject: [PATCH 093/131] skip another file --- tests/testthat/test-line_length_linter.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/test-line_length_linter.R b/tests/testthat/test-line_length_linter.R index 5e22fc523..5455c51bf 100644 --- a/tests/testthat/test-line_length_linter.R +++ b/tests/testthat/test-line_length_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("line_length_linter skips allowed usages", { linter <- line_length_linter(80L) @@ -71,3 +72,4 @@ test_that("Multiple lints give custom messages", { line_length_linter(5L) ) }) +# nofuzz end From 3929a437b2150c3f2396f59e5fae9818cdd19688 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 10:57:56 -0700 Subject: [PATCH 094/131] preceding-sibling::* --- R/fixed_regex_linter.R | 2 +- tests/testthat/test-fixed_regex_linter.R | 17 ++++++++++++++--- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/R/fixed_regex_linter.R b/R/fixed_regex_linter.R index 02ce1e576..12b45d0a7 100644 --- a/R/fixed_regex_linter.R +++ b/R/fixed_regex_linter.R @@ -120,7 +120,7 @@ fixed_regex_linter <- function(allow_unescaped = FALSE) { and not({ in_pipe_cond }) ) or ( STR_CONST - and preceding-sibling::*[2][self::SYMBOL_SUB/text() = 'pattern'] + and preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB/text() = 'pattern'] ) ] ") diff --git a/tests/testthat/test-fixed_regex_linter.R b/tests/testthat/test-fixed_regex_linter.R index 83a00c141..8fc19873b 100644 --- a/tests/testthat/test-fixed_regex_linter.R +++ b/tests/testthat/test-fixed_regex_linter.R @@ -350,13 +350,13 @@ test_that("'unescaped' regex can optionally be skipped", { }) local({ + linter <- fixed_regex_linter() + lint_msg <- "This regular expression is static" pipes <- pipes(exclude = c("%$%", "%T>%")) + patrick::with_parameters_test_that( "linter is pipe-aware", { - linter <- fixed_regex_linter() - lint_msg <- "This regular expression is static" - expect_lint(paste("x", pipe, "grepl(pattern = 'a')"), lint_msg, linter) expect_lint(paste("x", pipe, "grepl(pattern = '^a')"), NULL, linter) expect_lint(paste("x", pipe, "grepl(pattern = 'a', fixed = TRUE)"), NULL, linter) @@ -375,3 +375,14 @@ local({ .test_name = names(pipes) ) }) + +test_that("pipe-aware lint logic survives adversarial comments", { + expect_lint( + trim_some(" + x %>% grepl(pattern = # INJECTED COMMENT + 'a') + "), + "This regular expression is static", + fixed_regex_linter() + ) +}) From e57707ec684c77efc3c712d0fa3267c2f6497b41 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 11:12:07 -0700 Subject: [PATCH 095/131] improve handling of ifelse_censor, add a new test --- R/ifelse_censor_linter.R | 9 ++++----- tests/testthat/test-ifelse_censor_linter.R | 11 +++++++++-- tests/testthat/test-spaces_inside_linter.R | 16 ++++++++-------- 3 files changed, 21 insertions(+), 15 deletions(-) diff --git a/R/ifelse_censor_linter.R b/R/ifelse_censor_linter.R index 87bba6102..73710f27d 100644 --- a/R/ifelse_censor_linter.R +++ b/R/ifelse_censor_linter.R @@ -36,16 +36,15 @@ #' @export ifelse_censor_linter <- function() { xpath <- glue(" - following-sibling::expr[ + self::*[expr[ (LT or GT or LE or GE) and expr[1] = following-sibling::expr and expr[2] = following-sibling::expr - ] - /parent::expr - ") + ]]") Linter(linter_level = "expression", function(source_expression) { - ifelse_calls <- source_expression$xml_find_function_calls(ifelse_funs) + ifelse_calls <- xml_parent(source_expression$xml_find_function_calls(ifelse_funs)) + ifelse_calls <- strip_comments_from_subtree(ifelse_calls) bad_expr <- xml_find_all(ifelse_calls, xpath) matched_call <- xp_call_name(bad_expr) diff --git a/tests/testthat/test-ifelse_censor_linter.R b/tests/testthat/test-ifelse_censor_linter.R index 9aedd752c..4f9a6014c 100644 --- a/tests/testthat/test-ifelse_censor_linter.R +++ b/tests/testthat/test-ifelse_censor_linter.R @@ -70,8 +70,15 @@ test_that("ifelse_censor_linter blocks simple disallowed usages", { expect_lint( trim_some(" ifelse(2 + p + 104 + 1 #comment - > ncols, ncols, 2 + p + 104 + 1 - ) + > ncols, ncols, 2 + p + 104 + 1) + "), + rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"), + linter + ) + expect_lint( + trim_some(" + ifelse(2 + p + 104 + # comment + 1 > ncols, ncols, 2 + p + 104 + 1) "), rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"), linter diff --git a/tests/testthat/test-spaces_inside_linter.R b/tests/testthat/test-spaces_inside_linter.R index e8078ac66..e2c93329e 100644 --- a/tests/testthat/test-spaces_inside_linter.R +++ b/tests/testthat/test-spaces_inside_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("spaces_inside_linter skips allowed usages", { linter <- spaces_inside_linter() @@ -36,7 +37,7 @@ test_that("spaces_inside_linter skips allowed usages", { test_that("spaces_inside_linter blocks diallowed usages", { linter <- spaces_inside_linter() - expect_lint( # nofuzz + expect_lint( "a[1 ]", list( "Do not place spaces before square brackets", @@ -47,7 +48,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { linter ) - expect_lint( # nofuzz + expect_lint( "a[[1 ]]", list( "Do not place spaces before square brackets", @@ -69,7 +70,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { linter ) - expect_lint( # nofuzz + expect_lint( "a[ 1 ]", list( list( @@ -88,7 +89,7 @@ test_that("spaces_inside_linter blocks diallowed usages", { linter ) - expect_lint( # nofuzz + expect_lint( "a(1 )", list( "Do not place spaces before parentheses", @@ -121,7 +122,6 @@ test_that("spaces_inside_linter blocks diallowed usages", { linter ) - # nofuzz start expect_lint( "x[[ 1L ]]", list( @@ -181,11 +181,10 @@ test_that("spaces_inside_linter blocks diallowed usages", { ), linter ) - # nofuzz end }) test_that("multi-line expressions have good markers", { - expect_lint( # nofuzz + expect_lint( trim_some(" ( x | y ) @@ -198,7 +197,7 @@ test_that("multi-line expressions have good markers", { ) }) -test_that("spaces_inside_linter blocks disallowed usages with a pipe", { # nofuzz +test_that("spaces_inside_linter blocks disallowed usages with a pipe", { skip_if_not_r_version("4.1.0") linter <- spaces_inside_linter() @@ -245,3 +244,4 @@ test_that("spaces_inside_linter blocks disallowed usages with a pipe", { # nofuz test_that("terminal missing keyword arguments are OK", { expect_no_lint("alist(missing_arg = )", spaces_inside_linter()) }) +# nofuzz end From 72164ee5efc9ce55c0b34962d6e92f4d9b7ebaeb Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 13:55:11 -0700 Subject: [PATCH 096/131] more comments interfering with node=node tests --- R/sort_linter.R | 16 ++++++++-------- tests/testthat/test-sort_linter.R | 12 ++++++++++-- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/R/sort_linter.R b/R/sort_linter.R index 424ac5c41..2e1dc1099 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -83,12 +83,11 @@ sort_linter <- function() { ") sorted_xpath <- " - parent::expr[not(SYMBOL_SUB)] - /parent::expr[ - (EQ or NE) - and expr/expr = expr - ] - " + self::*[ + (EQ or NE) + and expr/expr = expr + and not(expr/EQ_SUB) + ]" arguments_xpath <- @@ -134,8 +133,9 @@ sort_linter <- function() { type = "warning" ) - xml_calls <- source_expression$xml_find_function_calls("sort") - sorted_expr <- xml_find_all(xml_calls, sorted_xpath) + sort_calls <- xml_parent(xml_parent(source_expression$xml_find_function_calls("sort"))) + sort_calls <- strip_comments_from_subtree(sort_calls) + sorted_expr <- xml_find_all(sort_calls, sorted_xpath) sorted_op <- xml_text(xml_find_first(sorted_expr, "*[2]")) lint_message <- ifelse( diff --git a/tests/testthat/test-sort_linter.R b/tests/testthat/test-sort_linter.R index 3a819a773..e8d6ca134 100644 --- a/tests/testthat/test-sort_linter.R +++ b/tests/testthat/test-sort_linter.R @@ -15,7 +15,7 @@ test_that("sort_linter skips allowed usages", { }) -test_that("sort_linter blocks simple disallowed usages", { +test_that("sort_linter blocks simple disallowed usages for x[order(x)] cases", { linter <- sort_linter() lint_message <- rex::rex("sort(", anything, ") is better than") @@ -118,7 +118,7 @@ test_that("sort_linter skips when inputs don't match", { expect_lint("sort(foo(x)) == x", NULL, linter) }) -test_that("sort_linter blocks simple disallowed usages", { +test_that("sort_linter blocks simple disallowed usages for is.sorted cases", { linter <- sort_linter() unsorted_msg <- rex::rex("Use is.unsorted(x) to test the unsortedness of a vector.") sorted_msg <- rex::rex("Use !is.unsorted(x) to test the sortedness of a vector.") @@ -133,6 +133,14 @@ test_that("sort_linter blocks simple disallowed usages", { # expression matching expect_lint("sort(foo(x)) == foo(x)", sorted_msg, linter) + expect_lint( + trim_some(" + sort(foo(x # comment + )) == foo(x) + "), + sorted_msg, + linter + ) }) test_that("lints vectorize", { From ac774a300acd90c1a10319d29cf14f6b63718c0e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 13:57:27 -0700 Subject: [PATCH 097/131] simpler preceding-sibling::* fix --- R/outer_negation_linter.R | 2 +- tests/testthat/test-outer_negation_linter.R | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/R/outer_negation_linter.R b/R/outer_negation_linter.R index 6a5ce6e18..584573fd6 100644 --- a/R/outer_negation_linter.R +++ b/R/outer_negation_linter.R @@ -44,7 +44,7 @@ outer_negation_linter <- function() { not(expr[ position() > 1 and not(OP-EXCLAMATION) - and not(preceding-sibling::*[1][self::EQ_SUB]) + and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) ]) ] " diff --git a/tests/testthat/test-outer_negation_linter.R b/tests/testthat/test-outer_negation_linter.R index 0601aa4ee..6f3596fbe 100644 --- a/tests/testthat/test-outer_negation_linter.R +++ b/tests/testthat/test-outer_negation_linter.R @@ -31,6 +31,16 @@ test_that("outer_negation_linter blocks simple disallowed usages", { # catch when all inputs are negated expect_lint("any(!x, !y)", not_all_msg, linter) expect_lint("all(!x, !y, na.rm = TRUE)", not_any_msg, linter) + + # adversarial comment + expect_lint( + trim_some(" + any(!x, na.rm = # comment + TRUE) + "), + not_all_msg, + linter + ) }) test_that("outer_negation_linter doesn't trigger on empty calls", { From 173e932bed450705139ca38aa8a4c8c1f499cc6b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 14:14:40 -0700 Subject: [PATCH 098/131] more nofuzz, more preceding-sibling::* --- R/implicit_assignment_linter.R | 2 +- tests/testthat/test-if_switch_linter.R | 8 ++++---- tests/testthat/test-implicit_assignment_linter.R | 11 +++++++++++ 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/R/implicit_assignment_linter.R b/R/implicit_assignment_linter.R index e7be487ed..d2c18ac0f 100644 --- a/R/implicit_assignment_linter.R +++ b/R/implicit_assignment_linter.R @@ -94,7 +94,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" } if (allow_scoped) { # force 2nd preceding to ensure we're in the loop condition, not the loop expression - in_branch_cond <- "ancestor::expr[preceding-sibling::*[2][self::IF or self::WHILE]]" + in_branch_cond <- "ancestor::expr[preceding-sibling::*[not(self::COMMENT)][2][self::IF or self::WHILE]]" xpath <- paste0( xpath, # _if_ we're in an IF/WHILE branch, lint if the assigned SYMBOL appears anywhere later on. diff --git a/tests/testthat/test-if_switch_linter.R b/tests/testthat/test-if_switch_linter.R index 1325fdcf4..478b48d22 100644 --- a/tests/testthat/test-if_switch_linter.R +++ b/tests/testthat/test-if_switch_linter.R @@ -78,7 +78,7 @@ test_that("multiple lints have right metadata", { ) }) -test_that("max_branch_lines= and max_branch_expressions= arguments work", { +test_that("max_branch_lines= and max_branch_expressions= arguments work", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_lines4_linter <- if_switch_linter(max_branch_lines = 4L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) @@ -380,7 +380,7 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit expect_lint(five_expr_three_lines_lines, lint_msg, max_expr4_linter) }) -test_that("max_branch_lines= and max_branch_expressions= interact correctly", { +test_that("max_branch_lines= and max_branch_expressions= interact correctly", { # nofuzz linter <- if_switch_linter(max_branch_lines = 5L, max_branch_expressions = 3L) lint_msg <- rex::rex("Prefer switch() statements over repeated if/else equality tests") @@ -432,7 +432,7 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { ) }) -test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'else' branch", { +test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'else' branch", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) lint_msg <- rex::rex("Prefer repeated if/else statements over overly-complicated switch() statements.") @@ -475,7 +475,7 @@ test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'el expect_lint(default_long_lines, lint_msg, max_expr2_linter) }) -test_that("max_branch_lines= and max_branch_expressions= are guided by the most complex branch", { +test_that("max_branch_lines= and max_branch_expressions= are guided by the most complex branch", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) lint_msg <- rex::rex("Prefer repeated if/else statements over overly-complicated switch() statements.") diff --git a/tests/testthat/test-implicit_assignment_linter.R b/tests/testthat/test-implicit_assignment_linter.R index 9c17e727c..2b81f8b11 100644 --- a/tests/testthat/test-implicit_assignment_linter.R +++ b/tests/testthat/test-implicit_assignment_linter.R @@ -438,6 +438,17 @@ test_that("allow_scoped skips scoped assignments", { # outside of branching, doesn't matter expect_lint("foo(idx <- bar()); baz()", lint_message, linter) expect_lint("foo(x, idx <- bar()); baz()", lint_message, linter) + + # adversarial comments + expect_no_lint( + trim_some(" + if # comment + (any(idx <- x < 0)) { + stop('negative elements: ', toString(which(idx))) + } + "), + linter + ) }) test_that("interaction of allow_lazy and allow_scoped", { From fcf7cf7aef0eecdfa6b333f3fc19abd774385424 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 14:30:53 -0700 Subject: [PATCH 099/131] tricky tricky --- R/coalesce_linter.R | 28 +++++++++++++-------------- tests/testthat/test-coalesce_linter.R | 10 ++++++++++ 2 files changed, 24 insertions(+), 14 deletions(-) diff --git a/R/coalesce_linter.R b/R/coalesce_linter.R index befa1636b..2cb0f5333 100644 --- a/R/coalesce_linter.R +++ b/R/coalesce_linter.R @@ -46,7 +46,7 @@ coalesce_linter <- function() { braced_expr_cond <- "expr[1][OP-LEFT-BRACE and count(*) = 3]/expr" xpath <- glue(" - parent::expr[ + expr[expr[ preceding-sibling::IF and ( expr[2] = following-sibling::ELSE/following-sibling::expr @@ -54,25 +54,25 @@ coalesce_linter <- function() { or expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::ELSE/following-sibling::expr or expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::ELSE/following-sibling::{braced_expr_cond} ) - ] - /parent::expr + ]] | - parent::expr[ - preceding-sibling::OP-EXCLAMATION - and parent::expr/preceding-sibling::IF + self::*[expr[ + preceding-sibling::IF + and OP-EXCLAMATION and ( - expr[2] = parent::expr/following-sibling::expr[1] - or expr[2] = parent::expr/following-sibling::{braced_expr_cond} - or expr[2][LEFT_ASSIGN]/expr[1] = parent::expr/following-sibling::expr[1] - or expr[2][LEFT_ASSIGN]/expr[1] = parent::expr/following-sibling::{braced_expr_cond} + expr/expr[2] = following-sibling::expr[1] + or expr/expr[2] = following-sibling::{braced_expr_cond} + or expr/expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::expr[1] + or expr/expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::{braced_expr_cond} ) - ] - /parent::expr - /parent::expr + ]] ") Linter(linter_level = "expression", function(source_expression) { - null_calls <- source_expression$xml_find_function_calls("is.null") + null_calls <- xml_parent(xml_parent(xml_parent( + source_expression$xml_find_function_calls("is.null") + ))) + null_calls <- strip_comments_from_subtree(null_calls) bad_expr <- xml_find_all(null_calls, xpath) is_negation <- !is.na(xml_find_first(bad_expr, "expr/OP-EXCLAMATION")) observed <- ifelse(is_negation, "if (!is.null(x)) x else y", "if (is.null(x)) y else x") diff --git a/tests/testthat/test-coalesce_linter.R b/tests/testthat/test-coalesce_linter.R index 434bdd7bd..c4ded0895 100644 --- a/tests/testthat/test-coalesce_linter.R +++ b/tests/testthat/test-coalesce_linter.R @@ -35,6 +35,16 @@ test_that("coalesce_linter blocks simple disallowed usage", { expect_lint("if (!is.null(x[1])) x[1] else y", lint_msg_not, linter) expect_lint("if (!is.null(foo(x))) foo(x) else y", lint_msg_not, linter) + + # adversarial comments + expect_lint( + trim_some(" + if (!is.null(x[1])) x[ # INJECTED COMMENT + 1] else y + "), + lint_msg_not, + linter + ) }) test_that("coalesce_linter blocks usage with implicit assignment", { From 025537b035e1c46b201ff0dfb41f7cff841a2184 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 14:38:32 -0700 Subject: [PATCH 100/131] hit the dj khaled --- R/sprintf_linter.R | 7 +++++-- tests/testthat/test-knitr_formats.R | 2 +- tests/testthat/test-sprintf_linter.R | 10 ++++++++++ 3 files changed, 16 insertions(+), 3 deletions(-) diff --git a/R/sprintf_linter.R b/R/sprintf_linter.R index 1eb3b345d..4c75c4bec 100644 --- a/R/sprintf_linter.R +++ b/R/sprintf_linter.R @@ -38,7 +38,10 @@ sprintf_linter <- function() { pipes <- setdiff(magrittr_pipes, "%$%") in_pipe_xpath <- glue("self::expr[ - preceding-sibling::*[1][self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }]] + preceding-sibling::*[not(self::COMMENT)][1][ + self::PIPE + or self::SPECIAL[{ xp_text_in_table(pipes) } + ]] and ( preceding-sibling::*[2]/STR_CONST or SYMBOL_SUB[text() = 'fmt']/following-sibling::expr[1]/STR_CONST @@ -89,7 +92,7 @@ sprintf_linter <- function() { arg_idx <- 2L:length(parsed_expr) parsed_expr[arg_idx + 1L] <- parsed_expr[arg_idx] names(parsed_expr)[arg_idx + 1L] <- arg_names[arg_idx] - parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[2]")) + parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[not(self::COMMENT)][2]")) names(parsed_expr)[2L] <- "" } parsed_expr <- zap_extra_args(parsed_expr) diff --git a/tests/testthat/test-knitr_formats.R b/tests/testthat/test-knitr_formats.R index eb3dfc5f9..7538dc213 100644 --- a/tests/testthat/test-knitr_formats.R +++ b/tests/testthat/test-knitr_formats.R @@ -120,7 +120,7 @@ test_that("it handles asciidoc", { ) }) -test_that("it does _not_ handle brew", { +test_that("it does _not_ handle brew", { # nofuzz expect_lint("'<% a %>'\n", checks = list( regexes[["quotes"]], diff --git a/tests/testthat/test-sprintf_linter.R b/tests/testthat/test-sprintf_linter.R index e0626a974..f66e20a3c 100644 --- a/tests/testthat/test-sprintf_linter.R +++ b/tests/testthat/test-sprintf_linter.R @@ -132,6 +132,16 @@ local({ ) }) +test_that("pipe logic survives adversarial comments", { + expect_no_lint( + trim_some(" + x |> # comment + sprintf(fmt = '%s') + "), + sprintf_linter() + ) +}) + test_that("lints vectorize", { skip_if_not_r_version("4.1.0") From f0c8c9a82a2d8ecd6c4d3fbbd33f40a066d91f26 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 14:55:17 -0700 Subject: [PATCH 101/131] another tricky one --- R/string_boundary_linter.R | 36 +++++++++----------- tests/testthat/test-string_boundary_linter.R | 10 ++++++ 2 files changed, 27 insertions(+), 19 deletions(-) diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index aaaa67f2d..536556085 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -116,25 +116,18 @@ string_boundary_linter <- function(allow_grepl = FALSE) { list(lint_expr = expr[should_lint], lint_type = lint_type) } + string_comparison_xpath <- "self::*[(EQ or NE) and expr/STR_CONST]" substr_xpath <- glue(" - (//EQ | //NE) - /parent::expr[ - expr[STR_CONST] - and expr[ - expr[1][SYMBOL_FUNCTION_CALL[text() = 'substr' or text() = 'substring']] - and expr[ - ( - position() = 3 - and NUM_CONST[text() = '1' or text() = '1L'] - ) or ( - position() = 4 - and expr[1][SYMBOL_FUNCTION_CALL[text() = 'nchar']] - and expr[position() = 2] = preceding-sibling::expr[2] - ) - ] - ] - ] - ") + self::*[expr/expr[ + ( + position() = 3 + and NUM_CONST[text() = '1' or text() = '1L'] + ) or ( + position() = 4 + and expr[1][SYMBOL_FUNCTION_CALL[text() = 'nchar']] + and expr[position() = 2] = preceding-sibling::expr[2] + ) + ]]") substr_arg2_xpath <- "string(./expr[expr[1][SYMBOL_FUNCTION_CALL]]/expr[3])" @@ -168,7 +161,12 @@ string_boundary_linter <- function(allow_grepl = FALSE) { )) } - substr_expr <- xml_find_all(xml, substr_xpath) + substr_calls <- xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("substr", "substring")) + )) + is_str_comparison <- !is.na(xml_find_first(substr_calls, string_comparison_xpath)) + substr_calls <- strip_comments_from_subtree(substr_calls[is_str_comparison]) + substr_expr <- xml_find_all(substr_calls, substr_xpath) substr_one <- xml_find_chr(substr_expr, substr_arg2_xpath) %in% c("1", "1L") substr_lint_message <- paste( ifelse( diff --git a/tests/testthat/test-string_boundary_linter.R b/tests/testthat/test-string_boundary_linter.R index 54f915ae7..446c5646f 100644 --- a/tests/testthat/test-string_boundary_linter.R +++ b/tests/testthat/test-string_boundary_linter.R @@ -102,6 +102,16 @@ test_that("string_boundary_linter blocks disallowed substr()/substring() usage", expect_lint("substring(x, start, nchar(x)) == 'abcde'", ends_message, linter) # more complicated expressions expect_lint("substring(colnames(x), start, nchar(colnames(x))) == 'abc'", ends_message, linter) + + # adversarial comments + expect_lint( + trim_some(" + substring(colnames(x), start, nchar(colnames( # INJECTED COMMENT + x))) == 'abc' + "), + ends_message, + linter + ) }) test_that("plain ^ or $ are skipped", { From ebe79364bf85bb1849c1fe9cd587ddc044a93c14 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 15:02:19 -0700 Subject: [PATCH 102/131] kitchen sink --- R/unreachable_code_linter.R | 12 ++++--- tests/testthat/test-unreachable_code_linter.R | 31 ++++++++++++++----- 2 files changed, 31 insertions(+), 12 deletions(-) diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index f2e9f8d56..656d02bff 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -84,15 +84,19 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud xpath_return_stop <- glue(" ( {expr_after_control} - | (//FUNCTION | //OP-LAMBDA)[following-sibling::expr[1]/*[1][self::OP-LEFT-BRACE]]/following-sibling::expr[1] + | + (//FUNCTION | //OP-LAMBDA)[ + following-sibling::expr[1]/*[not(self::COMMENT)][1][self::OP-LEFT-BRACE] + ] + /following-sibling::expr[1] ) /expr[expr[1][ not(OP-DOLLAR or OP-AT) and SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop'] ]] /following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[1]/@line2) + not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON or self::COMMENT) + and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) ][1] ") xpath_next_break <- glue(" @@ -100,7 +104,7 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud /expr[NEXT or BREAK] /following-sibling::*[ not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[1]/@line2) + and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) ][1] ") diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index 0b62e1b96..a9ef38b88 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -218,14 +218,29 @@ test_that("unreachable_code_linter passes on multi-line functions", { }) test_that("unreachable_code_linter ignores comments on the same expression", { - lines <- trim_some(" - foo <- function(x) { - return( - y^2 - ) # y^3 - } - ") - expect_no_lint(lines, unreachable_code_linter()) + linter <- unreachable_code_linter() + + expect_no_lint( + trim_some(" + foo <- function(x) { + return( + y^2 + ) # y^3 + } + "), + linter + ) + # the same, commented adversarially + expect_no_lint( + trim_some(" + foo <- function(x) # comment + { + return(y^2) + # y^3 + } + "), + linter + ) }) test_that("unreachable_code_linter ignores comments on the same line", { From 04d4e1b200aca5f8b9255409afe23849d8186c6c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 15:11:18 -0700 Subject: [PATCH 103/131] new one, old rule --- R/unnecessary_lambda_linter.R | 2 +- tests/testthat/test-lint.R | 2 +- tests/testthat/test-unnecessary_lambda_linter.R | 9 +++++++++ 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index e5ea2d18e..76dbf9c6b 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -125,7 +125,7 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { .//expr[ position() = 2 and preceding-sibling::expr/SYMBOL_FUNCTION_CALL - and not(preceding-sibling::*[1][self::EQ_SUB]) + and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) and not(parent::expr[ preceding-sibling::expr[not(SYMBOL_FUNCTION_CALL)] or following-sibling::*[not( diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 57da887f2..3b71e451f 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -146,7 +146,7 @@ test_that("lint() results from file or text should be consistent", { expect_identical(lint_from_file, lint_from_text) }) -test_that("exclusions work with custom linter names", { +test_that("exclusions work with custom linter names", { # nofuzz expect_no_lint( "a = 2 # nolint: bla.", linters = list(bla = assignment_linter()), diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index ada809368..541390878 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -161,6 +161,15 @@ test_that("unnecessary_lambda_linter doesn't apply to keyword args", { expect_no_lint("lapply(x, function(xi) data.frame(nm = xi))", linter) expect_no_lint("lapply(x, function(xi) return(data.frame(nm = xi)))", linter) + + # adversarially commented + expect_no_lint( + trim_some(" + lapply(x, function(xi) data.frame(nm = # INJECTED COMMENT + xi)) + "), + linter + ) }) test_that("purrr-style anonymous functions are also caught", { From a7c9768ad54a98b6389b69df35ca55043564611c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 16:21:25 -0700 Subject: [PATCH 104/131] just drop formulas --- .dev/maybe_fuzz_content.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.dev/maybe_fuzz_content.R b/.dev/maybe_fuzz_content.R index 950bd4e18..fa6cd1f69 100644 --- a/.dev/maybe_fuzz_content.R +++ b/.dev/maybe_fuzz_content.R @@ -63,6 +63,11 @@ comment_injection_fuzzer <- function(pd, lines) { # injecting comment before a call often structurally breaks parsing # (SYMBOL_FUNCTION_CALL-->SYMBOL), so avoid terminal_token_idx <- which(pd$terminal & !pd$token %in% c("COMMENT", "SYMBOL_FUNCTION_CALL", "SLOT")) + # formula is messy because it's very easy to break parsing, but not easy to exclude the right + # elements from the pd data.frame (easier with XPath ancestor axis). Just skip for now. + if (any(pd$token == "'~'")) { + return(invisible()) + } injection_count <- sample(0:length(terminal_token_idx), 1L) if (injection_count == 0L) { From e1a497cc96037e734c19533fd86687557847d737 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 16:21:44 -0700 Subject: [PATCH 105/131] edge case in seq_linter --- R/seq_linter.R | 1 + tests/testthat/test-seq_linter.R | 9 +++++++++ 2 files changed, 10 insertions(+) diff --git a/R/seq_linter.R b/R/seq_linter.R index c55e661f5..04d7d96ea 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -126,6 +126,7 @@ seq_linter <- function() { xml_find_all(seq_calls, seq_xpath), xml_find_all(xml, colon_xpath) ) + seq_expr <- strip_comments_from_subtree(seq_expr) dot_expr1 <- get_fun(seq_expr, 1L) dot_expr2 <- get_fun(seq_expr, 2L) diff --git a/tests/testthat/test-seq_linter.R b/tests/testthat/test-seq_linter.R index 9424d394f..295e496ef 100644 --- a/tests/testthat/test-seq_linter.R +++ b/tests/testthat/test-seq_linter.R @@ -96,6 +96,15 @@ test_that("finds 1:length(...) expressions", { linter ) + expect_lint( + trim_some(" + mutate(x, .id = 1:n( # comment + )) + "), + lint_msg("seq_len(n())", "1:n(),"), + linter + ) + expect_lint( "x[, .id := 1:.N]", lint_msg("seq_len(.N)", "1:.N,"), From 3d1131697d469d04dd35c3166ded60192c6473a4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 16:23:03 -0700 Subject: [PATCH 106/131] another sprintf case --- R/sprintf_linter.R | 2 +- tests/testthat/test-sprintf_linter.R | 12 +++++++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/R/sprintf_linter.R b/R/sprintf_linter.R index 4c75c4bec..fb06af173 100644 --- a/R/sprintf_linter.R +++ b/R/sprintf_linter.R @@ -43,7 +43,7 @@ sprintf_linter <- function() { or self::SPECIAL[{ xp_text_in_table(pipes) } ]] and ( - preceding-sibling::*[2]/STR_CONST + preceding-sibling::*[not(self::COMMENT)][2]/STR_CONST or SYMBOL_SUB[text() = 'fmt']/following-sibling::expr[1]/STR_CONST ) ]") diff --git a/tests/testthat/test-sprintf_linter.R b/tests/testthat/test-sprintf_linter.R index f66e20a3c..3127c82ed 100644 --- a/tests/testthat/test-sprintf_linter.R +++ b/tests/testthat/test-sprintf_linter.R @@ -133,12 +133,22 @@ local({ }) test_that("pipe logic survives adversarial comments", { + linter <- sprintf_linter() + expect_no_lint( trim_some(" x |> # comment sprintf(fmt = '%s') "), - sprintf_linter() + linter + ) + + expect_no_lint( + trim_some(' + "%s" %>% # comment + sprintf("%s%s") + '), + linter ) }) From a9dca0ca24c525c796931e3070a1cbb7f5fe11fc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 16:23:38 -0700 Subject: [PATCH 107/131] re-fixed unreachable code thing? --- R/unreachable_code_linter.R | 8 +-- tests/testthat/test-unreachable_code_linter.R | 55 ++++++++----------- 2 files changed, 25 insertions(+), 38 deletions(-) diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index 656d02bff..ae3d65e36 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -85,17 +85,15 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud ( {expr_after_control} | - (//FUNCTION | //OP-LAMBDA)[ - following-sibling::expr[1]/*[not(self::COMMENT)][1][self::OP-LEFT-BRACE] - ] - /following-sibling::expr[1] + (//FUNCTION | //OP-LAMBDA) + /following-sibling::expr[1][OP-LEFT-BRACE] ) /expr[expr[1][ not(OP-DOLLAR or OP-AT) and SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop'] ]] /following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON or self::COMMENT) + not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) ][1] ") diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index a9ef38b88..803555901 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -145,27 +145,27 @@ test_that("unreachable_code_linter works with next and break in sub expressions" linter ) - expect_no_lint( # nofuzz - trim_some(" - foo <- function(bar) { - if (bar) { - break # Test comment - } else { - next # Test comment - } - while (bar) { - next # 5 + 3 - } - repeat { - next # Test comment - } - for(i in 1:3) { - break # 5 + 4 - } - } - "), - linter - ) +# expect_no_lint( # nofuzz +# trim_some(" +# foo <- function(bar) { +# if (bar) { +# break # Test comment +# } else { +# next # Test comment +# } +# while (bar) { +# next # 5 + 3 +# } +# repeat { +# next # Test comment +# } +# for(i in 1:3) { +# break # 5 + 4 +# } +# } +# "), +# linter +# ) lines <- trim_some(" foo <- function(bar) { @@ -230,20 +230,9 @@ test_that("unreachable_code_linter ignores comments on the same expression", { "), linter ) - # the same, commented adversarially - expect_no_lint( - trim_some(" - foo <- function(x) # comment - { - return(y^2) - # y^3 - } - "), - linter - ) }) -test_that("unreachable_code_linter ignores comments on the same line", { +test_that("unreachable_code_linter ignores comments on the same line", { # nofuzz lines <- trim_some(" foo <- function(x) { return(y^2) # y^3 From 2a0831d84dd0cbcef7a3a13b9b39596cc68aefbc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 16:51:07 -0700 Subject: [PATCH 108/131] more nofuzz, and finally fixed the conjunct_test issue --- R/conjunct_test_linter.R | 3 ++- tests/testthat/test-assignment_linter.R | 2 +- tests/testthat/test-conjunct_test_linter.R | 17 ++++++++++++++--- .../test-function_left_parentheses_linter.R | 10 +++++----- tests/testthat/test-nested_pipe_linter.R | 4 ++-- tests/testthat/test-return_linter.R | 2 +- tests/testthat/test-unreachable_code_linter.R | 2 +- 7 files changed, 26 insertions(+), 14 deletions(-) diff --git a/R/conjunct_test_linter.R b/R/conjunct_test_linter.R index 95eee5150..8fd825b4a 100644 --- a/R/conjunct_test_linter.R +++ b/R/conjunct_test_linter.R @@ -82,7 +82,8 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE, following-sibling::expr[1][AND2] /parent::expr " - named_stopifnot_condition <- if (allow_named_stopifnot) "and not(preceding-sibling::*[1][self::EQ_SUB])" else "" + named_stopifnot_condition <- + if (allow_named_stopifnot) "and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])" else "" stopifnot_xpath <- glue(" following-sibling::expr[1][AND2 {named_stopifnot_condition}] /parent::expr diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index e67e6e182..d2d87500d 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -165,7 +165,7 @@ test_that("arguments handle trailing assignment operators correctly", { # nofuzz ) }) -test_that("allow_trailing interacts correctly with comments in braced expressions", { +test_that("allow_trailing interacts correctly with comments in braced expressions", { # nofuzz linter <- assignment_linter(allow_trailing = FALSE) expect_no_lint( trim_some(" diff --git a/tests/testthat/test-conjunct_test_linter.R b/tests/testthat/test-conjunct_test_linter.R index 047d2456d..9f05a2b02 100644 --- a/tests/testthat/test-conjunct_test_linter.R +++ b/tests/testthat/test-conjunct_test_linter.R @@ -66,12 +66,23 @@ test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() a }) test_that("conjunct_test_linter's allow_named_stopifnot argument works", { + linter <- conjunct_test_linter() + # allowed by default - expect_lint( + expect_no_lint( "stopifnot('x must be a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))", - NULL, - conjunct_test_linter() + linter + ) + # including with intervening comment + expect_no_lint( + trim_some(" + stopifnot('x must be a logical scalar' = # comment + length(x) == 1 && is.logical(x) && !is.na(x) + ) + "), + linter ) + expect_lint( "stopifnot('x is a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))", rex::rex("Write multiple conditions like stopifnot(A, B)"), diff --git a/tests/testthat/test-function_left_parentheses_linter.R b/tests/testthat/test-function_left_parentheses_linter.R index e45b1b7b0..d9343364d 100644 --- a/tests/testthat/test-function_left_parentheses_linter.R +++ b/tests/testthat/test-function_left_parentheses_linter.R @@ -7,7 +7,7 @@ test_that("function_left_parentheses_linter skips allowed usages", { expect_no_lint("base::print(blah)", linter) expect_no_lint('base::"print"(blah)', linter) expect_no_lint("base::print(blah, fun(1))", linter) - expect_no_lint("blah <- function(blah) { }", linter) + expect_no_lint("blah <- function(blah) { }", linter) # nofuzz expect_no_lint("(1 + 1)", linter) expect_no_lint("( (1 + 1) )", linter) expect_no_lint("if (blah) { }", linter) @@ -18,9 +18,9 @@ test_that("function_left_parentheses_linter skips allowed usages", { expect_no_lint("c(1, 2, 3)[(2 - 1)]", linter) expect_no_lint("list(1, 2, 3)[[(2 - 1)]]", linter) expect_no_lint("range(10)[(2 - 1):(10 - 1)]", linter) - expect_no_lint("function(){function(){}}()()", linter) - expect_no_lint("c(function(){})[1]()", linter) - expect_no_lint("function(x) (mean(x) + 3)", linter) + expect_no_lint("function(){function(){}}()()", linter) # nofuzz + expect_no_lint("c(function(){})[1]()", linter) # nofuzz + expect_no_lint("function(x) (mean(x) + 3)", linter) # nofuzz expect_no_lint('"blah (1)"', linter) }) @@ -197,7 +197,7 @@ test_that("newline in character string doesn't trigger false positive (#1963)", ) }) -test_that("shorthand functions are handled", { +test_that("shorthand functions are handled", { # nofuzz skip_if_not_r_version("4.1.0") linter <- function_left_parentheses_linter() fun_lint_msg <- rex::rex("Remove spaces before the left parenthesis in a function definition.") diff --git a/tests/testthat/test-nested_pipe_linter.R b/tests/testthat/test-nested_pipe_linter.R index 7f2857c85..d1f723b84 100644 --- a/tests/testthat/test-nested_pipe_linter.R +++ b/tests/testthat/test-nested_pipe_linter.R @@ -15,7 +15,7 @@ test_that("nested_pipe_linter skips allowed usages", { ) # pipes fitting on one line can be ignored - expect_lint( + expect_lint( # nofuzz "bind_rows(a %>% select(b), c %>% select(b))", NULL, linter @@ -27,7 +27,7 @@ test_that("nested_pipe_linter skips allowed usages", { expect_lint("switch(x, a = x, x %>% foo())", NULL, linter) # inline switch inputs are not linted - expect_lint( + expect_lint( # nofuzz trim_some(" switch( x %>% foo(), diff --git a/tests/testthat/test-return_linter.R b/tests/testthat/test-return_linter.R index 1a228e912..9cb9a23a6 100644 --- a/tests/testthat/test-return_linter.R +++ b/tests/testthat/test-return_linter.R @@ -704,7 +704,7 @@ test_that("except= and except_regex= combination works", { ) }) -test_that("return_linter skips brace-wrapped inline functions", { +test_that("return_linter skips brace-wrapped inline functions", { # nofuzz expect_no_lint("function(x) { sum(x) }", return_linter(return_style = "explicit")) }) diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index 803555901..b57648c96 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -274,7 +274,7 @@ test_that("unreachable_code_linter finds unreachable comments", { ) }) -test_that("unreachable_code_linter finds expressions in the same line", { +test_that("unreachable_code_linter finds expressions in the same line", { # nofuzz msg <- rex::rex("Remove code and comments coming after return() or stop()") linter <- unreachable_code_linter() From 9344004d9a10173c01734ef96e5348f43adfb3f1 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 22:00:43 -0700 Subject: [PATCH 109/131] unbelievably tricky --- R/unreachable_code_linter.R | 47 ++++--- tests/testthat/test-unreachable_code_linter.R | 117 +++++++++++------- 2 files changed, 108 insertions(+), 56 deletions(-) diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index ae3d65e36..2f3beae33 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -80,31 +80,50 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud (//REPEAT | //ELSE | //FOR)/following-sibling::expr[1] | (//IF | //WHILE)/following-sibling::expr[2] " + + unreachable_expr_cond_ws <- " + following-sibling::*[ + not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON or self::ELSE or preceding-sibling::ELSE) + and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) + ][1]" + # when a semicolon is present, the condition is a bit different due to nodes + unreachable_expr_cond_sc <- " + parent::exprlist[OP-SEMICOLON] + /following-sibling::*[ + not(self::OP-RIGHT-BRACE) + and (not(self::COMMENT) or @line1 > preceding-sibling::exprlist/expr/@line2) + ][1] + " + # NB: use not(OP-DOLLAR) to prevent matching process$stop(), #1051 - xpath_return_stop <- glue(" + xpath_return_stop_fmt <- " ( {expr_after_control} | (//FUNCTION | //OP-LAMBDA) - /following-sibling::expr[1][OP-LEFT-BRACE] + /following-sibling::expr[OP-LEFT-BRACE][last()] ) - /expr[expr[1][ + //expr[expr[1][ not(OP-DOLLAR or OP-AT) and SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop'] ]] - /following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) - ][1] - ") - xpath_next_break <- glue(" + /{unreachable_expr_cond} + " + xpath_return_stop <- paste( + glue(xpath_return_stop_fmt, unreachable_expr_cond = unreachable_expr_cond_ws), + glue(xpath_return_stop_fmt, unreachable_expr_cond = unreachable_expr_cond_sc), + sep = " | " + ) + xpath_next_break_fmt <- " ({expr_after_control}) /expr[NEXT or BREAK] - /following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) - ][1] - ") + /{unreachable_expr_cond} + " + xpath_next_break <- paste( + glue(xpath_next_break_fmt, unreachable_expr_cond = unreachable_expr_cond_ws), + glue(xpath_next_break_fmt, unreachable_expr_cond = unreachable_expr_cond_sc), + sep = " | " + ) xpath_if_while <- " (//WHILE | //IF)[following-sibling::expr[1]/NUM_CONST[text() = 'FALSE']] diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index b57648c96..da42b3d67 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -73,27 +73,25 @@ test_that("unreachable_code_linter works in sub expressions", { linter ) - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - return(bar); x <- 2 - } else { - return(bar); x <- 3 - } - while (bar) { - return(bar); 5 + 3 - } - repeat { - return(bar); test() - } - for(i in 1:3) { - return(bar); 5 + 4 + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar); x <- 2 + } else { + return(bar); x <- 3 + } + while (bar) { + return(bar); 5 + 3 + } + repeat { + return(bar); test() + } + for(i in 1:3) { + return(bar); 5 + 4 + } } - } - ") - - expect_lint( - lines, + "), list( list(line_number = 3L, message = msg), list(line_number = 5L, message = msg), @@ -103,6 +101,41 @@ test_that("unreachable_code_linter works in sub expressions", { ), linter ) + + #debug(linter) + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar); # comment + x <- 2 + } else { + return(bar); # comment + x <- 3 + } + while (bar) { + return(bar); # comment + 5 + 3 + } + repeat { + return(bar); # comment + test() + } + for(i in 1:3) { + return(bar); # comment + 5 + 4 + } + } + "), + list( + list(line_number = 4L, message = msg), + list(line_number = 7L, message = msg), + list(line_number = 11L, message = msg), + list(line_number = 15L, message = msg), + list(line_number = 19L, message = msg) + ), + linter + ) }) test_that("unreachable_code_linter works with next and break in sub expressions", { @@ -145,27 +178,27 @@ test_that("unreachable_code_linter works with next and break in sub expressions" linter ) -# expect_no_lint( # nofuzz -# trim_some(" -# foo <- function(bar) { -# if (bar) { -# break # Test comment -# } else { -# next # Test comment -# } -# while (bar) { -# next # 5 + 3 -# } -# repeat { -# next # Test comment -# } -# for(i in 1:3) { -# break # 5 + 4 -# } -# } -# "), -# linter -# ) + expect_no_lint( # nofuzz + trim_some(" + foo <- function(bar) { + if (bar) { + break # Test comment + } else { + next # Test comment + } + while (bar) { + next # 5 + 3 + } + repeat { + next # Test comment + } + for(i in 1:3) { + break # 5 + 4 + } + } + "), + linter + ) lines <- trim_some(" foo <- function(bar) { @@ -217,7 +250,7 @@ test_that("unreachable_code_linter passes on multi-line functions", { expect_no_lint(lines, unreachable_code_linter()) }) -test_that("unreachable_code_linter ignores comments on the same expression", { +test_that("unreachable_code_linter ignores comments on the same expression", { # nofuzz linter <- unreachable_code_linter() expect_no_lint( From f53ec50dc9337a5d81133a37411de82f5131ccab Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 22:10:00 -0700 Subject: [PATCH 110/131] need one further level up here too --- R/regex_subset_linter.R | 19 +++++++++++-------- tests/testthat/test-regex_subset_linter.R | 16 ++++++++++++---- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index 1102880f4..5ac1d1478 100644 --- a/R/regex_subset_linter.R +++ b/R/regex_subset_linter.R @@ -49,17 +49,20 @@ regex_subset_linter <- function() { xpath_fmt <- " self::*[ - OP-LEFT-BRACKET - and not(parent::*[LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN]) - and expr[1] = expr/expr[position() = {arg_pos} ] - ]" + not(LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN) + ] + /expr[ + OP-LEFT-BRACKET + and expr[1] = expr/expr[position() = {arg_pos} ] + ] + " grep_xpath <- glue(xpath_fmt, arg_pos = 3L) stringr_xpath <- glue(xpath_fmt, arg_pos = 2L) Linter(linter_level = "expression", function(source_expression) { - grep_calls <- xml_parent(xml_parent( + grep_calls <- xml_parent(xml_parent(xml_parent( source_expression$xml_find_function_calls(c("grepl", "grep")) - )) + ))) grep_calls <- strip_comments_from_subtree(grep_calls) grep_expr <- xml_find_all(grep_calls, grep_xpath) @@ -71,9 +74,9 @@ regex_subset_linter <- function() { type = "warning" ) - stringr_calls <- xml_parent(xml_parent( + stringr_calls <- xml_parent(xml_parent(xml_parent( source_expression$xml_find_function_calls(c("str_detect", "str_which")) - )) + ))) stringr_calls <- strip_comments_from_subtree(stringr_calls) stringr_expr <- xml_find_all(stringr_calls, stringr_xpath) diff --git a/tests/testthat/test-regex_subset_linter.R b/tests/testthat/test-regex_subset_linter.R index dce6ee60a..5753788ff 100644 --- a/tests/testthat/test-regex_subset_linter.R +++ b/tests/testthat/test-regex_subset_linter.R @@ -25,10 +25,18 @@ test_that("regex_subset_linter blocks simple disallowed usages", { test_that("regex_subset_linter skips grep/grepl subassignment", { linter <- regex_subset_linter() - expect_lint("x[grep(ptn, x)] <- ''", NULL, linter) - expect_lint("x[grepl(ptn, x)] <- ''", NULL, linter) - expect_lint("x[grep(ptn, x, perl = TRUE)] = ''", NULL, linter) - expect_lint("'' -> x[grep(ptn, x, ignore.case = TRUE)] = ''", NULL, linter) + expect_no_lint("x[grep(ptn, x)] <- ''", linter) + expect_no_lint("x[grepl(ptn, x)] <- ''", linter) + expect_no_lint("x[grep(ptn, x, perl = TRUE)] = ''", linter) + expect_no_lint("'' -> x[grep(ptn, x, ignore.case = TRUE)] = ''", linter) + + expect_no_lint( + trim_some(" + x[grepl(ptn, x) # comment + ] <- '' + "), + linter + ) }) test_that("regex_subset_linter skips allowed usages for stringr equivalents", { From 5d61675363accbaff8d54eabec6c6de93c83d48b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 22:19:37 -0700 Subject: [PATCH 111/131] one more easy one --- R/literal_coercion_linter.R | 2 +- tests/testthat/test-literal_coercion_linter.R | 10 +++++++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index b5a8c340c..b458eaf43 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -61,7 +61,7 @@ literal_coercion_linter <- function() { not(OP-DOLLAR or OP-AT) and ( NUM_CONST[not(contains(translate(text(), 'E', 'e'), 'e'))] - or STR_CONST[not(following-sibling::*[1][self::EQ_SUB])] + or STR_CONST[not(following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])] ) " xpath <- glue(" diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R index b8277929a..823c442fd 100644 --- a/tests/testthat/test-literal_coercion_linter.R +++ b/tests/testthat/test-literal_coercion_linter.R @@ -37,7 +37,15 @@ test_that("literal_coercion_linter skips allowed rlang usages", { }) test_that("literal_coercion_linter skips quoted keyword arguments", { - expect_no_lint("as.numeric(foo('a' = 1))", literal_coercion_linter()) + linter <- literal_coercion_linter() + expect_no_lint("as.numeric(foo('a' = 1))", linter) + expect_no_lint( + trim_some(" + as.numeric(foo('a' # comment + = 1)) + "), + linter + ) }) test_that("no warnings surfaced by running coercion", { From dd08aa21250fa8b70ee79e1b3eef062f8a6f59f1 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 22:39:32 -0700 Subject: [PATCH 112/131] another tricky one --- R/if_switch_linter.R | 19 ++++++++++++------- tests/testthat/test-if_switch_linter.R | 9 +++++++++ 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/R/if_switch_linter.R b/R/if_switch_linter.R index eaaa66d57..3cd4e6653 100644 --- a/R/if_switch_linter.R +++ b/R/if_switch_linter.R @@ -191,8 +191,6 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) # NB: IF AND {...} AND ELSE/... implies >= 3 equality conditions are present # .//expr/IF/...: the expr in `==` that's _not_ the STR_CONST # not(preceding::IF): prevent nested matches which might be incorrect globally - # not(. != .): don't match if there are _any_ expr which _don't_ match the top - # expr if_xpath <- glue(" //IF /parent::expr[ @@ -203,21 +201,28 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) and {equal_str_cond} and ELSE/following-sibling::expr[IF and {equal_str_cond}] ] - and not( - .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)] - != expr[1][EQ]/expr[not(STR_CONST)] - ) and not({ max_lines_cond }) ] ") + # not(. != .): don't match if there are _any_ expr which _don't_ match the top expr + # do this as a second step to + equality_test_cond <- glue("self::*[ + .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)] + != expr[1][EQ]/expr[not(STR_CONST)] + ]") + Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content bad_expr <- xml_find_all(xml, if_xpath) + expr_all_equal <- is.na(xml_find_first( + strip_comments_from_subtree(bad_expr), + equality_test_cond + )) lints <- xml_nodes_to_lints( - bad_expr, + bad_expr[expr_all_equal], source_expression = source_expression, lint_message = paste( "Prefer switch() statements over repeated if/else equality tests,", diff --git a/tests/testthat/test-if_switch_linter.R b/tests/testthat/test-if_switch_linter.R index 478b48d22..6d3f04997 100644 --- a/tests/testthat/test-if_switch_linter.R +++ b/tests/testthat/test-if_switch_linter.R @@ -29,6 +29,15 @@ test_that("if_switch_linter blocks simple disallowed usages", { expect_lint("if (x == 'a') 1 else if (x == 'b') 2 else if (x == 'c') 3", lint_msg, linter) # expressions are also OK expect_lint("if (foo(x) == 'a') 1 else if (foo(x) == 'b') 2 else if (foo(x) == 'c') 3", lint_msg, linter) + # including when comments are present + expect_lint( + trim_some(" + if (foo(x) == 'a') 1 else if (foo(x # comment + ) == 'b') 2 else if (foo(x) == 'c') 3 + "), + lint_msg, + linter + ) }) test_that("if_switch_linter handles further nested if/else correctly", { From b96f2b1ebf02969ce1c27d932b8db021dd893ec2 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 23:29:30 -0700 Subject: [PATCH 113/131] trickier handling needed --- R/sort_linter.R | 22 ++++++++++------------ tests/testthat/test-sort_linter.R | 10 ++++++++++ 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/R/sort_linter.R b/R/sort_linter.R index 2e1dc1099..3f1fb031b 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -69,16 +69,14 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export sort_linter <- function() { - non_keyword_arg <- "expr[not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])]" + non_keyword_arg <- "expr[position() > 1 and not(preceding-sibling::*[1][self::EQ_SUB])]" order_xpath <- glue(" - //OP-LEFT-BRACKET + self::expr[ + expr[1] = expr/{non_keyword_arg} + ] + /OP-LEFT-BRACKET /following-sibling::expr[1][ - expr[1][ - SYMBOL_FUNCTION_CALL[text() = 'order'] - and count(following-sibling::{non_keyword_arg}) = 1 - and following-sibling::{non_keyword_arg} = - parent::expr[1]/parent::expr[1]/expr[1] - ] + count({non_keyword_arg}) = 1 ] ") @@ -96,17 +94,17 @@ sort_linter <- function() { arg_values_xpath <- glue("{arguments_xpath}/following-sibling::expr[1]") Linter(linter_level = "expression", function(source_expression) { - xml <- source_expression$xml_parsed_content + order_calls <- strip_comments_from_subtree(xml_parent(xml_parent( + source_expression$xml_find_function_calls("order") + ))) - order_expr <- xml_find_all(xml, order_xpath) + order_expr <- xml_find_all(order_calls, order_xpath) variable <- xml_text(xml_find_first( order_expr, ".//SYMBOL_FUNCTION_CALL[text() = 'order']/parent::expr[1]/following-sibling::expr[1]" )) - order_expr <- strip_comments_from_subtree(order_expr) - orig_call <- sprintf("%s[%s]", variable, get_r_string(order_expr)) # Reconstruct new argument call for each expression separately diff --git a/tests/testthat/test-sort_linter.R b/tests/testthat/test-sort_linter.R index e8d6ca134..11a502d28 100644 --- a/tests/testthat/test-sort_linter.R +++ b/tests/testthat/test-sort_linter.R @@ -63,6 +63,7 @@ test_that("sort_linter produces customized warning message", { linter ) + # comment torture expect_lint( trim_some(" x[ # comment @@ -78,6 +79,15 @@ test_that("sort_linter produces customized warning message", { rex::rex("sort(x, na.last = FALSE)"), linter ) + + expect_lint( + trim_some(" + f( # comment + )[order(f())] + "), + rex::rex("sort(f(), na.last = TRUE) is better than f()[order(f())]"), + linter + ) }) test_that("sort_linter works with multiple lints in a single expression", { From ff083c26e70b78071efc2135851de1b5f6e1f256 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 23:29:57 -0700 Subject: [PATCH 114/131] for future reference --- R/sort_linter.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/sort_linter.R b/R/sort_linter.R index 3f1fb031b..2a0e6fa08 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -69,6 +69,7 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export sort_linter <- function() { + # NB: assumes COMMENTs stripped non_keyword_arg <- "expr[position() > 1 and not(preceding-sibling::*[1][self::EQ_SUB])]" order_xpath <- glue(" self::expr[ From 88f998ccc8d1739721d7e4b83462446766d6b448 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 23:41:31 -0700 Subject: [PATCH 115/131] blessed oversight --- R/unreachable_code_linter.R | 3 +- tests/testthat/test-unreachable_code_linter.R | 73 ++++++++++++++----- 2 files changed, 55 insertions(+), 21 deletions(-) diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index 2f3beae33..acfdda2d2 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -76,6 +76,7 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclude_end", "# nocov end")) { + # nolint next: object_usage_linter. Used in glue() in statically-difficult fashion to detect. expr_after_control <- " (//REPEAT | //ELSE | //FOR)/following-sibling::expr[1] | (//IF | //WHILE)/following-sibling::expr[2] @@ -116,7 +117,7 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud ) xpath_next_break_fmt <- " ({expr_after_control}) - /expr[NEXT or BREAK] + //expr[NEXT or BREAK] /{unreachable_expr_cond} " xpath_next_break <- paste( diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index da42b3d67..eb60d2bee 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -200,27 +200,25 @@ test_that("unreachable_code_linter works with next and break in sub expressions" linter ) - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - next; x <- 2 - } else { - break; x <- 3 - } - while (bar) { - break; 5 + 3 - } - repeat { - next; test() - } - for(i in 1:3) { - break; 5 + 4 - } - } - ") - expect_lint( - lines, + trim_some(" + foo <- function(bar) { + if (bar) { + next; x <- 2 + } else { + break; x <- 3 + } + while (bar) { + break; 5 + 3 + } + repeat { + next; test() + } + for(i in 1:3) { + break; 5 + 4 + } + } + "), list( list(line_number = 3L, message = msg), list(line_number = 5L, message = msg), @@ -230,6 +228,41 @@ test_that("unreachable_code_linter works with next and break in sub expressions" ), linter ) + + # also with comments + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + next; # comment + x <- 2 + } else { + break; # comment + x <- 3 + } + while (bar) { + break; # comment + 5 + 3 + } + repeat { + next; # comment + test() + } + for(i in 1:3) { + break; # comment + 5 + 4 + } + } + "), + list( + list(line_number = 4L, message = msg), + list(line_number = 7L, message = msg), + list(line_number = 11L, message = msg), + list(line_number = 15L, message = msg), + list(line_number = 19L, message = msg) + ), + linter + ) }) test_that("unreachable_code_linter ignores expressions that aren't functions", { From 5606eac49bba5e4574fb82cea4903446ddd53dc7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 23:46:56 -0700 Subject: [PATCH 116/131] vestigial --- .dev/ast_fuzz_test.R | 1 - 1 file changed, 1 deletion(-) diff --git a/.dev/ast_fuzz_test.R b/.dev/ast_fuzz_test.R index 0d09f5e45..3494d4549 100644 --- a/.dev/ast_fuzz_test.R +++ b/.dev/ast_fuzz_test.R @@ -131,7 +131,6 @@ withr::defer(for (restoration in test_restorations) writeLines(restoration$lines # the best approach but documentation was not very helpful. reporter <- testthat::SummaryReporter$new() testthat::test_local(reporter = reporter, stop_on_failure = FALSE) -# testthat::test_file('tests/testthat/test-brace_linter.R') failures <- reporter$failures$as_list() # ignore any test that failed for expected reasons, e.g. some known lint metadata changes From 49872bf1c0281464a44147ec38f32aff7ba8a786 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 23:47:01 -0700 Subject: [PATCH 117/131] expect_no_lint --- tests/testthat/test-conjunct_test_linter.R | 54 ++++++++++++---------- 1 file changed, 29 insertions(+), 25 deletions(-) diff --git a/tests/testthat/test-conjunct_test_linter.R b/tests/testthat/test-conjunct_test_linter.R index 9f05a2b02..d08e46d4f 100644 --- a/tests/testthat/test-conjunct_test_linter.R +++ b/tests/testthat/test-conjunct_test_linter.R @@ -1,21 +1,25 @@ test_that("conjunct_test_linter skips allowed usages of expect_true", { - expect_lint("expect_true(x)", NULL, conjunct_test_linter()) - expect_lint("testthat::expect_true(x, y, z)", NULL, conjunct_test_linter()) + linter <- conjunct_test_linter() + + expect_no_lint("expect_true(x)", linter) + expect_no_lint("testthat::expect_true(x, y, z)", linter) # more complicated expression - expect_lint("expect_true(x || (y && z))", NULL, conjunct_test_linter()) + expect_no_lint("expect_true(x || (y && z))", linter) # the same by operator precedence, though not obvious a priori - expect_lint("expect_true(x || y && z)", NULL, conjunct_test_linter()) - expect_lint("expect_true(x && y || z)", NULL, conjunct_test_linter()) + expect_no_lint("expect_true(x || y && z)", linter) + expect_no_lint("expect_true(x && y || z)", linter) }) test_that("conjunct_test_linter skips allowed usages of expect_true", { - expect_lint("expect_false(x)", NULL, conjunct_test_linter()) - expect_lint("testthat::expect_false(x, y, z)", NULL, conjunct_test_linter()) + linter <- conjunct_test_linter() + + expect_no_lint("expect_false(x)", linter) + expect_no_lint("testthat::expect_false(x, y, z)", linter) # more complicated expression # (NB: xx && yy || zz and xx || yy && zz both parse with || first) - expect_lint("expect_false(x && (y || z))", NULL, conjunct_test_linter()) + expect_no_lint("expect_false(x && (y || z))", linter) }) test_that("conjunct_test_linter blocks && conditions with expect_true()", { @@ -43,14 +47,14 @@ test_that("conjunct_test_linter blocks || conditions with expect_false()", { test_that("conjunct_test_linter skips allowed stopifnot() and assert_that() usages", { linter <- conjunct_test_linter() - expect_lint("stopifnot(x)", NULL, linter) - expect_lint("assert_that(x, y, z)", NULL, linter) + expect_no_lint("stopifnot(x)", linter) + expect_no_lint("assert_that(x, y, z)", linter) # more complicated expression - expect_lint("stopifnot(x || (y && z))", NULL, linter) + expect_no_lint("stopifnot(x || (y && z))", linter) # the same by operator precedence, though not obvious a priori - expect_lint("stopifnot(x || y && z)", NULL, linter) - expect_lint("assertthat::assert_that(x && y || z)", NULL, linter) + expect_no_lint("stopifnot(x || y && z)", linter) + expect_no_lint("assertthat::assert_that(x && y || z)", linter) }) test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() and assert_that()", { @@ -93,11 +97,11 @@ test_that("conjunct_test_linter's allow_named_stopifnot argument works", { test_that("conjunct_test_linter skips allowed usages", { linter <- conjunct_test_linter() - expect_lint("dplyr::filter(DF, A, B)", NULL, linter) - expect_lint("dplyr::filter(DF, !(A & B))", NULL, linter) + expect_no_lint("dplyr::filter(DF, A, B)", linter) + expect_no_lint("dplyr::filter(DF, !(A & B))", linter) # | is the "top-level" operator here - expect_lint("dplyr::filter(DF, A & B | C)", NULL, linter) - expect_lint("dplyr::filter(DF, A | B & C)", NULL, linter) + expect_no_lint("dplyr::filter(DF, A & B | C)", linter) + expect_no_lint("dplyr::filter(DF, A | B & C)", linter) }) test_that("conjunct_test_linter blocks simple disallowed usages", { @@ -116,22 +120,22 @@ test_that("conjunct_test_linter respects its allow_filter argument", { linter_dplyr <- conjunct_test_linter(allow_filter = "not_dplyr") lint_msg <- rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)") - expect_lint("dplyr::filter(DF, A & B)", NULL, linter_always) - expect_lint("dplyr::filter(DF, A & B & C)", NULL, linter_always) - expect_lint("DF %>% dplyr::filter(A & B)", NULL, linter_always) + expect_no_lint("dplyr::filter(DF, A & B)", linter_always) + expect_no_lint("dplyr::filter(DF, A & B & C)", linter_always) + expect_no_lint("DF %>% dplyr::filter(A & B)", linter_always) expect_lint("dplyr::filter(DF, A & B)", lint_msg, linter_dplyr) expect_lint("dplyr::filter(DF, A & B & C)", lint_msg, linter_dplyr) expect_lint("DF %>% dplyr::filter(A & B)", lint_msg, linter_dplyr) - expect_lint("filter(DF, A & B)", NULL, linter_dplyr) - expect_lint("filter(DF, A & B & C)", NULL, linter_dplyr) - expect_lint("DF %>% filter(A & B)", NULL, linter_dplyr) + expect_no_lint("filter(DF, A & B)", linter_dplyr) + expect_no_lint("filter(DF, A & B & C)", linter_dplyr) + expect_no_lint("DF %>% filter(A & B)", linter_dplyr) }) test_that("filter() is assumed to be dplyr::filter() by default, unless o/w specified", { linter <- conjunct_test_linter() - expect_lint("stats::filter(A & B)", NULL, linter) - expect_lint("ns::filter(A & B)", NULL, linter) + expect_no_lint("stats::filter(A & B)", linter) + expect_no_lint("ns::filter(A & B)", linter) expect_lint( "DF %>% filter(A & B)", rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)"), From 34940109a9fb84032d77ee27dde43342fe5a59ee Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 9 Mar 2025 23:47:35 -0700 Subject: [PATCH 118/131] leftovers --- tests/testthat/test-coalesce_linter.R | 2 +- tests/testthat/test-fixed_regex_linter.R | 2 +- tests/testthat/test-string_boundary_linter.R | 2 +- tests/testthat/test-unnecessary_lambda_linter.R | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-coalesce_linter.R b/tests/testthat/test-coalesce_linter.R index c4ded0895..e25cb7a52 100644 --- a/tests/testthat/test-coalesce_linter.R +++ b/tests/testthat/test-coalesce_linter.R @@ -39,7 +39,7 @@ test_that("coalesce_linter blocks simple disallowed usage", { # adversarial comments expect_lint( trim_some(" - if (!is.null(x[1])) x[ # INJECTED COMMENT + if (!is.null(x[1])) x[ # comment 1] else y "), lint_msg_not, diff --git a/tests/testthat/test-fixed_regex_linter.R b/tests/testthat/test-fixed_regex_linter.R index 8fc19873b..d2058627e 100644 --- a/tests/testthat/test-fixed_regex_linter.R +++ b/tests/testthat/test-fixed_regex_linter.R @@ -379,7 +379,7 @@ local({ test_that("pipe-aware lint logic survives adversarial comments", { expect_lint( trim_some(" - x %>% grepl(pattern = # INJECTED COMMENT + x %>% grepl(pattern = # comment 'a') "), "This regular expression is static", diff --git a/tests/testthat/test-string_boundary_linter.R b/tests/testthat/test-string_boundary_linter.R index 446c5646f..7e02c658d 100644 --- a/tests/testthat/test-string_boundary_linter.R +++ b/tests/testthat/test-string_boundary_linter.R @@ -106,7 +106,7 @@ test_that("string_boundary_linter blocks disallowed substr()/substring() usage", # adversarial comments expect_lint( trim_some(" - substring(colnames(x), start, nchar(colnames( # INJECTED COMMENT + substring(colnames(x), start, nchar(colnames( # comment x))) == 'abc' "), ends_message, diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 541390878..f3228058b 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -165,7 +165,7 @@ test_that("unnecessary_lambda_linter doesn't apply to keyword args", { # adversarially commented expect_no_lint( trim_some(" - lapply(x, function(xi) data.frame(nm = # INJECTED COMMENT + lapply(x, function(xi) data.frame(nm = # comment xi)) "), linter From 0f02cc550f1554d90d0e6153d52f61c726f2c445 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 10 Mar 2025 00:00:03 -0700 Subject: [PATCH 119/131] expect_no_lint in all touched files --- tests/testthat/test-empty_assignment_linter.R | 8 +- .../testthat/test-expect_comparison_linter.R | 10 +- tests/testthat/test-fixed_regex_linter.R | 120 +++++++++--------- tests/testthat/test-if_switch_linter.R | 79 ++++++------ tests/testthat/test-ifelse_censor_linter.R | 4 +- tests/testthat/test-knitr_formats.R | 3 +- tests/testthat/test-length_test_linter.R | 4 +- tests/testthat/test-line_length_linter.R | 6 +- tests/testthat/test-matrix_apply_linter.R | 16 +-- tests/testthat/test-nested_pipe_linter.R | 24 ++-- tests/testthat/test-outer_negation_linter.R | 24 ++-- tests/testthat/test-paren_body_linter.R | 8 +- tests/testthat/test-redundant_equals_linter.R | 6 +- tests/testthat/test-regex_subset_linter.R | 14 +- tests/testthat/test-sort_linter.R | 24 ++-- .../test-spaces_left_parentheses_linter.R | 64 +++++----- tests/testthat/test-sprintf_linter.R | 31 +++-- .../test-trailing_blank_lines_linter.R | 10 +- .../test-trailing_whitespace_linter.R | 7 +- .../test-unnecessary_concatenation_linter.R | 32 ++--- 20 files changed, 244 insertions(+), 250 deletions(-) diff --git a/tests/testthat/test-empty_assignment_linter.R b/tests/testthat/test-empty_assignment_linter.R index 1cc4d9618..a2b7e50f6 100644 --- a/tests/testthat/test-empty_assignment_linter.R +++ b/tests/testthat/test-empty_assignment_linter.R @@ -1,9 +1,11 @@ test_that("empty_assignment_linter skips valid usage", { - expect_lint("x <- { 3 + 4 }", NULL, empty_assignment_linter()) - expect_lint("x <- if (x > 1) { 3 + 4 }", NULL, empty_assignment_linter()) + linter <- empty_assignment_linter() + + expect_no_lint("x <- { 3 + 4 }", linter) + expect_no_lint("x <- if (x > 1) { 3 + 4 }", linter) # also triggers assignment_linter - expect_lint("x = { 3 + 4 }", NULL, empty_assignment_linter()) + expect_no_lint("x = { 3 + 4 }", linter) }) test_that("empty_assignment_linter blocks disallowed usages", { diff --git a/tests/testthat/test-expect_comparison_linter.R b/tests/testthat/test-expect_comparison_linter.R index f4a6b9bd0..adcab53e1 100644 --- a/tests/testthat/test-expect_comparison_linter.R +++ b/tests/testthat/test-expect_comparison_linter.R @@ -2,18 +2,18 @@ test_that("expect_comparison_linter skips allowed usages", { linter <- expect_comparison_linter() # there's no expect_ne() for this operator - expect_lint("expect_true(x != y)", NULL, linter) + expect_no_lint("expect_true(x != y)", linter) # NB: also applies to tinytest, but it's sufficient to test testthat - expect_lint("testthat::expect_true(x != y)", NULL, linter) + expect_no_lint("testthat::expect_true(x != y)", linter) # multiple comparisons are OK - expect_lint("expect_true(x > y || x > z)", NULL, linter) + expect_no_lint("expect_true(x > y || x > z)", linter) # expect_gt() and friends don't have an info= argument - expect_lint("expect_true(x > y, info = 'x is bigger than y yo')", NULL, linter) + expect_no_lint("expect_true(x > y, info = 'x is bigger than y yo')", linter) # expect_true() used incorrectly, and as executed the first argument is not a lint - expect_lint("expect_true(is.count(n_draws), n_draws > 1)", NULL, linter) + expect_no_lint("expect_true(is.count(n_draws), n_draws > 1)", linter) }) test_that("expect_comparison_linter blocks simple disallowed usages", { diff --git a/tests/testthat/test-fixed_regex_linter.R b/tests/testthat/test-fixed_regex_linter.R index d2058627e..0b4a9f273 100644 --- a/tests/testthat/test-fixed_regex_linter.R +++ b/tests/testthat/test-fixed_regex_linter.R @@ -1,30 +1,30 @@ test_that("fixed_regex_linter skips allowed usages", { linter <- fixed_regex_linter() - expect_lint("gsub('^x', '', y)", NULL, linter) - expect_lint("grep('x$', '', y)", NULL, linter) - expect_lint("sub('[a-zA-Z]', '', y)", NULL, linter) - expect_lint("grepl(fmt, y)", NULL, linter) - expect_lint(R"{regexec('\\s', '', y)}", NULL, linter) - expect_lint("grep('a(?=b)', x, perl = TRUE)", NULL, linter) - expect_lint("grep('0+1', x, perl = TRUE)", NULL, linter) - expect_lint("grep('1*2', x)", NULL, linter) - expect_lint("grep('a|b', x)", NULL, linter) - expect_lint(R"{grep('\\[|\\]', x)}", NULL, linter) + expect_no_lint("gsub('^x', '', y)", linter) + expect_no_lint("grep('x$', '', y)", linter) + expect_no_lint("sub('[a-zA-Z]', '', y)", linter) + expect_no_lint("grepl(fmt, y)", linter) + expect_no_lint(R"{regexec('\\s', '', y)}", linter) + expect_no_lint("grep('a(?=b)', x, perl = TRUE)", linter) + expect_no_lint("grep('0+1', x, perl = TRUE)", linter) + expect_no_lint("grep('1*2', x)", linter) + expect_no_lint("grep('a|b', x)", linter) + expect_no_lint(R"{grep('\\[|\\]', x)}", linter) # if fixed=TRUE is already set, regex patterns don't matter - expect_lint(R"{gsub('\\.', '', y, fixed = TRUE)}", NULL, linter) + expect_no_lint(R"{gsub('\\.', '', y, fixed = TRUE)}", linter) # ignore.case=TRUE implies regex interpretation - expect_lint("gsub('abcdefg', '', y, ignore.case = TRUE)", NULL, linter) + expect_no_lint("gsub('abcdefg', '', y, ignore.case = TRUE)", linter) # char classes starting with [] might contain other characters -> not fixed - expect_lint("sub('[][]', '', y)", NULL, linter) - expect_lint("sub('[][ ]', '', y)", NULL, linter) - expect_lint("sub('[],[]', '', y)", NULL, linter) + expect_no_lint("sub('[][]', '', y)", linter) + expect_no_lint("sub('[][ ]', '', y)", linter) + expect_no_lint("sub('[],[]', '', y)", linter) # wrapper functions don't throw - expect_lint("gregexpr(pattern = pattern, data, perl = TRUE, ...)", NULL, linter) + expect_no_lint("gregexpr(pattern = pattern, data, perl = TRUE, ...)", linter) }) test_that("fixed_regex_linter blocks simple disallowed usages", { @@ -77,19 +77,19 @@ test_that("fixed_regex_linter catches regex like [.] or [$]", { test_that("fixed_regex_linter catches null calls to strsplit as well", { linter <- fixed_regex_linter() - expect_lint("strsplit(x, '^x')", NULL, linter) - expect_lint(R"{strsplit(x, '\\s')}", NULL, linter) - expect_lint("strsplit(x, 'a(?=b)', perl = TRUE)", NULL, linter) - expect_lint("strsplit(x, '0+1', perl = TRUE)", NULL, linter) - expect_lint("strsplit(x, 'a|b')", NULL, linter) + expect_no_lint("strsplit(x, '^x')", linter) + expect_no_lint(R"{strsplit(x, '\\s')}", linter) + expect_no_lint("strsplit(x, 'a(?=b)', perl = TRUE)", linter) + expect_no_lint("strsplit(x, '0+1', perl = TRUE)", linter) + expect_no_lint("strsplit(x, 'a|b')", linter) - expect_lint("tstrsplit(x, '1*2')", NULL, linter) - expect_lint("tstrsplit(x, '[a-zA-Z]')", NULL, linter) - expect_lint("tstrsplit(x, fmt)", NULL, linter) + expect_no_lint("tstrsplit(x, '1*2')", linter) + expect_no_lint("tstrsplit(x, '[a-zA-Z]')", linter) + expect_no_lint("tstrsplit(x, fmt)", linter) # if fixed=TRUE is already set, regex patterns don't matter - expect_lint(R"{strsplit(x, '\\.', fixed = TRUE)}", NULL, linter) - expect_lint(R"{strsplit(x, '\\.', fixed = T)}", NULL, linter) + expect_no_lint(R"{strsplit(x, '\\.', fixed = TRUE)}", linter) + expect_no_lint(R"{strsplit(x, '\\.', fixed = T)}", linter) }) test_that("fixed_regex_linter catches calls to strsplit as well", { @@ -106,7 +106,7 @@ test_that("fixed_regex_linter is more exact about distinguishing \\s from \\:", linter <- fixed_regex_linter() lint_msg <- rex::rex("This regular expression is static") - expect_lint(R"{grep('\\s', '', x)}", NULL, linter) + expect_no_lint(R"{grep('\\s', '', x)}", linter) expect_lint(R"{grep('\\:', '', x)}", lint_msg, linter) }) @@ -114,18 +114,18 @@ test_that("fixed_regex_linter is more exact about distinguishing \\s from \\:", test_that("fixed_regex_linter skips allowed stringr usages", { linter <- fixed_regex_linter() - expect_lint("str_replace(y, '[a-zA-Z]', '')", NULL, linter) - expect_lint("str_replace_all(y, '^x', '')", NULL, linter) - expect_lint("str_detect(y, fmt)", NULL, linter) - expect_lint(R"{str_extract(y, '\\s')}", NULL, linter) - expect_lint(R"{str_extract_all(y, '\\s')}", NULL, linter) - expect_lint("str_which(x, '1*2')", NULL, linter) + expect_no_lint("str_replace(y, '[a-zA-Z]', '')", linter) + expect_no_lint("str_replace_all(y, '^x', '')", linter) + expect_no_lint("str_detect(y, fmt)", linter) + expect_no_lint(R"{str_extract(y, '\\s')}", linter) + expect_no_lint(R"{str_extract_all(y, '\\s')}", linter) + expect_no_lint("str_which(x, '1*2')", linter) # if fixed() is already set, regex patterns don't matter - expect_lint(R"{str_replace(y, fixed('\\.'), '')}", NULL, linter) + expect_no_lint(R"{str_replace(y, fixed('\\.'), '')}", linter) # namespace qualification doesn't matter - expect_lint("stringr::str_replace(y, stringr::fixed('abcdefg'), '')", NULL, linter) + expect_no_lint("stringr::str_replace(y, stringr::fixed('abcdefg'), '')", linter) }) test_that("fixed_regex_linter blocks simple disallowed usages of stringr functions", { @@ -148,11 +148,11 @@ test_that("fixed_regex_linter catches calls to str_split as well", { linter <- fixed_regex_linter() lint_msg <- rex::rex("This regular expression is static") - expect_lint("str_split(x, '^x')", NULL, linter) - expect_lint("str_split(x, fmt)", NULL, linter) + expect_no_lint("str_split(x, '^x')", linter) + expect_no_lint("str_split(x, fmt)", linter) # if fixed() is already set, regex patterns don't matter - expect_lint(R"{str_split(x, fixed('\\.'))}", NULL, linter) + expect_no_lint(R"{str_split(x, fixed('\\.'))}", linter) expect_lint(R"{str_split(x, '\\.')}", lint_msg, linter) expect_lint("str_split(x, '[.]')", lint_msg, linter) }) @@ -163,8 +163,8 @@ test_that("str_replace_all's multi-replacement version is handled", { # While each of the replacements is fixed, and this _could_ in principle be replaced by # a pipeline where each step does one of the replacements and fixed() is used, this is overkill. # Instead, ensure that no lint is returned for this case - expect_lint('str_replace_all(x, c("one" = "1", "two" = "2", "three" = "3"))', NULL, linter) - expect_lint('grepl(c("a" = "b"), x)', NULL, linter) + expect_no_lint('str_replace_all(x, c("one" = "1", "two" = "2", "three" = "3"))', linter) + expect_no_lint('grepl(c("a" = "b"), x)', linter) }) test_that("1- or 2-width octal escape sequences are handled", { @@ -209,20 +209,20 @@ test_that("bracketed unicode escapes are caught", { test_that("escaped characters are handled correctly", { linter <- fixed_regex_linter() - expect_lint(R"{gsub('\n+', '', sql)}", NULL, linter) - expect_lint('gsub("\\n{2,}", "\n", D)', NULL, linter) - expect_lint(R'{gsub("[\r\n]", "", x)}', NULL, linter) - expect_lint(R'{gsub("\n $", "", y)}', NULL, linter) - expect_lint(R'{gsub("```\n*```r*\n*", "", x)}', NULL, linter) - expect_lint('strsplit(x, "(;|\n)")', NULL, linter) - expect_lint(R'{strsplit(x, "(;|\n)")}', NULL, linter) - expect_lint(R'{grepl("[\\W]", x, perl = TRUE)}', NULL, linter) - expect_lint(R'{grepl("[\\W]", x)}', NULL, linter) + expect_no_lint(R"{gsub('\n+', '', sql)}", linter) + expect_no_lint('gsub("\\n{2,}", "\n", D)', linter) + expect_no_lint(R'{gsub("[\r\n]", "", x)}', linter) + expect_no_lint(R'{gsub("\n $", "", y)}', linter) + expect_no_lint(R'{gsub("```\n*```r*\n*", "", x)}', linter) + expect_no_lint('strsplit(x, "(;|\n)")', linter) + expect_no_lint(R'{strsplit(x, "(;|\n)")}', linter) + expect_no_lint(R'{grepl("[\\W]", x, perl = TRUE)}', linter) + expect_no_lint(R'{grepl("[\\W]", x)}', linter) }) # make sure the logic is properly vectorized test_that("single expression with multiple regexes is OK", { - expect_lint('c(grep("^a", x), grep("b$", x))', NULL, fixed_regex_linter()) + expect_no_lint('c(grep("^a", x), grep("b$", x))', fixed_regex_linter()) }) test_that("fixed replacements vectorize and recognize str_detect", { @@ -344,8 +344,8 @@ local({ test_that("'unescaped' regex can optionally be skipped", { linter <- fixed_regex_linter(allow_unescaped = TRUE) - expect_lint("grepl('a', x)", NULL, linter) - expect_lint("str_detect(x, 'a')", NULL, linter) + expect_no_lint("grepl('a', x)", linter) + expect_no_lint("str_detect(x, 'a')", linter) expect_lint("grepl('[$]', x)", rex::rex('Use "$" with fixed = TRUE'), linter) }) @@ -358,18 +358,18 @@ local({ "linter is pipe-aware", { expect_lint(paste("x", pipe, "grepl(pattern = 'a')"), lint_msg, linter) - expect_lint(paste("x", pipe, "grepl(pattern = '^a')"), NULL, linter) - expect_lint(paste("x", pipe, "grepl(pattern = 'a', fixed = TRUE)"), NULL, linter) + expect_no_lint(paste("x", pipe, "grepl(pattern = '^a')"), linter) + expect_no_lint(paste("x", pipe, "grepl(pattern = 'a', fixed = TRUE)"), linter) expect_lint(paste("x", pipe, "str_detect('a')"), lint_msg, linter) - expect_lint(paste("x", pipe, "str_detect('^a')"), NULL, linter) - expect_lint(paste("x", pipe, "str_detect(fixed('a'))"), NULL, linter) + expect_no_lint(paste("x", pipe, "str_detect('^a')"), linter) + expect_no_lint(paste("x", pipe, "str_detect(fixed('a'))"), linter) expect_lint(paste("x", pipe, "gsub(pattern = 'a', replacement = '')"), lint_msg, linter) - expect_lint(paste("x", pipe, "gsub(pattern = '^a', replacement = '')"), NULL, linter) - expect_lint(paste("x", pipe, "gsub(pattern = 'a', replacement = '', fixed = TRUE)"), NULL, linter) + expect_no_lint(paste("x", pipe, "gsub(pattern = '^a', replacement = '')"), linter) + expect_no_lint(paste("x", pipe, "gsub(pattern = 'a', replacement = '', fixed = TRUE)"), linter) expect_lint(paste("x", pipe, "str_replace('a', '')"), lint_msg, linter) - expect_lint(paste("x", pipe, "str_replace('^a', '')"), NULL, linter) - expect_lint(paste("x", pipe, "str_replace(fixed('a'), '')"), NULL, linter) + expect_no_lint(paste("x", pipe, "str_replace('^a', '')"), linter) + expect_no_lint(paste("x", pipe, "str_replace(fixed('a'), '')"), linter) }, pipe = pipes, .test_name = names(pipes) diff --git a/tests/testthat/test-if_switch_linter.R b/tests/testthat/test-if_switch_linter.R index 6d3f04997..867473413 100644 --- a/tests/testthat/test-if_switch_linter.R +++ b/tests/testthat/test-if_switch_linter.R @@ -2,23 +2,23 @@ test_that("if_switch_linter skips allowed usages", { linter <- if_switch_linter() # don't apply to simple if/else statements - expect_lint("if (x == 'a') 1 else 2", NULL, linter) + expect_no_lint("if (x == 'a') 1 else 2", linter) # don't apply to non-character conditions # (NB: switch _could_ be used for integral input, but this # interface is IMO a bit clunky / opaque) - expect_lint("if (x == 1) 1 else 2", NULL, linter) + expect_no_lint("if (x == 1) 1 else 2", linter) # this also has a switch equivalent, but we don't both handling such # complicated cases - expect_lint("if (x == 'a') 1 else if (x != 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x != 'b') 2 else 3", linter) # multiple variables involved --> no clean change - expect_lint("if (x == 'a') 1 else if (y == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (y == 'b') 2 else 3", linter) # multiple conditions --> no clean change - expect_lint("if (is.character(x) && x == 'a') 1 else if (x == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (is.character(x) && x == 'a') 1 else if (x == 'b') 2 else 3", linter) # simple cases with two conditions might be more natural # without switch(); require at least three branches to trigger a lint - expect_lint("if (x == 'a') 1 else if (x == 'b') 2", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2", linter) # still no third if() clause - expect_lint("if (x == 'a') 1 else if (x == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2 else 3", linter) }) test_that("if_switch_linter blocks simple disallowed usages", { @@ -52,9 +52,8 @@ test_that("if_switch_linter handles further nested if/else correctly", { # related to previous test -- if the first condition is non-`==`, the # whole if/else chain is "tainted" / non-switch()-recommended. # (technically, switch can work here, but the semantics are opaque) - expect_lint( + expect_no_lint( "if (x %in% c('a', 'e', 'f')) 1 else if (x == 'b') 2 else if (x == 'c') 3 else if (x == 'd') 4", - NULL, linter ) }) @@ -140,9 +139,9 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { # no 9 } ") - expect_lint(three_per_branch_lines, NULL, max_lines2_linter) + expect_no_lint(three_per_branch_lines, max_lines2_linter) expect_lint(three_per_branch_lines, lint_msg, max_lines4_linter) - expect_lint(three_per_branch_lines, NULL, max_expr2_linter) + expect_no_lint(three_per_branch_lines, max_expr2_linter) expect_lint(three_per_branch_lines, lint_msg, max_expr4_linter) five_per_branch_lines <- trim_some(" @@ -166,10 +165,10 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { # no 15 } ") - expect_lint(five_per_branch_lines, NULL, max_lines2_linter) - expect_lint(five_per_branch_lines, NULL, max_lines4_linter) - expect_lint(five_per_branch_lines, NULL, max_expr2_linter) - expect_lint(five_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(five_per_branch_lines, max_lines2_linter) + expect_no_lint(five_per_branch_lines, max_lines4_linter) + expect_no_lint(five_per_branch_lines, max_expr2_linter) + expect_no_lint(five_per_branch_lines, max_expr4_linter) five_lines_three_expr_lines <- trim_some(" if (x == 'a') { @@ -192,9 +191,9 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { # no ) } ") - expect_lint(five_lines_three_expr_lines, NULL, max_lines2_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_lines4_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_expr2_linter) + expect_no_lint(five_lines_three_expr_lines, max_lines2_linter) + expect_no_lint(five_lines_three_expr_lines, max_lines4_linter) + expect_no_lint(five_lines_three_expr_lines, max_expr2_linter) expect_lint( five_lines_three_expr_lines, list(lint_msg, line_number = 1L), @@ -216,14 +215,14 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { # no 13; 14; 15 } ") - expect_lint(five_expr_three_lines_lines, NULL, max_lines2_linter) + expect_no_lint(five_expr_three_lines_lines, max_lines2_linter) expect_lint( five_expr_three_lines_lines, list(lint_msg, line_number = 1L), max_lines4_linter ) - expect_lint(five_expr_three_lines_lines, NULL, max_expr2_linter) - expect_lint(five_expr_three_lines_lines, NULL, max_expr4_linter) + expect_no_lint(five_expr_three_lines_lines, max_expr2_linter) + expect_no_lint(five_expr_three_lines_lines, max_expr4_linter) }) test_that("max_branch_lines= and max_branch_expressions= block over-complex switch() too", { # nofuzz @@ -246,10 +245,10 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit } ) ") - expect_lint(one_per_branch_lines, NULL, max_lines2_linter) - expect_lint(one_per_branch_lines, NULL, max_lines4_linter) - expect_lint(one_per_branch_lines, NULL, max_expr2_linter) - expect_lint(one_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(one_per_branch_lines, max_lines2_linter) + expect_no_lint(one_per_branch_lines, max_lines4_linter) + expect_no_lint(one_per_branch_lines, max_expr2_linter) + expect_no_lint(one_per_branch_lines, max_expr4_linter) two_per_branch_lines <- trim_some(" switch(x, @@ -267,10 +266,10 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit } ) ") - expect_lint(two_per_branch_lines, NULL, max_lines2_linter) - expect_lint(two_per_branch_lines, NULL, max_lines4_linter) - expect_lint(two_per_branch_lines, NULL, max_expr2_linter) - expect_lint(two_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(two_per_branch_lines, max_lines2_linter) + expect_no_lint(two_per_branch_lines, max_lines4_linter) + expect_no_lint(two_per_branch_lines, max_expr2_linter) + expect_no_lint(two_per_branch_lines, max_expr4_linter) three_per_branch_lines <- trim_some(" switch(x, @@ -296,13 +295,13 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit list(lint_msg, line_number = 1L), max_lines2_linter ) - expect_lint(three_per_branch_lines, NULL, max_lines4_linter) + expect_no_lint(three_per_branch_lines, max_lines4_linter) expect_lint( three_per_branch_lines, list(lint_msg, line_number = 1L), max_expr2_linter ) - expect_lint(three_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(three_per_branch_lines, max_expr4_linter) five_per_branch_lines <- trim_some(" switch(x, @@ -362,7 +361,7 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit expect_lint(five_lines_three_expr_lines, lint_msg, max_lines2_linter) expect_lint(five_lines_three_expr_lines, lint_msg, max_lines4_linter) expect_lint(five_lines_three_expr_lines, lint_msg, max_expr2_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_expr4_linter) + expect_no_lint(five_lines_three_expr_lines, max_expr4_linter) five_expr_three_lines_lines <- trim_some(" switch(x, @@ -384,7 +383,7 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit ) ") expect_lint(five_expr_three_lines_lines, lint_msg, max_lines2_linter) - expect_lint(five_expr_three_lines_lines, NULL, max_lines4_linter) + expect_no_lint(five_expr_three_lines_lines, max_lines4_linter) expect_lint(five_expr_three_lines_lines, lint_msg, max_expr2_linter) expect_lint(five_expr_three_lines_lines, lint_msg, max_expr4_linter) }) @@ -407,7 +406,7 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { linter ) - expect_lint( + expect_no_lint( trim_some(" if (x == 'a') { foo( @@ -422,11 +421,10 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { 3 } "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" if (x == 'a') { 1; 2; 3; 4 @@ -436,7 +434,6 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { 6 } "), - NULL, linter ) }) @@ -459,8 +456,8 @@ test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'el 6 } ") - expect_lint(else_long_lines, NULL, max_lines2_linter) - expect_lint(else_long_lines, NULL, max_expr2_linter) + expect_no_lint(else_long_lines, max_lines2_linter) + expect_no_lint(else_long_lines, max_expr2_linter) default_long_lines <- trim_some(" switch(x, @@ -501,8 +498,8 @@ test_that("max_branch_lines= and max_branch_expressions= are guided by the most 5 } ") - expect_lint(if_else_one_branch_lines, NULL, max_lines2_linter) - expect_lint(if_else_one_branch_lines, NULL, max_expr2_linter) + expect_no_lint(if_else_one_branch_lines, max_lines2_linter) + expect_no_lint(if_else_one_branch_lines, max_expr2_linter) # lint if _any_ branch is too complex switch_one_branch_lines <- trim_some(" diff --git a/tests/testthat/test-ifelse_censor_linter.R b/tests/testthat/test-ifelse_censor_linter.R index 4f9a6014c..763a077af 100644 --- a/tests/testthat/test-ifelse_censor_linter.R +++ b/tests/testthat/test-ifelse_censor_linter.R @@ -1,8 +1,8 @@ test_that("ifelse_censor_linter skips allowed usages", { linter <- ifelse_censor_linter() - expect_lint("ifelse(x == 2, x, y)", NULL, linter) - expect_lint("ifelse(x > 2, x, y)", NULL, linter) + expect_no_lint("ifelse(x == 2, x, y)", linter) + expect_no_lint("ifelse(x > 2, x, y)", linter) }) test_that("ifelse_censor_linter blocks simple disallowed usages", { diff --git a/tests/testthat/test-knitr_formats.R b/tests/testthat/test-knitr_formats.R index 7538dc213..8a70c7c87 100644 --- a/tests/testthat/test-knitr_formats.R +++ b/tests/testthat/test-knitr_formats.R @@ -131,9 +131,8 @@ test_that("it does _not_ handle brew", { # nofuzz }) test_that("it does _not_ error with inline \\Sexpr", { - expect_lint( + expect_no_lint( "#' text \\Sexpr{1 + 1} more text", - NULL, default_linters ) }) diff --git a/tests/testthat/test-length_test_linter.R b/tests/testthat/test-length_test_linter.R index 824cb9e7d..f71e13e66 100644 --- a/tests/testthat/test-length_test_linter.R +++ b/tests/testthat/test-length_test_linter.R @@ -1,8 +1,8 @@ test_that("skips allowed usages", { linter <- length_test_linter() - expect_lint("length(x) > 0", NULL, linter) - expect_lint("length(DF[key == val, cols])", NULL, linter) + expect_no_lint("length(x) > 0", linter) + expect_no_lint("length(DF[key == val, cols])", linter) }) test_that("blocks simple disallowed usages", { diff --git a/tests/testthat/test-line_length_linter.R b/tests/testthat/test-line_length_linter.R index 5455c51bf..483ecff5a 100644 --- a/tests/testthat/test-line_length_linter.R +++ b/tests/testthat/test-line_length_linter.R @@ -2,8 +2,8 @@ test_that("line_length_linter skips allowed usages", { linter <- line_length_linter(80L) - expect_lint("blah", NULL, linter) - expect_lint(strrep("x", 80L), NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint(strrep("x", 80L), linter) }) test_that("line_length_linter blocks disallowed usages", { @@ -38,7 +38,7 @@ test_that("line_length_linter blocks disallowed usages", { linter <- line_length_linter(20L) lint_msg <- rex::rex("Lines should not be more than 20 characters. This line is 22 characters.") - expect_lint(strrep("a", 20L), NULL, linter) + expect_no_lint(strrep("a", 20L), linter) expect_lint( strrep("a", 22L), list( diff --git a/tests/testthat/test-matrix_apply_linter.R b/tests/testthat/test-matrix_apply_linter.R index b896c54e7..5503fb8b2 100644 --- a/tests/testthat/test-matrix_apply_linter.R +++ b/tests/testthat/test-matrix_apply_linter.R @@ -1,31 +1,31 @@ test_that("matrix_apply_linter skips allowed usages", { linter <- matrix_apply_linter() - expect_lint("apply(x, 1, prod)", NULL, linter) + expect_no_lint("apply(x, 1, prod)", linter) - expect_lint("apply(x, 1, function(i) sum(i[i > 0]))", NULL, linter) + expect_no_lint("apply(x, 1, function(i) sum(i[i > 0]))", linter) # sum as FUN argument - expect_lint("apply(x, 1, f, sum)", NULL, linter) + expect_no_lint("apply(x, 1, f, sum)", linter) # mean() with named arguments other than na.rm is skipped because they are not # implemented in colMeans() or rowMeans() - expect_lint("apply(x, 1, mean, trim = 0.2)", NULL, linter) + expect_no_lint("apply(x, 1, mean, trim = 0.2)", linter) }) test_that("matrix_apply_linter is not implemented for complex MARGIN values", { linter <- matrix_apply_linter() # Could be implemented at some point - expect_lint("apply(x, seq(2, 4), sum)", NULL, linter) + expect_no_lint("apply(x, seq(2, 4), sum)", linter) # No equivalent - expect_lint("apply(x, c(2, 4), sum)", NULL, linter) + expect_no_lint("apply(x, c(2, 4), sum)", linter) # Beyond the scope of static analysis - expect_lint("apply(x, m, sum)", NULL, linter) + expect_no_lint("apply(x, m, sum)", linter) - expect_lint("apply(x, 1 + 2:4, sum)", NULL, linter) + expect_no_lint("apply(x, 1 + 2:4, sum)", linter) }) diff --git a/tests/testthat/test-nested_pipe_linter.R b/tests/testthat/test-nested_pipe_linter.R index d1f723b84..f79dbd3e6 100644 --- a/tests/testthat/test-nested_pipe_linter.R +++ b/tests/testthat/test-nested_pipe_linter.R @@ -1,54 +1,50 @@ test_that("nested_pipe_linter skips allowed usages", { linter <- nested_pipe_linter() - expect_lint("a %>% b() %>% c()", NULL, linter) + expect_no_lint("a %>% b() %>% c()", linter) - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { out <- a %>% b() return(out) } "), - NULL, linter ) # pipes fitting on one line can be ignored - expect_lint( # nofuzz + expect_no_lint( # nofuzz "bind_rows(a %>% select(b), c %>% select(b))", - NULL, linter ) # switch outputs are OK - expect_lint("switch(x, a = x %>% foo())", NULL, linter) + expect_no_lint("switch(x, a = x %>% foo())", linter) # final position is an output position - expect_lint("switch(x, a = x, x %>% foo())", NULL, linter) + expect_no_lint("switch(x, a = x, x %>% foo())", linter) # inline switch inputs are not linted - expect_lint( # nofuzz + expect_no_lint( # nofuzz trim_some(" switch( x %>% foo(), a = x ) "), - NULL, linter ) }) patrick::with_parameters_test_that( "allow_outer_calls defaults are ignored by default", - expect_lint( + expect_no_lint( trim_some(sprintf(outer_call, fmt = " %s( x %%>%% foo() ) ")), - NULL, nested_pipe_linter() ), .test_name = c("try", "tryCatch", "withCallingHandlers"), @@ -114,14 +110,13 @@ test_that("allow_outer_calls= argument works", { nested_pipe_linter(allow_outer_calls = character()) ) - expect_lint( + expect_no_lint( trim_some(" print( x %>% foo() ) "), - NULL, nested_pipe_linter(allow_outer_calls = "print") ) }) @@ -133,9 +128,8 @@ test_that("Native pipes are handled as well", { linter_inline <- nested_pipe_linter(allow_inline = FALSE) lint_msg <- rex::rex("Don't nest pipes inside other calls.") - expect_lint( # nofuzz + expect_no_lint( # nofuzz "bind_rows(a |> select(b), c |> select(b))", - NULL, linter ) expect_lint( diff --git a/tests/testthat/test-outer_negation_linter.R b/tests/testthat/test-outer_negation_linter.R index 6f3596fbe..aa18761f1 100644 --- a/tests/testthat/test-outer_negation_linter.R +++ b/tests/testthat/test-outer_negation_linter.R @@ -1,20 +1,20 @@ test_that("outer_negation_linter skips allowed usages", { linter <- outer_negation_linter() - expect_lint("x <- any(y)", NULL, linter) - expect_lint("y <- all(z)", NULL, linter) + expect_no_lint("x <- any(y)", linter) + expect_no_lint("y <- all(z)", linter) # extended usage of any is not covered - expect_lint("any(!a & b)", NULL, linter) - expect_lint("all(a | !b)", NULL, linter) + expect_no_lint("any(!a & b)", linter) + expect_no_lint("all(a | !b)", linter) - expect_lint("any(a, b)", NULL, linter) - expect_lint("all(b, c)", NULL, linter) - expect_lint("any(!a, b)", NULL, linter) - expect_lint("all(a, !b)", NULL, linter) - expect_lint("any(a, !b, na.rm = TRUE)", NULL, linter) + expect_no_lint("any(a, b)", linter) + expect_no_lint("all(b, c)", linter) + expect_no_lint("any(!a, b)", linter) + expect_no_lint("all(a, !b)", linter) + expect_no_lint("any(a, !b, na.rm = TRUE)", linter) # ditto when na.rm is passed quoted - expect_lint("any(a, !b, 'na.rm' = TRUE)", NULL, linter) + expect_no_lint("any(a, !b, 'na.rm' = TRUE)", linter) }) test_that("outer_negation_linter blocks simple disallowed usages", { @@ -47,9 +47,9 @@ test_that("outer_negation_linter doesn't trigger on empty calls", { linter <- outer_negation_linter() # minimal version of issue - expect_lint("any()", NULL, linter) + expect_no_lint("any()", linter) # closer to what was is practically relevant, as another regression test - expect_lint("x %>% any()", NULL, linter) + expect_no_lint("x %>% any()", linter) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R index 44965af29..d82c1738c 100644 --- a/tests/testthat/test-paren_body_linter.R +++ b/tests/testthat/test-paren_body_linter.R @@ -11,10 +11,10 @@ testthat::test_that("paren_body_linter returns correct lints", { expect_lint("for (i in seq_along(1))test", lint_msg, linter) # A space after the closing parenthesis does not prompt a lint - expect_lint("function() test", NULL, linter) + expect_no_lint("function() test", linter) # Symbols after the closing parenthesis of a function call do not prompt a lint - expect_lint("head(mtcars)$cyl", NULL, linter) + expect_no_lint("head(mtcars)$cyl", linter) # paren_body_linter returns the correct line number expect_lint( @@ -36,10 +36,10 @@ testthat::test_that("paren_body_linter returns correct lints", { ) # paren_body_linter does not lint when the function body is defined on a new line - expect_lint("function()\n test", NULL, linter) + expect_no_lint("function()\n test", linter) # paren_body_linter does not lint comments - expect_lint("#function()test", NULL, linter) + expect_no_lint("#function()test", linter) # multiple lints on the same line expect_lint("function()if(TRUE)while(TRUE)test", list(lint_msg, lint_msg, lint_msg), linter) diff --git a/tests/testthat/test-redundant_equals_linter.R b/tests/testthat/test-redundant_equals_linter.R index 5b830e867..8bd829b6a 100644 --- a/tests/testthat/test-redundant_equals_linter.R +++ b/tests/testthat/test-redundant_equals_linter.R @@ -1,8 +1,10 @@ test_that("redundant_equals_linter skips allowed usages", { + linter <- redundant_equals_linter() + # comparisons to non-logical constants - expect_lint("x == 1", NULL, redundant_equals_linter()) + expect_no_lint("x == 1", linter) # comparison to TRUE as a string - expect_lint("x != 'TRUE'", NULL, redundant_equals_linter()) + expect_no_lint("x != 'TRUE'", linter) }) test_that("multiple lints return correct custom messages", { diff --git a/tests/testthat/test-regex_subset_linter.R b/tests/testthat/test-regex_subset_linter.R index 5753788ff..f819d543f 100644 --- a/tests/testthat/test-regex_subset_linter.R +++ b/tests/testthat/test-regex_subset_linter.R @@ -1,6 +1,8 @@ test_that("regex_subset_linter skips allowed usages", { - expect_lint("y[grepl(ptn, x)]", NULL, regex_subset_linter()) - expect_lint("x[grepl(ptn, foo(x))]", NULL, regex_subset_linter()) + linter <- regex_subset_linter() + + expect_no_lint("y[grepl(ptn, x)]", linter) + expect_no_lint("x[grepl(ptn, foo(x))]", linter) }) test_that("regex_subset_linter blocks simple disallowed usages", { @@ -42,10 +44,10 @@ test_that("regex_subset_linter skips grep/grepl subassignment", { test_that("regex_subset_linter skips allowed usages for stringr equivalents", { linter <- regex_subset_linter() - expect_lint("y[str_detect(x, ptn)]", NULL, linter) - expect_lint("x[str_detect(foo(x), ptn)]", NULL, linter) - expect_lint("x[str_detect(x, ptn)] <- ''", NULL, linter) - expect_lint("x[str_detect(x, ptn)] <- ''", NULL, linter) + expect_no_lint("y[str_detect(x, ptn)]", linter) + expect_no_lint("x[str_detect(foo(x), ptn)]", linter) + expect_no_lint("x[str_detect(x, ptn)] <- ''", linter) + expect_no_lint("x[str_detect(x, ptn)] <- ''", linter) }) test_that("regex_subset_linter blocks disallowed usages for stringr equivalents", { diff --git a/tests/testthat/test-sort_linter.R b/tests/testthat/test-sort_linter.R index 11a502d28..aa0e57804 100644 --- a/tests/testthat/test-sort_linter.R +++ b/tests/testthat/test-sort_linter.R @@ -1,17 +1,17 @@ test_that("sort_linter skips allowed usages", { linter <- sort_linter() - expect_lint("order(y)", NULL, linter) + expect_no_lint("order(y)", linter) - expect_lint("y[order(x)]", NULL, linter) + expect_no_lint("y[order(x)]", linter) # If another function is intercalated, don't fail - expect_lint("x[c(order(x))]", NULL, linter) + expect_no_lint("x[c(order(x))]", linter) - expect_lint("x[order(y, x)]", NULL, linter) - expect_lint("x[order(x, y)]", NULL, linter) + expect_no_lint("x[order(y, x)]", linter) + expect_no_lint("x[order(x, y)]", linter) # pretty sure this never makes sense, but test anyway - expect_lint("x[order(y, na.last = x)]", NULL, linter) + expect_no_lint("x[order(y, na.last = x)]", linter) }) @@ -115,17 +115,17 @@ test_that("sort_linter skips usages calling sort arguments", { linter <- sort_linter() # any arguments to sort --> not compatible - expect_lint("sort(x, decreasing = TRUE) == x", NULL, linter) - expect_lint("sort(x, na.last = TRUE) != x", NULL, linter) - expect_lint("sort(x, method_arg = TRUE) == x", NULL, linter) + expect_no_lint("sort(x, decreasing = TRUE) == x", linter) + expect_no_lint("sort(x, na.last = TRUE) != x", linter) + expect_no_lint("sort(x, method_arg = TRUE) == x", linter) }) test_that("sort_linter skips when inputs don't match", { linter <- sort_linter() - expect_lint("sort(x) == y", NULL, linter) - expect_lint("sort(x) == foo(x)", NULL, linter) - expect_lint("sort(foo(x)) == x", NULL, linter) + expect_no_lint("sort(x) == y", linter) + expect_no_lint("sort(x) == foo(x)", linter) + expect_no_lint("sort(foo(x)) == x", linter) }) test_that("sort_linter blocks simple disallowed usages for is.sorted cases", { diff --git a/tests/testthat/test-spaces_left_parentheses_linter.R b/tests/testthat/test-spaces_left_parentheses_linter.R index cc808354b..6d7956daf 100644 --- a/tests/testthat/test-spaces_left_parentheses_linter.R +++ b/tests/testthat/test-spaces_left_parentheses_linter.R @@ -2,44 +2,44 @@ test_that("spaces_left_parentheses_linter skips allowed usages", { linter <- spaces_left_parentheses_linter() - expect_lint("blah", NULL, linter) - expect_lint("print(blah)", NULL, linter) - expect_lint("base::print(blah)", NULL, linter) - expect_lint("base::print(blah, fun(1))", NULL, linter) - expect_lint("blah <- function(blah) { }", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("print(blah)", linter) + expect_no_lint("base::print(blah)", linter) + expect_no_lint("base::print(blah, fun(1))", linter) + expect_no_lint("blah <- function(blah) { }", linter) - expect_lint("(1 + 1)", NULL, linter) - expect_lint("(1 + 1)", NULL, linter) - expect_lint("( (1 + 1) )", NULL, linter) - expect_lint("if (blah) { }", NULL, linter) - expect_lint("for (i in j) { }", NULL, linter) - expect_lint("1 * (1 + 1)", NULL, linter) - expect_lint("!(1 == 1)", NULL, linter) - expect_lint("(2 - 1):(3 - 1)", NULL, linter) - expect_lint("c(1, 2, 3)[(2 - 1)]", NULL, linter) - expect_lint("list(1, 2, 3)[[(2 - 1)]]", NULL, linter) - expect_lint("range(10)[(2 - 1):(10 - 1)]", NULL, linter) - expect_lint("function(){function(){}}()()", NULL, linter) - expect_lint("c(function(){})[1]()", NULL, linter) + expect_no_lint("(1 + 1)", linter) + expect_no_lint("(1 + 1)", linter) + expect_no_lint("( (1 + 1) )", linter) + expect_no_lint("if (blah) { }", linter) + expect_no_lint("for (i in j) { }", linter) + expect_no_lint("1 * (1 + 1)", linter) + expect_no_lint("!(1 == 1)", linter) + expect_no_lint("(2 - 1):(3 - 1)", linter) + expect_no_lint("c(1, 2, 3)[(2 - 1)]", linter) + expect_no_lint("list(1, 2, 3)[[(2 - 1)]]", linter) + expect_no_lint("range(10)[(2 - 1):(10 - 1)]", linter) + expect_no_lint("function(){function(){}}()()", linter) + expect_no_lint("c(function(){})[1]()", linter) - expect_lint("\"test <- function(x) { if(1 + 1) 'hi' }\"", NULL, linter) - expect_lint("res <- c((mat - 1L) %*% combs + 1L)", NULL, linter) - expect_lint("if (!(foo && bar || baz)) { foo }", NULL, linter) - expect_lint("x^(y + z)", NULL, linter) - expect_lint("x**(y + z)", NULL, linter) - expect_lint("a <- -(b)", NULL, linter) + expect_no_lint("\"test <- function(x) { if(1 + 1) 'hi' }\"", linter) + expect_no_lint("res <- c((mat - 1L) %*% combs + 1L)", linter) + expect_no_lint("if (!(foo && bar || baz)) { foo }", linter) + expect_no_lint("x^(y + z)", linter) + expect_no_lint("x**(y + z)", linter) + expect_no_lint("a <- -(b)", linter) - expect_lint("(3^(3 + 2))", NULL, linter) - expect_lint("-(!!!symb)", NULL, linter) + expect_no_lint("(3^(3 + 2))", linter) + expect_no_lint("-(!!!symb)", linter) - expect_lint("'[[<-.data.frame'(object, y)", NULL, linter) - expect_lint("object@data@get('input')", NULL, linter) - expect_lint("x <- ~(. + y)", NULL, linter) + expect_no_lint("'[[<-.data.frame'(object, y)", linter) + expect_no_lint("object@data@get('input')", linter) + expect_no_lint("x <- ~(. + y)", linter) # the internal newline is required to trigger the lint - expect_lint("if (x > 1)\n x <- x[-(i)]", NULL, linter) + expect_no_lint("if (x > 1)\n x <- x[-(i)]", linter) # these don't violate the linter, even if they are strange coding practice - expect_lint("for (ii in 1:10) next()", NULL, linter) - expect_lint("for (ii in 1:10) break()", NULL, linter) + expect_no_lint("for (ii in 1:10) next()", linter) + expect_no_lint("for (ii in 1:10) break()", linter) }) test_that("spaces_left_parentheses_linter blocks disallowed usages", { diff --git a/tests/testthat/test-sprintf_linter.R b/tests/testthat/test-sprintf_linter.R index 3127c82ed..7fc6fa27d 100644 --- a/tests/testthat/test-sprintf_linter.R +++ b/tests/testthat/test-sprintf_linter.R @@ -4,14 +4,14 @@ patrick::with_parameters_test_that( linter <- sprintf_linter() # NB: using paste0, not sprintf, to avoid escaping '%d' in sprint fmt= - expect_lint(paste0(call_name, "('hello')"), NULL, linter) - expect_lint(paste0(call_name, "('hello %d', 1)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %d', x)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %d', x + 1)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %d', f(x))"), NULL, linter) - expect_lint(paste0(call_name, "('hello %1$s %1$s', x)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), NULL, linter) + expect_no_lint(paste0(call_name, "('hello')"), linter) + expect_no_lint(paste0(call_name, "('hello %d', 1)"), linter) + expect_no_lint(paste0(call_name, "('hello %d', x)"), linter) + expect_no_lint(paste0(call_name, "('hello %d', x + 1)"), linter) + expect_no_lint(paste0(call_name, "('hello %d', f(x))"), linter) + expect_no_lint(paste0(call_name, "('hello %1$s %1$s', x)"), linter) + expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), linter) + expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), linter) }, .test_name = c("sprintf", "gettextf"), call_name = c("sprintf", "gettextf") @@ -66,24 +66,23 @@ test_that("edge cases are detected correctly", { linter <- sprintf_linter() # works with multi-line sprintf and comments - expect_lint( + expect_no_lint( trim_some(" sprintf( 'test fmt %s', # this is a comment 2 ) "), - NULL, linter ) # dots - expect_lint("sprintf('%d %d, %d', id, ...)", NULL, linter) + expect_no_lint("sprintf('%d %d, %d', id, ...)", linter) # TODO(#1265) extend ... detection to at least test for too many arguments. # named argument fmt - expect_lint("sprintf(x, fmt = 'hello %1$s %1$s')", NULL, linter) + expect_no_lint("sprintf(x, fmt = 'hello %1$s %1$s')", linter) expect_lint( "sprintf(x, fmt = 'hello %1$s %1$s %3$d', y)", @@ -92,7 +91,7 @@ test_that("edge cases are detected correctly", { ) # #2131: xml2lang stripped necessary whitespace - expect_lint("sprintf('%s', if (A) '' else y)", NULL, linter) + expect_no_lint("sprintf('%s', if (A) '' else y)", linter) }) local({ @@ -103,13 +102,13 @@ local({ patrick::with_parameters_test_that( "piping into sprintf works", { - expect_lint(paste("x", pipe, "sprintf(fmt = '%s')"), NULL, linter) + expect_no_lint(paste("x", pipe, "sprintf(fmt = '%s')"), linter) # no fmt= specified -> this is just 'sprintf("%s", "%s%s")', which won't lint - expect_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), NULL, linter) + expect_no_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), linter) expect_lint(paste("x", pipe, "sprintf(fmt = '%s%s')"), unused_fmt_msg, linter) # Cannot evaluate statically --> skip - expect_lint(paste("x", pipe, 'sprintf("a")'), NULL, linter) + expect_no_lint(paste("x", pipe, 'sprintf("a")'), linter) # Nested pipes expect_lint( paste("'%%sb'", pipe, "sprintf('%s')", pipe, "sprintf('a')"), diff --git a/tests/testthat/test-trailing_blank_lines_linter.R b/tests/testthat/test-trailing_blank_lines_linter.R index 9b12e5943..f6060e0ec 100644 --- a/tests/testthat/test-trailing_blank_lines_linter.R +++ b/tests/testthat/test-trailing_blank_lines_linter.R @@ -2,13 +2,13 @@ test_that("trailing_blank_lines_linter doesn't block allowed usages", { linter <- trailing_blank_lines_linter() - expect_lint("blah", NULL, linter) - expect_lint("blah <- 1 ", NULL, linter) - expect_lint("blah <- 1\nblah", NULL, linter) - expect_lint("blah <- 1\nblah\n \n blah", NULL, linter) + expect_no_lint("blah", linter) + expect_no_lint("blah <- 1 ", linter) + expect_no_lint("blah <- 1\nblah", linter) + expect_no_lint("blah <- 1\nblah\n \n blah", linter) tmp <- withr::local_tempfile(lines = "lm(y ~ x)") - expect_lint(file = tmp, checks = NULL, linters = linter) + expect_no_lint(file = tmp, linters = linter) }) test_that("trailing_blank_lines_linter detects disallowed usages", { diff --git a/tests/testthat/test-trailing_whitespace_linter.R b/tests/testthat/test-trailing_whitespace_linter.R index 514287e58..82e5e56bb 100644 --- a/tests/testthat/test-trailing_whitespace_linter.R +++ b/tests/testthat/test-trailing_whitespace_linter.R @@ -3,7 +3,7 @@ test_that("returns the correct linting", { linter <- trailing_whitespace_linter() lint_msg <- rex::rex("Remove trailing whitespace.") - expect_lint("blah", NULL, linter) + expect_no_lint("blah", linter) expect_lint( "blah <- 1 ", @@ -36,9 +36,8 @@ test_that("also handles completely empty lines per allow_empty_lines argument", trailing_whitespace_linter(allow_empty_lines = TRUE) ) - expect_lint( + expect_no_lint( "blah <- 1\n \n'hi'\na <- 2", - NULL, trailing_whitespace_linter(allow_empty_lines = TRUE) ) }) @@ -47,7 +46,7 @@ test_that("also handles trailing whitespace in string constants", { linter <- trailing_whitespace_linter() lint_msg <- rex::rex("Remove trailing whitespace.") - expect_lint("blah <- ' \n \n'", NULL, linter) + expect_no_lint("blah <- ' \n \n'", linter) # Don't exclude past the end of string expect_lint( "blah <- ' \n \n' ", diff --git a/tests/testthat/test-unnecessary_concatenation_linter.R b/tests/testthat/test-unnecessary_concatenation_linter.R index d8cae3f6b..1800f3490 100644 --- a/tests/testthat/test-unnecessary_concatenation_linter.R +++ b/tests/testthat/test-unnecessary_concatenation_linter.R @@ -1,13 +1,13 @@ test_that("unnecessary_concatenation_linter skips allowed usages", { linter <- unnecessary_concatenation_linter() - expect_lint("c(x)", NULL, linter) - expect_lint("c(1, 2)", NULL, linter) - expect_lint("c(x, recursive = TRUE)", NULL, linter) - expect_lint("c(1, recursive = FALSE)", NULL, linter) - expect_lint("lapply(1, c)", NULL, linter) - expect_lint("c(a = 1)", NULL, linter) - expect_lint("c('a' = 1)", NULL, linter) + expect_no_lint("c(x)", linter) + expect_no_lint("c(1, 2)", linter) + expect_no_lint("c(x, recursive = TRUE)", linter) + expect_no_lint("c(1, recursive = FALSE)", linter) + expect_no_lint("lapply(1, c)", linter) + expect_no_lint("c(a = 1)", linter) + expect_no_lint("c('a' = 1)", linter) }) test_that("unnecessary_concatenation_linter blocks disallowed usages", { @@ -54,7 +54,7 @@ local({ patrick::with_parameters_test_that( "Correctly handles concatenation within magrittr pipes", { - expect_lint(sprintf('"a" %s c("b")', pipe), NULL, linter) + expect_no_lint(sprintf('"a" %s c("b")', pipe), linter) expect_lint(sprintf('"a" %s c()', pipe), const_msg, linter) expect_lint(sprintf('"a" %s list("b", c())', pipe), no_arg_msg, linter) }, @@ -78,9 +78,9 @@ test_that("symbolic expressions are allowed, except by request", { linter_strict <- unnecessary_concatenation_linter(allow_single_expression = FALSE) lint_msg <- rex::rex("Remove unnecessary c() of a constant expression.") - expect_lint("c(alpha / 2)", NULL, linter) - expect_lint("c(paste0('.', 1:2))", NULL, linter) - expect_lint("c(DF[cond > 1, col])", NULL, linter) + expect_no_lint("c(alpha / 2)", linter) + expect_no_lint("c(paste0('.', 1:2))", linter) + expect_no_lint("c(DF[cond > 1, col])", linter) # allow_single_expression = FALSE turns both into lints expect_lint("c(alpha / 2)", lint_msg, linter_strict) @@ -99,24 +99,24 @@ test_that("sequences with : are linted whenever a constant is involved", { # this is slightly different if a,b are factors, in which case : does # something like interaction - expect_lint("c(a:b)", NULL, linter) + expect_no_lint("c(a:b)", linter) expect_lint("c(a:b)", expr_msg, linter_strict) - expect_lint("c(a:foo(b))", NULL, linter) + expect_no_lint("c(a:foo(b))", linter) expect_lint("c(a:foo(b))", expr_msg, linter_strict) }) test_that("c(...) does not lint under !allow_single_expression", { - expect_lint("c(...)", NULL, unnecessary_concatenation_linter(allow_single_expression = FALSE)) + expect_no_lint("c(...)", unnecessary_concatenation_linter(allow_single_expression = FALSE)) }) test_that("invalid allow_single_expression argument produce informative error messages", { expect_error( - expect_lint("c()", NULL, unnecessary_concatenation_linter(allow_single_expression = 1.0)), + expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = 1.0)), rex::rex("is.logical(allow_single_expression) is not TRUE") ) expect_error( - expect_lint("c()", NULL, unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))), + expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))), rex::rex("length(allow_single_expression) == 1L is not TRUE") ) }) From aa3e9300f158a73d1ae87d56e4b888030184081d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 10 Mar 2025 00:05:39 -0700 Subject: [PATCH 120/131] start the NEWS --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index af6d69e88..cbd1aeeb4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -31,6 +31,8 @@ * `object_usage_linter()` gains argument `interpret_extensions` to govern which false positive-prone common syntaxes should be checked for used objects (#1472, @MichaelChirico). Currently `"glue"` (renamed from earlier argument `interpret_glue`) and `"rlang"` are supported. The latter newly covers usage of the `.env` pronoun like `.env$key`, where `key` was previously missed as being a used variable. * `boolean_arithmetic_linter()` finds many more cases like `sum(x | y) == 0` where the total of a known-logical vector is compared to 0 (#1580, @MichaelChirico). * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico). +* General handling of logic around where linters can appear in code has been improved. In many cases, this is a tiny robustness fix for weird edge cases unlikely to be found in practice, but in others, this improves practical linter precision (reduced false positives and/or false negatives). The affected linters are: + + `brace_linter()` ### New linters From 18f32d328fb669b7ad458c36d41fed646ce47570 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 10 Mar 2025 16:26:08 +0000 Subject: [PATCH 121/131] cite all changed linters --- NEWS.md | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/NEWS.md b/NEWS.md index cbd1aeeb4..869bb5d7d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -33,6 +33,36 @@ * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico). * General handling of logic around where linters can appear in code has been improved. In many cases, this is a tiny robustness fix for weird edge cases unlikely to be found in practice, but in others, this improves practical linter precision (reduced false positives and/or false negatives). The affected linters are: + `brace_linter()` + + `coalesce_linter()` + + `comparison_negation_linter()` + + `conjunct_test_linter()` + + `empty_assignment_linter()` + + `fixed_regex_linter()` + + `if_switch_linter()` + + `ifelse_censor_linter()` + + `implicit_assignment_linter()` + + `length_test_linter()` + + `literal_coercion_linter()` + + `matrix_apply_linter()` + + `nzchar_linter()` + + `object_length_linter()` + + `object_usage_linter()` + + `object_usage_linter()` + + `outer_negation_linter()` + + `redundant_equals_linter()` + + `regex_subset_linter()` + + `seq_linter()` + + `sort_linter()` + + `sprintf_linter()` + + `string_boundary_linter()` + + `strings_as_factors_linter()` + + `unnecessary_concatenation_linter()` + + `unnecessary_lambda_linter()` + + `unnecessary_nesting_linter()` + + `unnecessary_placeholder_linter()` + + `unreachable_code_linter()` + + `vector_logic_linter()` + ### New linters From 2907c8623ba2fcc4e4bf9c75ab292b707c24db23 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 10 Mar 2025 17:18:54 +0000 Subject: [PATCH 122/131] annotate reference issues where noteworthy --- NEWS.md | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/NEWS.md b/NEWS.md index 869bb5d7d..ec31a1bce 100644 --- a/NEWS.md +++ b/NEWS.md @@ -31,37 +31,37 @@ * `object_usage_linter()` gains argument `interpret_extensions` to govern which false positive-prone common syntaxes should be checked for used objects (#1472, @MichaelChirico). Currently `"glue"` (renamed from earlier argument `interpret_glue`) and `"rlang"` are supported. The latter newly covers usage of the `.env` pronoun like `.env$key`, where `key` was previously missed as being a used variable. * `boolean_arithmetic_linter()` finds many more cases like `sum(x | y) == 0` where the total of a known-logical vector is compared to 0 (#1580, @MichaelChirico). * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico). -* General handling of logic around where linters can appear in code has been improved. In many cases, this is a tiny robustness fix for weird edge cases unlikely to be found in practice, but in others, this improves practical linter precision (reduced false positives and/or false negatives). The affected linters are: +* General handling of logic around where linters can appear in code has been improved (#2822, @MichaelChirico). In many cases, this is a tiny robustness fix for weird edge cases unlikely to be found in practice, but in others, this improves practical linter precision (reduced false positives and/or false negatives). The affected linters (with annotations for changes noteworthy enough to have gotten a dedicated bug) are: + `brace_linter()` + `coalesce_linter()` - + `comparison_negation_linter()` - + `conjunct_test_linter()` + + `comparison_negation_linter()` #2826 + + `conjunct_test_linter()` #2827 + `empty_assignment_linter()` - + `fixed_regex_linter()` + + `fixed_regex_linter()` #2827 + `if_switch_linter()` - + `ifelse_censor_linter()` + + `ifelse_censor_linter()` #2826 + `implicit_assignment_linter()` + `length_test_linter()` - + `literal_coercion_linter()` - + `matrix_apply_linter()` - + `nzchar_linter()` - + `object_length_linter()` + + `literal_coercion_linter()` #2824 + + `matrix_apply_linter()` #2825 + + `nzchar_linter()` #2826 + + `object_length_linter()` #2827 + + `object_name_linter()` #2827 + `object_usage_linter()` - + `object_usage_linter()` - + `outer_negation_linter()` + + `outer_negation_linter()` #2827 + `redundant_equals_linter()` + `regex_subset_linter()` + `seq_linter()` + `sort_linter()` - + `sprintf_linter()` + + `sprintf_linter()` #2827 + `string_boundary_linter()` + `strings_as_factors_linter()` - + `unnecessary_concatenation_linter()` - + `unnecessary_lambda_linter()` - + `unnecessary_nesting_linter()` + + `unnecessary_concatenation_linter()` #2827 + + `unnecessary_lambda_linter()` #2827 + + `unnecessary_nesting_linter()` #2827 + `unnecessary_placeholder_linter()` - + `unreachable_code_linter()` - + `vector_logic_linter()` + + `unreachable_code_linter()` #2827 + + `vector_logic_linter()` #2826 ### New linters From a42bda56bcafdec2475da17fafc3822dfc5c80c7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 10 Mar 2025 17:20:23 +0000 Subject: [PATCH 123/131] cleanup --- NEWS.md | 2 +- tests/testthat/test-unreachable_code_linter.R | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index ec31a1bce..39817f20b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -31,7 +31,7 @@ * `object_usage_linter()` gains argument `interpret_extensions` to govern which false positive-prone common syntaxes should be checked for used objects (#1472, @MichaelChirico). Currently `"glue"` (renamed from earlier argument `interpret_glue`) and `"rlang"` are supported. The latter newly covers usage of the `.env` pronoun like `.env$key`, where `key` was previously missed as being a used variable. * `boolean_arithmetic_linter()` finds many more cases like `sum(x | y) == 0` where the total of a known-logical vector is compared to 0 (#1580, @MichaelChirico). * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico). -* General handling of logic around where linters can appear in code has been improved (#2822, @MichaelChirico). In many cases, this is a tiny robustness fix for weird edge cases unlikely to be found in practice, but in others, this improves practical linter precision (reduced false positives and/or false negatives). The affected linters (with annotations for changes noteworthy enough to have gotten a dedicated bug) are: +* General handling of logic around where comments can appear in code has been improved (#2822, @MichaelChirico). In many cases, this is a tiny robustness fix for weird edge cases unlikely to be found in practice, but in others, this improves practical linter precision (reduced false positives and/or false negatives). The affected linters (with annotations for changes noteworthy enough to have gotten a dedicated bug) are: + `brace_linter()` + `coalesce_linter()` + `comparison_negation_linter()` #2826 diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index eb60d2bee..2a9cf20d4 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -102,7 +102,6 @@ test_that("unreachable_code_linter works in sub expressions", { linter ) - #debug(linter) expect_lint( trim_some(" foo <- function(bar) { From ee9b446e0686837c98c856d405fa81d81713d768 Mon Sep 17 00:00:00 2001 From: AshesITR Date: Thu, 24 Jul 2025 22:20:27 +0200 Subject: [PATCH 124/131] remove empty line --- NEWS.md | 1 - 1 file changed, 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index d3df2e442..e49dc2916 100644 --- a/NEWS.md +++ b/NEWS.md @@ -47,7 +47,6 @@ * `object_usage_linter()` lints missing packages that may cause false positives (#2872, @AshesITR) * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico). - ### New linters * `download_file_linter()` encourages the use of `mode = "wb"` (or `mode = "ab"`) when using `download.file()`, rather than `mode = "w"` or `mode = "a"`, as the latter can produce broken From 50b88328282960f1d6a399668bf60fd8cb102bbc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 24 Jul 2025 13:23:06 -0700 Subject: [PATCH 125/131] revert --- tests/testthat/test-pipe_continuation_linter.R | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-pipe_continuation_linter.R b/tests/testthat/test-pipe_continuation_linter.R index 566848505..89633f6b2 100644 --- a/tests/testthat/test-pipe_continuation_linter.R +++ b/tests/testthat/test-pipe_continuation_linter.R @@ -158,14 +158,12 @@ local({ test_data <- diamonds %>% head(10) %>% tail(5) }) "), "three inside test_that()", - trim_some( - " - { - x <- a %>% b %>% c - y <- c %>% b %>% a - } - " - ), "two different single-line pipelines", + trim_some(" + { + x <- a %>% b %>% c + y <- c %>% b %>% a + } + "), "two different single-line pipelines", trim_some(" my_fun <- function() { a %>% From 4f95e406525ec1f96e35af795f2ec7e157b7e260 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 24 Jul 2025 13:25:36 -0700 Subject: [PATCH 126/131] revert --- tests/testthat/test-commented_code_linter.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-commented_code_linter.R b/tests/testthat/test-commented_code_linter.R index 8809335de..80143631f 100644 --- a/tests/testthat/test-commented_code_linter.R +++ b/tests/testthat/test-commented_code_linter.R @@ -92,13 +92,15 @@ test_that("commented_code_linter can detect operators in comments and lint corre expect_no_lint(paste("# something like i", op, "1", collapse = ""), linter) expect_lint(paste("# i", op, "1", collapse = ""), lint_msg, linter) } +}) +test_that("commented_code_linter can detect operators in comments and lint correctly", { skip_if_not_r_version("4.1.0") expect_lint( "# 1:3 |> sum()", rex::rex("Remove commented code."), - linter + commented_code_linter() ) }) From ebab6048e64da55b728164206a2b531ef4d71270 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 24 Jul 2025 13:26:49 -0700 Subject: [PATCH 127/131] revert --- tests/testthat/test-pipe_consistency_linter.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-pipe_consistency_linter.R b/tests/testthat/test-pipe_consistency_linter.R index 97243fae4..2197fa329 100644 --- a/tests/testthat/test-pipe_consistency_linter.R +++ b/tests/testthat/test-pipe_consistency_linter.R @@ -3,7 +3,6 @@ test_that("pipe_consistency skips allowed usage", { skip_if_not_r_version("4.1.0") linter <- pipe_consistency_linter() - expect_no_lint("1:3 %>% mean() %>% as.character()", linter) expect_no_lint("1:3 |> mean() |> as.character()", linter) # With no pipes expect_no_lint("x <- 1:5", linter) @@ -135,7 +134,10 @@ test_that("pipe_consistency_linter works with %>% argument", { linter ) - expect_no_lint("1:3 %>% mean() %>% as.character()", linter) + expect_no_lint( + "1:3 %>% mean() %>% as.character()", + linter + ) expect_lint( trim_some(" From 2a1ebe27b2686dcf87cd1c8c596a9135a42364fc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 24 Jul 2025 13:33:06 -0700 Subject: [PATCH 128/131] failed merge? --- tests/testthat/test-object_usage_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index 66d786c70..7efc4025b 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -643,7 +643,7 @@ test_that("respects `skip_with` argument for `with()` expressions", { }) test_that("missing libraries don't cause issue", { - expect_no_lint( + expect_lint( trim_some(" library(a.a.a.z.z.z) foo <- function() { From 4870ecb675a97aab80e61fd8b58f86d1446ecb70 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 24 Jul 2025 13:42:55 -0700 Subject: [PATCH 129/131] narrow line --- R/function_left_parentheses_linter.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/function_left_parentheses_linter.R b/R/function_left_parentheses_linter.R index de0d9a41d..f3e4af5bf 100644 --- a/R/function_left_parentheses_linter.R +++ b/R/function_left_parentheses_linter.R @@ -47,7 +47,8 @@ function_left_parentheses_linter <- function() { # nolint: object_length. # because it allows the xpath to be the same for both FUNCTION and SYMBOL_FUNCTION_CALL. # Further, write 4 separate XPaths because the 'range_end_xpath' differs for these two nodes. bad_line_fun_xpath <- "(//FUNCTION | //OP-LAMBDA)[@line1 != following-sibling::OP-LEFT-PAREN/@line1]" - bad_line_call_xpath <- "(//SYMBOL_FUNCTION_CALL | //SLOT)[@line1 != parent::expr/following-sibling::OP-LEFT-PAREN/@line1]" + bad_line_call_xpath <- + "(//SYMBOL_FUNCTION_CALL | //SLOT)[@line1 != parent::expr/following-sibling::OP-LEFT-PAREN/@line1]" bad_col_fun_xpath <- "(//FUNCTION | //OP-LAMBDA)[ @line1 = following-sibling::OP-LEFT-PAREN/@line1 and @col2 != following-sibling::OP-LEFT-PAREN/@col1 - 1 From 83aa12eaf58d03a5341184a2ce86e8d7da8cb8f6 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 24 Jul 2025 13:43:22 -0700 Subject: [PATCH 130/131] trailing ws --- tests/testthat/test-is_numeric_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-is_numeric_linter.R b/tests/testthat/test-is_numeric_linter.R index d0026e1f7..aa3093775 100644 --- a/tests/testthat/test-is_numeric_linter.R +++ b/tests/testthat/test-is_numeric_linter.R @@ -30,7 +30,7 @@ test_that("is_numeric_linter blocks disallowed usages involving ||", { # identical expressions match too expect_lint( # nofuzz "is.integer(DT$x) || is.numeric(DT$x)", - lint_msg, + lint_msg, linter ) From 2392fa40450860106eae55f80627c566662e4339 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 21:27:46 +0000 Subject: [PATCH 131/131] missed expect_comparison_linter --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 8df129fe4..f8cab179d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -53,6 +53,7 @@ + `comparison_negation_linter()` #2826 + `conjunct_test_linter()` #2827 + `empty_assignment_linter()` + + `expect_comparison_linter()` + `fixed_regex_linter()` #2827 + `if_switch_linter()` + `ifelse_censor_linter()` #2826