From 5bc4dbe4396e558725542cdca7dc9599a2dd1d2b Mon Sep 17 00:00:00 2001 From: Jack Kennedy <57638616+jcken95@users.noreply.github.com> Date: Thu, 24 Oct 2024 21:42:48 +0100 Subject: [PATCH 1/5] Remove pipe on end of commented code prior to checking parsability (#2672) * fix: remove base pipe from end of line before detecting parsability * fix: remove magrittr pipe from end of line before detecting parsability * feat: add test * chore: add commented code linter ignoring end pipe to news * fix: seperate tests for magrittr/base pipe to allow for minimum R version * refac: check for trailing comma/pipes in one fn call * chore: minor rewording of news Co-authored-by: AshesITR * avoid extra nesting * further condense test code --------- Co-authored-by: AshesITR Co-authored-by: Michael Chirico --- NEWS.md | 1 + R/commented_code_linter.R | 5 +++-- tests/testthat/test-commented_code_linter.R | 10 ++++++++++ 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index d017c606a..b827f1e7a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -29,6 +29,7 @@ * `.lintr` configs set by option `lintr.linter_file` or environment variable `R_LINTR_LINTER_FILE` can point to subdirectories (#2512, @MichaelChirico). * `indentation_linter()` returns `ranges[1L]==1L` when the offending line has 0 spaces (#2550, @MichaelChirico). * `literal_coercion_linter()` doesn't surface a warning about NAs during coercion for code like `as.integer("a")` (#2566, @MichaelChirico). +* `commented_code_linter()` can detect commented code that ends with a pipe (#2671, @jcken95) ## Changes to default linters diff --git a/R/commented_code_linter.R b/R/commented_code_linter.R index fcc4af9ef..97f9c8d8e 100644 --- a/R/commented_code_linter.R +++ b/R/commented_code_linter.R @@ -83,9 +83,10 @@ commented_code_linter <- function() { all_comments <- xml_text(all_comment_nodes) code_candidates <- re_matches(all_comments, code_candidate_regex, global = FALSE, locations = TRUE) extracted_code <- code_candidates[, "code"] - # ignore trailing ',' when testing for parsability - extracted_code <- re_substitutes(extracted_code, rex(",", any_spaces, end), "") + # ignore trailing ',' or pipes ('|>', '%>%') when testing for parsability + extracted_code <- re_substitutes(extracted_code, rex(or(",", "|>", "%>%"), any_spaces, end), "") extracted_code <- re_substitutes(extracted_code, rex(start, any_spaces, ","), "") + is_parsable <- which(vapply(extracted_code, parsable, logical(1L))) lint_list <- xml_nodes_to_lints( diff --git a/tests/testthat/test-commented_code_linter.R b/tests/testthat/test-commented_code_linter.R index fadc98d5e..5154a5a94 100644 --- a/tests/testthat/test-commented_code_linter.R +++ b/tests/testthat/test-commented_code_linter.R @@ -103,3 +103,13 @@ test_that("commented_code_linter can detect operators in comments and lint corre commented_code_linter() ) }) + +test_that("commented_code_linter can detect commented code ending with pipes", { + linter <- commented_code_linter() + lint_msg <- rex::rex("Remove commented code.") + + expect_lint("# f() %>%", lint_msg, linter) + + skip_if_not_r_version("4.1.0") + expect_lint("# f() |>", lint_msg, linter) +}) From 4de229f55e9387379beb42f61c235266bbc68dcd Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 31 Oct 2024 23:44:17 -0700 Subject: [PATCH 2/5] Don't package testthat-problems.rds (#2682) --- .Rbuildignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.Rbuildignore b/.Rbuildignore index 257a72963..23f41e938 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -23,6 +23,7 @@ ^bench$ ^tests/testthat/dummy_packages/package/[.]Rbuildignore$ ^tests/testthat/dummy_packages/cp1252/[.]Rbuildignore$ +testthat-problems[.]rds$ ^_pkgdown\.yaml$ ^docs$ ^pkgdown$ From ed2473f81e7bb3dbf7daf16945757e2d6a373671 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Sun, 10 Nov 2024 20:03:43 -0800 Subject: [PATCH 3/5] Bump JamesIves/github-pages-deploy-action from 4.6.8 to 4.6.9 (#2686) Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.6.8 to 4.6.9. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.6.8...v4.6.9) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com> --- .github/workflows/pkgdown.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 4e77b61eb..466abf1e0 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -39,7 +39,7 @@ jobs: - name: Deploy to GitHub pages 🚀 if: github.event_name != 'pull_request' - uses: JamesIves/github-pages-deploy-action@v4.6.8 + uses: JamesIves/github-pages-deploy-action@v4.6.9 with: clean: false branch: gh-pages From 9d58027882db0dcced8fbb2fd3d583ca0cc6315c Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Mon, 18 Nov 2024 21:12:23 +0100 Subject: [PATCH 4/5] Add utils to check for lint and error classes (#2681) --- R/extract.R | 2 +- R/get_source_expressions.R | 6 +++--- R/lint.R | 2 +- R/utils.R | 5 ++++- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/R/extract.R b/R/extract.R index c9aa57b70..edd12a456 100644 --- a/R/extract.R +++ b/R/extract.R @@ -9,7 +9,7 @@ extract_r_source <- function(filename, lines, error = identity) { output <- rep.int(NA_character_, length(lines)) chunks <- tryCatch(get_chunk_positions(pattern = pattern, lines = lines), error = error) - if (inherits(chunks, "error") || inherits(chunks, "lint")) { + if (is_error(chunks) || is_lint(chunks)) { assign("e", chunks, envir = parent.frame()) # error, so return empty code return(output) diff --git a/R/get_source_expressions.R b/R/get_source_expressions.R index ec8a4d406..3f1817023 100644 --- a/R/get_source_expressions.R +++ b/R/get_source_expressions.R @@ -86,7 +86,7 @@ get_source_expressions <- function(filename, lines = NULL) { source_expression$content <- get_content(source_expression$lines) parsed_content <- get_source_expression(source_expression, error = function(e) lint_parse_error(e, source_expression)) - if (inherits(e, "lint") && (is.na(e$line) || !nzchar(e$line) || e$message == "unexpected end of input")) { + if (is_lint(e) && (is.na(e$line) || !nzchar(e$line) || e$message == "unexpected end of input")) { # Don't create expression list if it's unreliable (invalid encoding or unhandled parse error) expressions <- list() } else { @@ -502,7 +502,7 @@ get_source_expression <- function(source_expression, error = identity) { error = error ) - if (inherits(parsed_content, c("error", "lint"))) { + if (is_error(parsed_content) || is_lint(parsed_content)) { assign("e", parsed_content, envir = parent.frame()) parse_error <- TRUE } @@ -513,7 +513,7 @@ get_source_expression <- function(source_expression, error = identity) { error = error ) - if (inherits(parsed_content, c("error", "lint"))) { + if (is_error(parsed_content) || is_lint(parsed_content)) { # Let parse errors take precedence over encoding problems if (!parse_error) assign("e", parsed_content, envir = parent.frame()) return() # parsed_content is unreliable if encoding is invalid diff --git a/R/lint.R b/R/lint.R index 042fbeaca..1961acb05 100644 --- a/R/lint.R +++ b/R/lint.R @@ -696,7 +696,7 @@ maybe_report_progress <- function(pb) { } maybe_append_error_lint <- function(lints, error, lint_cache, filename) { - if (inherits(error, "lint")) { + if (is_lint(error)) { error$linter <- "error" lints[[length(lints) + 1L]] <- error diff --git a/R/utils.R b/R/utils.R index d23fc8902..acdf2c521 100644 --- a/R/utils.R +++ b/R/utils.R @@ -245,9 +245,12 @@ get_r_string <- function(s, xpath = NULL) { } is_linter <- function(x) inherits(x, "linter") +is_lint <- function(x) inherits(x, "lint") + +is_error <- function(x) inherits(x, "error") is_tainted <- function(lines) { - inherits(tryCatch(nchar(lines), error = identity), "error") + is_error(tryCatch(nchar(lines), error = identity)) } #' Check that the entries in ... are valid From 5c72a1ce8cf88fffe270ef6be90d278786e41b42 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 26 Nov 2024 11:31:58 -0800 Subject: [PATCH 5/5] Emphasize S3-S4 difference in recommendation for how to fix class_equals_linter() (#2688) * Emphasize S3-S4 difference in recommendation * Update in tests * One more --- R/class_equals_linter.R | 7 ++++--- tests/testthat/test-class_equals_linter.R | 10 +++++----- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/R/class_equals_linter.R b/R/class_equals_linter.R index 2dd24b83d..1f3483e9b 100644 --- a/R/class_equals_linter.R +++ b/R/class_equals_linter.R @@ -48,9 +48,10 @@ class_equals_linter <- function() { bad_expr <- xml_find_all(xml_calls, xpath) operator <- xml_find_chr(bad_expr, "string(*[2])") - lint_message <- sprintf( - "Use inherits(x, 'class-name'), is. or is(x, 'class') instead of comparing class(x) with %s.", - operator + lint_message <- paste0( + "Use inherits(x, 'class-name'), is. for S3 classes, ", + "or is(x, 'S4Class') for S4 classes, ", + "instead of comparing class(x) with ", operator, "." ) xml_nodes_to_lints( bad_expr, diff --git a/tests/testthat/test-class_equals_linter.R b/tests/testthat/test-class_equals_linter.R index fb640e448..cc4495ec3 100644 --- a/tests/testthat/test-class_equals_linter.R +++ b/tests/testthat/test-class_equals_linter.R @@ -11,7 +11,7 @@ test_that("class_equals_linter skips allowed usages", { test_that("class_equals_linter blocks simple disallowed usages", { linter <- class_equals_linter() - lint_msg <- rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')") + lint_msg <- rex::rex("Use inherits(x, 'class-name'), is. for S3 classes, or is(x, 'S4Class') for S4 classes") expect_lint("if (class(x) == 'character') stop('no')", lint_msg, linter) expect_lint("is_regression <- class(x) == 'lm'", lint_msg, linter) @@ -20,7 +20,7 @@ test_that("class_equals_linter blocks simple disallowed usages", { test_that("class_equals_linter blocks usage of %in% for checking class", { linter <- class_equals_linter() - lint_msg <- rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')") + lint_msg <- rex::rex("Use inherits(x, 'class-name'), is. for S3 classes, or is(x, 'S4Class') for S4 classes") expect_lint("if ('character' %in% class(x)) stop('no')", lint_msg, linter) expect_lint("if (class(x) %in% 'character') stop('no')", lint_msg, linter) @@ -29,7 +29,7 @@ test_that("class_equals_linter blocks usage of %in% for checking class", { test_that("class_equals_linter blocks class(x) != 'klass'", { expect_lint( "if (class(x) != 'character') TRUE", - rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')"), + rex::rex("Use inherits(x, 'class-name'), is. for S3 classes, or is(x, 'S4Class') for S4 classes"), class_equals_linter() ) }) @@ -43,13 +43,13 @@ test_that("class_equals_linter skips usage for subsetting", { # but not further nesting expect_lint( "x[if (class(x) == 'foo') 1 else 2]", - rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')"), + rex::rex("Use inherits(x, 'class-name'), is. for S3 classes, or is(x, 'S4Class') for S4 classes"), linter ) }) test_that("lints vectorize", { - lint_msg <- rex::rex("Use inherits(x, 'class-name'), is. or is(x, 'class')") + lint_msg <- rex::rex("Use inherits(x, 'class-name'), is. for S3 classes, or is(x, 'S4Class') for S4 classes") expect_lint( trim_some("{