From 00aaf53562350147ffbb0f65f657f0eb77671143 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 21 Jun 2025 14:21:29 -0700 Subject: [PATCH 01/23] lint(text=) finds local settings again --- NEWS.md | 2 +- R/lint.R | 3 +-- R/settings.R | 1 + tests/testthat/test-lint.R | 8 ++++++++ 4 files changed, 11 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 5412986c5..dd4888b64 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,7 +16,7 @@ ## Bug fixes * `Lint()`, and thus all linters, ensures that the returned object's `message` attribute is consistently a simple character string (and not, for example, an object of class `"glue"`; #2740, @MichaelChirico). -* Files with encoding inferred from settings read more robustly under `lint(parse_settings = TRUE)` (#2803, @MichaelChirico). +* Files with encoding inferred from settings read more robustly under `lint(parse_settings = TRUE)` (#2803, @MichaelChirico). Thanks also to @bastistician for detecting a regression caused by the initial change for users of Emacs (#2847). ## Changes to default linters diff --git a/R/lint.R b/R/lint.R index 0f09ee524..460f60146 100644 --- a/R/lint.R +++ b/R/lint.R @@ -45,9 +45,8 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = needs_tempfile <- missing(filename) || re_matches(filename, rex(newline)) inline_data <- !is.null(text) || needs_tempfile - parse_settings <- !inline_data && isTRUE(parse_settings) - if (parse_settings) { + if (isTRUE(parse_settings)) { read_settings(filename) on.exit(reset_settings(), add = TRUE) } diff --git a/R/settings.R b/R/settings.R index 48ffcf602..0458df6fa 100644 --- a/R/settings.R +++ b/R/settings.R @@ -65,6 +65,7 @@ read_settings <- function(filename, call = parent.frame()) { reset_settings() + if (missing(filename)) filename <- "./any_local_file" config_file <- find_config(filename) default_encoding <- find_default_encoding(filename) if (!is.null(default_encoding)) { diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 57da887f2..8e613feb0 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -233,3 +233,11 @@ test_that("Linter() input is validated", { test_that("typo in argument name gives helpful error", { expect_error(lint("xxx", litners = identity), "Found unknown arguments in `...`: `litners`") }) + +test_that("settings are picked up under lint(text=)", { + .lintr <- withr::local_tempfile(lines = "linters: list(assignment_linter())") + withr::local_options(lintr.linter_file = .lintr) + + # lint '=', but not the operator spacing + expect_length(lint(text = "a=1"), 1L) +}) From a257f09c41f2c0e9b2b110009270a2c4e06a2111 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 21 Jun 2025 14:27:32 -0700 Subject: [PATCH 02/23] Add a comment --- R/settings.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/settings.R b/R/settings.R index 0458df6fa..699a2be83 100644 --- a/R/settings.R +++ b/R/settings.R @@ -65,6 +65,7 @@ read_settings <- function(filename, call = parent.frame()) { reset_settings() + # doing lint(text=) should read settings from the current directory, required e.g. for Emacs if (missing(filename)) filename <- "./any_local_file" config_file <- find_config(filename) default_encoding <- find_default_encoding(filename) From b50e4e269064099ed83e3efa4cad50bad3bec2b3 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 21 Jun 2025 14:28:36 -0700 Subject: [PATCH 03/23] Annotate issue # too --- R/settings.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/settings.R b/R/settings.R index 699a2be83..c106ffbd4 100644 --- a/R/settings.R +++ b/R/settings.R @@ -65,7 +65,7 @@ read_settings <- function(filename, call = parent.frame()) { reset_settings() - # doing lint(text=) should read settings from the current directory, required e.g. for Emacs + # doing lint(text=) should read settings from the current directory, required e.g. for Emacs, #2847 if (missing(filename)) filename <- "./any_local_file" config_file <- find_config(filename) default_encoding <- find_default_encoding(filename) From 159234d31d17d658935cbb6cccc4a7e0967ffac4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 21 Jun 2025 15:48:11 -0700 Subject: [PATCH 04/23] explicitly disable cyclocomp_linter under "hard mode" --- .lintr | 1 + 1 file changed, 1 insertion(+) diff --git a/.lintr b/.lintr index 7d89de3fd..89ba36d38 100644 --- a/.lintr +++ b/.lintr @@ -38,6 +38,7 @@ linters: all_linters( `<<-` = NULL )), unnecessary_concatenation_linter(allow_single_expression = FALSE), + cyclocomp_linter = if (requireNamespace("cyclocomp", quietly = TRUE)) cyclocomp_linter(), absolute_path_linter = NULL, library_call_linter = NULL, nonportable_path_linter = NULL, From af4d66b9cb29f2c1a21c8b2d33f2f23a0e722f37 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 21 Jun 2025 15:51:10 -0700 Subject: [PATCH 05/23] also need explicit parse_settings=FALSE in cyclocomp test --- tests/testthat/test-cyclocomp_linter.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-cyclocomp_linter.R b/tests/testthat/test-cyclocomp_linter.R index 391973c2f..37f17bb0d 100644 --- a/tests/testthat/test-cyclocomp_linter.R +++ b/tests/testthat/test-cyclocomp_linter.R @@ -69,5 +69,9 @@ test_that("a null linter is returned, with warning, if cyclocomp is unavailable" linter <- cyclocomp_linter(1L) }) - expect_error(lint(text = "if (TRUE) 1 else 2", linters = linter), "disabled", fixed = TRUE) + expect_error( + lint(text = "if (TRUE) 1 else 2", linters = linter, parse_settings = FALSE), + "disabled", + fixed = TRUE + ) }) From 3043aa161b83f38d599680ccd189b28eb3b6197d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 21 Jun 2025 18:30:43 -0700 Subject: [PATCH 06/23] More explicit parse_settings=FALSE --- tests/testthat/test-backport_linter.R | 2 +- tests/testthat/test-get_source_expressions.R | 2 +- tests/testthat/test-lint.R | 10 +++++----- tests/testthat/test-methods.R | 4 ++-- tests/testthat/test-spaces_left_parentheses_linter.R | 6 +++++- 5 files changed, 14 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-backport_linter.R b/tests/testthat/test-backport_linter.R index e445c4404..5404d39bb 100644 --- a/tests/testthat/test-backport_linter.R +++ b/tests/testthat/test-backport_linter.R @@ -1,6 +1,6 @@ test_that("backport_linter produces error when R version misspecified", { expect_error( - lint(text = "numToBits(2)", linters = backport_linter(420L)), + lint(text = "numToBits(2)", linters = backport_linter(420L), parse_settings = FALSE), "`r_version` must be an R version number" ) }) diff --git a/tests/testthat/test-get_source_expressions.R b/tests/testthat/test-get_source_expressions.R index eeaff905b..775662f1c 100644 --- a/tests/testthat/test-get_source_expressions.R +++ b/tests/testthat/test-get_source_expressions.R @@ -107,7 +107,7 @@ test_that("Multi-byte character truncated by parser is ignored", { test_that("Can read non UTF-8 file", { proj_dir <- test_path("dummy_projects", "project") withr::local_dir(proj_dir) - expect_no_lint(file = "cp1252.R", linters = list()) + expect_no_lint(file = "cp1252.R", linters = list(), parse_settings = FALSE) }) test_that("Warns if encoding is misspecified, Pt. 1", { diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 8e613feb0..bb5b5bc13 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -121,13 +121,13 @@ test_that("lint() results from file or text should be consistent", { file <- normalize_path(file) lint_from_file <- lint(file, linters = linters) - lint_from_lines <- lint(linters = linters, text = lines) - lint_from_text <- lint(linters = linters, text = text) + lint_from_lines <- lint(linters = linters, text = lines, parse_settings = FALSE) + lint_from_text <- lint(linters = linters, text = text, parse_settings = FALSE) # Remove file before linting to ensure that lint works and do not # assume that file exists when both filename and text are supplied. expect_identical(unlink(file), 0L) - lint_from_text2 <- lint(file, linters = linters, text = text) + lint_from_text2 <- lint(file, linters = linters, text = text, parse_settings = FALSE) expect_length(lint_from_file, 2L) expect_length(lint_from_lines, 2L) @@ -205,12 +205,12 @@ test_that("old compatibility usage errors", { ) expect_error( - lint("a <- 1\n", linters = function(two, arguments) NULL), + lint("a <- 1\n", linters = function(two, arguments) NULL, parse_settings = FALSE), error_msg ) expect_error( - lint("a <- 1\n", linters = "equals_na_linter"), + lint("a <- 1\n", linters = "equals_na_linter", parse_settings = FALSE), error_msg ) }) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index 91a04cafc..452311280 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -69,14 +69,14 @@ test_that("as.data.frame.lints", { }) test_that("summary.lints() works (no lints)", { - no_lints <- lint("x <- 1\n", linters = assignment_linter()) + no_lints <- lint("x <- 1\n", linters = assignment_linter(), parse_settings = FALSE) no_lint_summary <- summary(no_lints) expect_s3_class(no_lint_summary, "data.frame") expect_identical(nrow(no_lint_summary), 0L) }) test_that("summary.lints() works (lints found)", { - has_lints <- lint("x = 1\n", linters = assignment_linter()) + has_lints <- lint("x = 1\n", linters = assignment_linter(), parse_settings = FALSE) has_lint_summary <- summary(has_lints) expect_s3_class(has_lint_summary, "data.frame") diff --git a/tests/testthat/test-spaces_left_parentheses_linter.R b/tests/testthat/test-spaces_left_parentheses_linter.R index ce854828c..976bf0f00 100644 --- a/tests/testthat/test-spaces_left_parentheses_linter.R +++ b/tests/testthat/test-spaces_left_parentheses_linter.R @@ -93,7 +93,11 @@ test_that("doesn't produce a warning", { } ") - expect_no_warning(lint(text = complex_lines, linters = spaces_left_parentheses_linter())) + expect_no_warning(lint( + text = complex_lines, + linters = spaces_left_parentheses_linter(), + parse_settings = FALSE + )) }) test_that("lints vectorize", { From 07d31f3b4a1d1f84403516d08253ad2b7452d280 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 21 Jun 2025 18:35:27 -0700 Subject: [PATCH 07/23] must parse .Rproj settings --- tests/testthat/test-get_source_expressions.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-get_source_expressions.R b/tests/testthat/test-get_source_expressions.R index 775662f1c..eeaff905b 100644 --- a/tests/testthat/test-get_source_expressions.R +++ b/tests/testthat/test-get_source_expressions.R @@ -107,7 +107,7 @@ test_that("Multi-byte character truncated by parser is ignored", { test_that("Can read non UTF-8 file", { proj_dir <- test_path("dummy_projects", "project") withr::local_dir(proj_dir) - expect_no_lint(file = "cp1252.R", linters = list(), parse_settings = FALSE) + expect_no_lint(file = "cp1252.R", linters = list()) }) test_that("Warns if encoding is misspecified, Pt. 1", { From 83125b3fcc005896e77fa5833771005669de8069 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 08:19:06 -0700 Subject: [PATCH 08/23] revert config edit --- .lintr | 1 - 1 file changed, 1 deletion(-) diff --git a/.lintr b/.lintr index 89ba36d38..7d89de3fd 100644 --- a/.lintr +++ b/.lintr @@ -38,7 +38,6 @@ linters: all_linters( `<<-` = NULL )), unnecessary_concatenation_linter(allow_single_expression = FALSE), - cyclocomp_linter = if (requireNamespace("cyclocomp", quietly = TRUE)) cyclocomp_linter(), absolute_path_linter = NULL, library_call_linter = NULL, nonportable_path_linter = NULL, From 7deac2bc406560608c8b1b22489d671190df2eb7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 08:50:48 -0700 Subject: [PATCH 09/23] revert --- R/settings.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/settings.R b/R/settings.R index c106ffbd4..48ffcf602 100644 --- a/R/settings.R +++ b/R/settings.R @@ -65,8 +65,6 @@ read_settings <- function(filename, call = parent.frame()) { reset_settings() - # doing lint(text=) should read settings from the current directory, required e.g. for Emacs, #2847 - if (missing(filename)) filename <- "./any_local_file" config_file <- find_config(filename) default_encoding <- find_default_encoding(filename) if (!is.null(default_encoding)) { From 05f8fbc9f025c07b4f9cf59ece0a2993da12f71d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 08:51:20 -0700 Subject: [PATCH 10/23] revert --- tests/testthat/test-lint.R | 8 -------- 1 file changed, 8 deletions(-) diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 6b91af8f2..9bdfb305f 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -278,11 +278,3 @@ test_that("gitlab_output() writes expected report", { )) ) }) - -test_that("settings are picked up under lint(text=)", { - .lintr <- withr::local_tempfile(lines = "linters: list(assignment_linter())") - withr::local_options(lintr.linter_file = .lintr) - - # lint '=', but not the operator spacing - expect_length(lint(text = "a=1"), 1L) -}) From f0f4a70dd41d0836f981cbfe5de63923104c6ddf Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 16:20:18 +0000 Subject: [PATCH 11/23] Revert "revert" This reverts commit 7deac2bc406560608c8b1b22489d671190df2eb7. --- R/settings.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/settings.R b/R/settings.R index 48ffcf602..c106ffbd4 100644 --- a/R/settings.R +++ b/R/settings.R @@ -65,6 +65,8 @@ read_settings <- function(filename, call = parent.frame()) { reset_settings() + # doing lint(text=) should read settings from the current directory, required e.g. for Emacs, #2847 + if (missing(filename)) filename <- "./any_local_file" config_file <- find_config(filename) default_encoding <- find_default_encoding(filename) if (!is.null(default_encoding)) { From 9fe5af5780c4dd5c7584e2e0160d34f6a49c4824 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 09:38:30 -0700 Subject: [PATCH 12/23] amend .lintr to avoid cyclocomp here only --- .github/workflows/R-CMD-check-hard.yaml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/.github/workflows/R-CMD-check-hard.yaml b/.github/workflows/R-CMD-check-hard.yaml index 977807d3c..ccae691a2 100644 --- a/.github/workflows/R-CMD-check-hard.yaml +++ b/.github/workflows/R-CMD-check-hard.yaml @@ -61,6 +61,16 @@ jobs: any::withr needs: check + - name: disable-suggested-linters + run: | + config <- read.dcf(".lintr") + linters <- as.list(str2lang(config[, "linters"])) + linters = as.call(c(linters, list(cyclocomp_linter = NULL))) + config[, "linters"] <- paste(format(linters), collapse = "\n") + write.dcf(config, ".lintr") + + shell: Rscript {0} + - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true From 90b9d7bf33c1bb9c843065e37ef8fd19ffe99009 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 12:47:44 -0700 Subject: [PATCH 13/23] mention breaking change --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 8e1ede73d..6959d3a87 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,7 @@ + Linters `closed_curly_linter()`, `open_curly_linter()`, `paren_brace_linter()`, and `semicolon_terminator_linter()`. * Argument `interpret_glue` to `object_usage_linter()` is deprecated in favor of the more general `interpret_extensions`, in which `"glue"` is present by default (#1472, @MichaelChirico). See the description below. * The default for `pipe_consistency_linter()` is changed from `"auto"` (require one pipe style, either magrittr or native) to `"|>"` (R native pipe required) to coincide with the same change in the Tidyverse Style Guide (#2707, @MichaelChirico). +* `lint()` no longer picks up settings automatically in _ad hoc_ invocations like `lint("text\n")` or `lint(text = "str")`. You should set `parse_settings=TRUE` to force settings to be read. ## Bug fixes From a0401cc01793cafd7b47ad7254f09dc674c66e49 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 19:50:13 +0000 Subject: [PATCH 14/23] full revert --- R/lint.R | 3 ++- R/settings.R | 2 -- tests/testthat/test-backport_linter.R | 2 +- tests/testthat/test-cyclocomp_linter.R | 6 +----- tests/testthat/test-lint.R | 11 ++++++----- tests/testthat/test-methods.R | 4 ++-- tests/testthat/test-spaces_left_parentheses_linter.R | 6 +----- 7 files changed, 13 insertions(+), 21 deletions(-) diff --git a/R/lint.R b/R/lint.R index 37c44621e..362336407 100644 --- a/R/lint.R +++ b/R/lint.R @@ -45,8 +45,9 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = needs_tempfile <- missing(filename) || re_matches(filename, rex(newline)) inline_data <- !is.null(text) || needs_tempfile + parse_settings <- !inline_data && isTRUE(parse_settings) - if (isTRUE(parse_settings)) { + if (parse_settings) { read_settings(filename) on.exit(reset_settings(), add = TRUE) } diff --git a/R/settings.R b/R/settings.R index c106ffbd4..48ffcf602 100644 --- a/R/settings.R +++ b/R/settings.R @@ -65,8 +65,6 @@ read_settings <- function(filename, call = parent.frame()) { reset_settings() - # doing lint(text=) should read settings from the current directory, required e.g. for Emacs, #2847 - if (missing(filename)) filename <- "./any_local_file" config_file <- find_config(filename) default_encoding <- find_default_encoding(filename) if (!is.null(default_encoding)) { diff --git a/tests/testthat/test-backport_linter.R b/tests/testthat/test-backport_linter.R index 3e1034606..0025f4b3b 100644 --- a/tests/testthat/test-backport_linter.R +++ b/tests/testthat/test-backport_linter.R @@ -1,6 +1,6 @@ test_that("backport_linter produces error when R version misspecified", { expect_error( - lint(text = "numToBits(2)", linters = backport_linter(420L), parse_settings = FALSE), + lint(text = "numToBits(2)", linters = backport_linter(420L)), "`r_version` must be an R version number" ) }) diff --git a/tests/testthat/test-cyclocomp_linter.R b/tests/testthat/test-cyclocomp_linter.R index 37f17bb0d..391973c2f 100644 --- a/tests/testthat/test-cyclocomp_linter.R +++ b/tests/testthat/test-cyclocomp_linter.R @@ -69,9 +69,5 @@ test_that("a null linter is returned, with warning, if cyclocomp is unavailable" linter <- cyclocomp_linter(1L) }) - expect_error( - lint(text = "if (TRUE) 1 else 2", linters = linter, parse_settings = FALSE), - "disabled", - fixed = TRUE - ) + expect_error(lint(text = "if (TRUE) 1 else 2", linters = linter), "disabled", fixed = TRUE) }) diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 9bdfb305f..983c5e0c4 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -121,13 +121,13 @@ test_that("lint() results from file or text should be consistent", { file <- normalize_path(file) lint_from_file <- lint(file, linters = linters) - lint_from_lines <- lint(linters = linters, text = lines, parse_settings = FALSE) - lint_from_text <- lint(linters = linters, text = text, parse_settings = FALSE) + lint_from_lines <- lint(linters = linters, text = lines) + lint_from_text <- lint(linters = linters, text = text) # Remove file before linting to ensure that lint works and do not # assume that file exists when both filename and text are supplied. expect_identical(unlink(file), 0L) - lint_from_text2 <- lint(file, linters = linters, text = text, parse_settings = FALSE) + lint_from_text2 <- lint(file, linters = linters, text = text) expect_length(lint_from_file, 2L) expect_length(lint_from_lines, 2L) @@ -205,12 +205,12 @@ test_that("old compatibility usage errors", { ) expect_error( - lint("a <- 1\n", linters = function(two, arguments) NULL, parse_settings = FALSE), + lint("a <- 1\n", linters = function(two, arguments) NULL), error_msg ) expect_error( - lint("a <- 1\n", linters = "equals_na_linter", parse_settings = FALSE), + lint("a <- 1\n", linters = "equals_na_linter"), error_msg ) }) @@ -234,6 +234,7 @@ test_that("typo in argument name gives helpful error", { expect_error(lint("xxx", litners = identity), "Found unknown arguments in `...`: `litners`") }) + test_that("gitlab_output() writes expected report", { skip_if_not_installed("jsonlite") diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index e7db32570..f8aef14e1 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -49,14 +49,14 @@ test_that("as.data.frame.lints", { }) test_that("summary.lints() works (no lints)", { - no_lints <- lint("x <- 1\n", linters = assignment_linter(), parse_settings = FALSE) + no_lints <- lint("x <- 1\n", linters = assignment_linter()) no_lint_summary <- summary(no_lints) expect_s3_class(no_lint_summary, "data.frame") expect_identical(nrow(no_lint_summary), 0L) }) test_that("summary.lints() works (lints found)", { - has_lints <- lint("x = 1\n", linters = assignment_linter(), parse_settings = FALSE) + has_lints <- lint("x = 1\n", linters = assignment_linter()) has_lint_summary <- summary(has_lints) expect_s3_class(has_lint_summary, "data.frame") diff --git a/tests/testthat/test-spaces_left_parentheses_linter.R b/tests/testthat/test-spaces_left_parentheses_linter.R index 976bf0f00..ce854828c 100644 --- a/tests/testthat/test-spaces_left_parentheses_linter.R +++ b/tests/testthat/test-spaces_left_parentheses_linter.R @@ -93,11 +93,7 @@ test_that("doesn't produce a warning", { } ") - expect_no_warning(lint( - text = complex_lines, - linters = spaces_left_parentheses_linter(), - parse_settings = FALSE - )) + expect_no_warning(lint(text = complex_lines, linters = spaces_left_parentheses_linter())) }) test_that("lints vectorize", { From f3337be573be8f8df176bb820c6a1d5e1b81213b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 19:51:36 +0000 Subject: [PATCH 15/23] only edit NEWS --- .github/workflows/R-CMD-check-hard.yaml | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/.github/workflows/R-CMD-check-hard.yaml b/.github/workflows/R-CMD-check-hard.yaml index ccae691a2..977807d3c 100644 --- a/.github/workflows/R-CMD-check-hard.yaml +++ b/.github/workflows/R-CMD-check-hard.yaml @@ -61,16 +61,6 @@ jobs: any::withr needs: check - - name: disable-suggested-linters - run: | - config <- read.dcf(".lintr") - linters <- as.list(str2lang(config[, "linters"])) - linters = as.call(c(linters, list(cyclocomp_linter = NULL))) - config[, "linters"] <- paste(format(linters), collapse = "\n") - write.dcf(config, ".lintr") - - shell: Rscript {0} - - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true From 0f028e6ba4fce2dc09e421f39ea5452f6a44e2bb Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 21:49:13 +0000 Subject: [PATCH 16/23] restore once more :) --- R/lint.R | 3 +-- R/settings.R | 2 ++ tests/testthat/test-lint.R | 13 +++++++++++++ 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/R/lint.R b/R/lint.R index 362336407..37c44621e 100644 --- a/R/lint.R +++ b/R/lint.R @@ -45,9 +45,8 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = needs_tempfile <- missing(filename) || re_matches(filename, rex(newline)) inline_data <- !is.null(text) || needs_tempfile - parse_settings <- !inline_data && isTRUE(parse_settings) - if (parse_settings) { + if (isTRUE(parse_settings)) { read_settings(filename) on.exit(reset_settings(), add = TRUE) } diff --git a/R/settings.R b/R/settings.R index 48ffcf602..c106ffbd4 100644 --- a/R/settings.R +++ b/R/settings.R @@ -65,6 +65,8 @@ read_settings <- function(filename, call = parent.frame()) { reset_settings() + # doing lint(text=) should read settings from the current directory, required e.g. for Emacs, #2847 + if (missing(filename)) filename <- "./any_local_file" config_file <- find_config(filename) default_encoding <- find_default_encoding(filename) if (!is.null(default_encoding)) { diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 983c5e0c4..d81e877a1 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -279,3 +279,16 @@ test_that("gitlab_output() writes expected report", { )) ) }) + +test_that("explicit parse_settings=TRUE works for inline data", { + withr::local_dir(tempdir()) + .lintr <- withr::local_tempfile(lines = "linters: list(assignment_linter())") + withr::local_options(list(lintr.linter_file = .lintr)) + + lint_str <- "a=1\n" # assignment lints, but not infix_spaces + foo.R <- withr::local_tempfile(lines = lint_str) + + expect_length(lint(foo.R, parse_settings = TRUE), 1L) + expect_length(lint(text = lint_str, parse_settings = TRUE), 1L) + expect_length(lint(lint_str, parse_settings = TRUE), 1L) +}) From 90f9687a75924bc0f8ca55638cda3741657a5ad4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 14:58:15 -0700 Subject: [PATCH 17/23] delint --- tests/testthat/test-lint.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index d81e877a1..562e4d1cb 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -286,9 +286,9 @@ test_that("explicit parse_settings=TRUE works for inline data", { withr::local_options(list(lintr.linter_file = .lintr)) lint_str <- "a=1\n" # assignment lints, but not infix_spaces - foo.R <- withr::local_tempfile(lines = lint_str) + foo <- withr::local_tempfile(lines = lint_str) - expect_length(lint(foo.R, parse_settings = TRUE), 1L) + expect_length(lint(foo, parse_settings = TRUE), 1L) expect_length(lint(text = lint_str, parse_settings = TRUE), 1L) expect_length(lint(lint_str, parse_settings = TRUE), 1L) }) From aa8e5fd809ad7be5cf54e64355606215f4534524 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 22:41:12 +0000 Subject: [PATCH 18/23] dont parse when missing parse_settings --- R/lint.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/lint.R b/R/lint.R index 37c44621e..aaec52c87 100644 --- a/R/lint.R +++ b/R/lint.R @@ -45,8 +45,9 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = needs_tempfile <- missing(filename) || re_matches(filename, rex(newline)) inline_data <- !is.null(text) || needs_tempfile + parse_settings <- (!inline_data || !missing(parse_settings)) && isTRUE(parse_settings) - if (isTRUE(parse_settings)) { + if (parse_settings) { read_settings(filename) on.exit(reset_settings(), add = TRUE) } From fa8e9eb2a199852ac76388917d7bfbe10aedccd2 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 22:42:42 +0000 Subject: [PATCH 19/23] another test --- tests/testthat/test-lint.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 562e4d1cb..e47fbe339 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -291,4 +291,7 @@ test_that("explicit parse_settings=TRUE works for inline data", { expect_length(lint(foo, parse_settings = TRUE), 1L) expect_length(lint(text = lint_str, parse_settings = TRUE), 1L) expect_length(lint(lint_str, parse_settings = TRUE), 1L) + + # parse_settings=TRUE default not picked up + expect_length(lint(text = lint_str), 2L) }) From 891604a4ff654b796a48a8b72cd719e159d1fb0f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 15:54:45 -0700 Subject: [PATCH 20/23] new helper for cyclocomp --- R/lint.R | 48 ++++++++++++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 20 deletions(-) diff --git a/R/lint.R b/R/lint.R index aaec52c87..03edd64cd 100644 --- a/R/lint.R +++ b/R/lint.R @@ -77,26 +77,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = return(exclude(lints, lines = lines, linter_names = names(linters), ...)) } - file_linter_names <- names(linters)[vapply(linters, is_linter_level, logical(1L), "file")] - expression_linter_names <- names(linters)[vapply(linters, is_linter_level, logical(1L), "expression")] - - lints <- list() - if (!is_tainted(source_expressions$lines)) { - for (expr in source_expressions$expressions) { - for (linter in necessary_linters(expr, expression_linter_names, file_linter_names)) { - # use withCallingHandlers for friendlier failures on unexpected linter errors - lints[[length(lints) + 1L]] <- withCallingHandlers( - get_lints(expr, linter, linters[[linter]], lint_cache, source_expressions$lines), - error = function(cond) { - cli_abort( - "Linter {.fn linter} failed in {.file {filename}}:", - parent = cond - ) - } - ) - } - } - } + lints <- lint_impl(linters, lint_cache, source_expression$lines, source_expression$expressions) lints <- maybe_append_condition_lints(lints, source_expressions, lint_cache, filename) lints <- reorder_lints(flatten_lints(lints)) @@ -111,6 +92,33 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = zap_temp_filename(res, needs_tempfile) } +lint_impl_ <- function(linters, lint_cache, lines, expressions) { + if (is_tainted(lines)) { + return(list()) + } + + file_linter_names <- names(linters)[vapply(linters, is_linter_level, logical(1L), "file")] + expression_linter_names <- names(linters)[vapply(linters, is_linter_level, logical(1L), "expression")] + + lints <- list() + for (expr in expressions) { + for (linter in necessary_linters(expr, expression_linter_names, file_linter_names)) { + # use withCallingHandlers for friendlier failures on unexpected linter errors + lints[[length(lints) + 1L]] <- withCallingHandlers( + get_lints(expr, linter, linters[[linter]], lint_cache, lines), + error = function(cond) { + cli_abort( + "Linter {.fn linter} failed in {.file {filename}}:", + parent = cond + ) + } + ) + } + } + + lints +} + #' @param path For the base directory of the project (for `lint_dir()`) or #' package (for `lint_package()`). #' @param relative_path if `TRUE`, file paths are printed using their path relative to the base directory. From a4e29a14501035080f1501e76dce5354d5233162 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 22:59:03 +0000 Subject: [PATCH 21/23] missing _ --- R/lint.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/lint.R b/R/lint.R index 03edd64cd..0381a0da0 100644 --- a/R/lint.R +++ b/R/lint.R @@ -77,7 +77,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = return(exclude(lints, lines = lines, linter_names = names(linters), ...)) } - lints <- lint_impl(linters, lint_cache, source_expression$lines, source_expression$expressions) + lints <- lint_impl_(linters, lint_cache, source_expression$lines, source_expression$expressions) lints <- maybe_append_condition_lints(lints, source_expressions, lint_cache, filename) lints <- reorder_lints(flatten_lints(lints)) From 42d628c1c237136a9206de0e42c881b05fe85706 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 23:06:11 +0000 Subject: [PATCH 22/23] more typos --- R/lint.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/lint.R b/R/lint.R index 0381a0da0..a912093b4 100644 --- a/R/lint.R +++ b/R/lint.R @@ -77,7 +77,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = return(exclude(lints, lines = lines, linter_names = names(linters), ...)) } - lints <- lint_impl_(linters, lint_cache, source_expression$lines, source_expression$expressions) + lints <- lint_impl_(linters, lint_cache, source_expressions) lints <- maybe_append_condition_lints(lints, source_expressions, lint_cache, filename) lints <- reorder_lints(flatten_lints(lints)) @@ -92,8 +92,8 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = zap_temp_filename(res, needs_tempfile) } -lint_impl_ <- function(linters, lint_cache, lines, expressions) { - if (is_tainted(lines)) { +lint_impl_ <- function(linters, lint_cache, source_expressions) { + if (is_tainted(source_expressions$lines)) { return(list()) } @@ -101,11 +101,11 @@ lint_impl_ <- function(linters, lint_cache, lines, expressions) { expression_linter_names <- names(linters)[vapply(linters, is_linter_level, logical(1L), "expression")] lints <- list() - for (expr in expressions) { + for (expr in source_expressions$expressions) { for (linter in necessary_linters(expr, expression_linter_names, file_linter_names)) { # use withCallingHandlers for friendlier failures on unexpected linter errors lints[[length(lints) + 1L]] <- withCallingHandlers( - get_lints(expr, linter, linters[[linter]], lint_cache, lines), + get_lints(expr, linter, linters[[linter]], lint_cache, source_expressions$lines), error = function(cond) { cli_abort( "Linter {.fn linter} failed in {.file {filename}}:", From 61bf105151f0c57898cb838f6eca10a6f9ed7ee7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 29 Jul 2025 16:21:02 -0700 Subject: [PATCH 23/23] need to pass filename= --- R/lint.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/lint.R b/R/lint.R index a912093b4..e079e11f1 100644 --- a/R/lint.R +++ b/R/lint.R @@ -77,7 +77,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = return(exclude(lints, lines = lines, linter_names = names(linters), ...)) } - lints <- lint_impl_(linters, lint_cache, source_expressions) + lints <- lint_impl_(linters, lint_cache, filename, source_expressions) lints <- maybe_append_condition_lints(lints, source_expressions, lint_cache, filename) lints <- reorder_lints(flatten_lints(lints)) @@ -92,7 +92,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = zap_temp_filename(res, needs_tempfile) } -lint_impl_ <- function(linters, lint_cache, source_expressions) { +lint_impl_ <- function(linters, lint_cache, filename, source_expressions) { if (is_tainted(source_expressions$lines)) { return(list()) }