From 758ee6bc4699259bf72d1790a966081b4416583d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 1 Dec 2020 19:15:33 -0500 Subject: [PATCH 1/4] fix namespace hooks exception in object_name_linter (#633) * fix namespace hooks exception in object_name_linter * add a test, fix comment --- NEWS.md | 2 +- R/object_name_linters.R | 53 ++++++++++++++---------- tests/testthat/test-object_name_linter.R | 2 + 3 files changed, 34 insertions(+), 23 deletions(-) diff --git a/NEWS.md b/NEWS.md index 7dfc590a5..9a7944f33 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,7 +16,7 @@ * New `sprintf_linter()` (#544, #578, #624, #625, @renkun-ken, @AshesITR) * Exclusions specified in the `.lintr` file are now relative to the location of that file and support excluding entire directories (#158, #438, @AshesITR) -* `object_name_linter()` now excludes special R hook functions such as `.onLoad` (#500, #614, @AshesITR) +* `object_name_linter()` now excludes special R hook functions such as `.onLoad` (#500, #614, @AshesITR and @michaelchirico) * `equals_na_linter()` now lints `x != NA` and `NA == x`, and skips usages in comments (#545, @michaelchirico) * Malformed Rmd files now cause a lint instead of an error (#571, #575, @AshesITR) * `object_name_linter()` gains a new default style, `"symbols"`, which won't lint all-symbol object names (in particular, that means operator names like `%+%` are skipped; #615, @michaelchirico) diff --git a/R/object_name_linters.R b/R/object_name_linters.R index 17a7211a2..f2be63e72 100644 --- a/R/object_name_linters.R +++ b/R/object_name_linters.R @@ -51,14 +51,14 @@ object_name_linter <- function(styles = c("snake_case", "symbols")) { nms <- strip_names( as.character(xml2::xml_find_first(assignments, "./text()"))) - generics <- c( + generics <- strip_names(c( declared_s3_generics(xml), namespace_imports()$fun, names(.knownS3Generics), - .S3PrimitiveGenerics, ls(baseenv())) + .S3PrimitiveGenerics, ls(baseenv()))) - style_matches <- lapply(styles, function(x) { - check_style(nms, x, generics) + style_matches <- lapply(styles, function(style) { + check_style(nms, style, generics) }) matches_a_style <- Reduce(`|`, style_matches) @@ -90,6 +90,9 @@ check_style <- function(nms, style, generics = character()) { # If they are not conforming, but are S3 methods then ignore them conforming[!conforming][has_generic] <- TRUE } + # exclude namespace hooks like .onLoad, .Last.lib, etc (#500) + is_special <- is_special_function(nms[!conforming]) + conforming[!conforming][is_special] <- TRUE } conforming } @@ -130,8 +133,7 @@ make_object_linter <- function(fun) { keep_indices <- which( !is_operator(names) & !is_known_generic(names) & - !is_base_function(names) & - !is_special_function(names) + !is_base_function(names) ) lapply( @@ -229,27 +231,34 @@ base_pkgs <- c( "mgcv" ) -base_funs <- unlist(lapply(base_pkgs, - function(x) { - name <- try_silently(getNamespace(x)) - if (!inherits(name, "try-error")) { - ls(name, all.names = TRUE) - } - })) +# some duplicates such as .onLoad appear in multiple packages; sort for efficiency +base_funs <- sort(unique(unlist(lapply( + base_pkgs, + function(x) { + name <- try_silently(getNamespace(x)) + if (!inherits(name, "try-error")) { + ls(name, all.names = TRUE) + } + } +)))) is_base_function <- function(x) { x %in% base_funs } -# see ?".onLoad" and ?"Startup" +# see ?".onLoad", ?Startup, and ?quit. Remove leading dot to match behavior of strip_names(). +# All of .onLoad, .onAttach, and .onUnload are used in base packages, +# and should be caught in is_base_function; they're included here for completeness / stability +# (they don't strictly _have_ to be defined in base, so could in principle be removed). +# .Last.sys and .First.sys are part of base itself, so aren't included here. special_funs <- c( - ".onLoad", - ".onAttach", - ".onUnload", - ".onDetach", - ".Last.lib", - ".First", - ".Last" + "onLoad", + "onAttach", + "onUnload", + "onDetach", + "Last.lib", + "First", + "Last" ) is_special_function <- function(x) { @@ -266,7 +275,7 @@ object_lint <- function(source_file, token, message, type) { line = source_file$lines[as.character(token$line1)], ranges = list(c(token$col1, token$col2)), linter = type - ) + ) } diff --git a/tests/testthat/test-object_name_linter.R b/tests/testthat/test-object_name_linter.R index 4fa5f0c59..0f73fb3cc 100644 --- a/tests/testthat/test-object_name_linter.R +++ b/tests/testthat/test-object_name_linter.R @@ -48,6 +48,8 @@ test_that("linter ignores some objects", { expect_lint("print.foo <- t", NULL, object_name_linter("CamelCase")) # S3 generic expect_lint("names.foo <- t", NULL, object_name_linter("CamelCase")) # int generic expect_lint("sapply(x,f,USE.NAMES=T)", NULL, object_name_linter("snake_case")) # defined elsewhere + expect_lint(".onLoad <- function(...) TRUE", NULL, object_name_linter("snake_case")) # namespace hooks, #500 + expect_lint(".First <- function(...) TRUE", NULL, object_name_linter("snake_case")) # namespace hooks expect_lint("`%++%` <- `+`", NULL, object_name_linter("symbols")) # all-symbol operator }) From e74aa0e664feba5b6a8311b4ec3df31d1f8eff6f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 2 Dec 2020 05:04:46 -0500 Subject: [PATCH 2/4] spaces_inside_linter ignores trailing comments (#638) * spaces_inside_linter ignores trailing comments * add additional test to trigger CI * fix regex Co-authored-by: AshesITR --- NEWS.md | 1 + R/spaces_inside_linter.R | 5 ++++- tests/testthat/test-spaces_inside_linter.R | 9 +++++++++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 9a7944f33..1c48556f8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,6 +20,7 @@ * `equals_na_linter()` now lints `x != NA` and `NA == x`, and skips usages in comments (#545, @michaelchirico) * Malformed Rmd files now cause a lint instead of an error (#571, #575, @AshesITR) * `object_name_linter()` gains a new default style, `"symbols"`, which won't lint all-symbol object names (in particular, that means operator names like `%+%` are skipped; #615, @michaelchirico) +* `spaces_inside_linter` ignores spaces preceding trailing comments (#636, @michaelchirico) # lintr 2.0.1 diff --git a/R/spaces_inside_linter.R b/R/spaces_inside_linter.R index 4f0b1c235..e99cf0da4 100644 --- a/R/spaces_inside_linter.R +++ b/R/spaces_inside_linter.R @@ -9,7 +9,10 @@ spaces_inside_linter <- function(source_file) { "']'") # using a regex here as checking each token is horribly slow - re <- rex(list(one_of("[("), " ") %or% list(" " %if_prev_isnt% ",", one_of("])"))) + re <- rex( + list(one_of("[("), one_or_more(" "), none_of(end %or% "#" %or% " ")) %or% + list(" " %if_prev_isnt% ",", one_of("])")) + ) all_matches <- re_matches(source_file$lines, re, global = TRUE, locations = TRUE) line_numbers <- as.integer(names(source_file$lines)) diff --git a/tests/testthat/test-spaces_inside_linter.R b/tests/testthat/test-spaces_inside_linter.R index 3d2cd80ae..3932d2335 100644 --- a/tests/testthat/test-spaces_inside_linter.R +++ b/tests/testthat/test-spaces_inside_linter.R @@ -53,4 +53,13 @@ test_that("returns the correct linting", { NULL, spaces_inside_linter) + # trailing comments are OK (#636) + expect_lint("or( #code\n x, y\n)", NULL, spaces_inside_linter) + + expect_lint(trim_some(" + fun( # this is another comment + a = 42, # because 42 is always the answer + b = Inf + ) + "), NULL, spaces_inside_linter) }) From 5a52eee1b991014a85f0aba1e7933c0b776e8394 Mon Sep 17 00:00:00 2001 From: AshesITR Date: Wed, 2 Dec 2020 16:26:07 +0100 Subject: [PATCH 3/4] add T_and_F_symbol_linter to default_linters (#612) * add T_and_F_symbol_linter to default_linters delint zzz.R and remove unnecessary # nolint in the same file also fix the minor issue #511 while touching zzz.R fixes #517 and #511 * update NEWS.md * add T/F symbol to default_linter_testcode.R * add info comment * restore line_length lint and no_tab * sync all versions of default_linter_testcode.R * Restore trailing whitespace A proper IDE makes this nigh impossible to produce :D * Update default_linter_testcode.R * Update default_linter_testcode.R * Update default_linter_testcode.R * fix T_and_F lint in addins.R * # nocov RStudio addins * remove unused function named_list, # nocov .onLoad Co-authored-by: Michael Chirico --- NEWS.md | 2 ++ R/addins.R | 4 ++- R/zzz.R | 29 ++++++++++++------- tests/testthat/default_linter_testcode.R | 8 +++-- .../package/R/default_linter_testcode.R | 8 +++-- .../data-raw/default_linter_testcode.R | 8 +++-- .../inst/data-raw/default_linter_testcode.R | 8 +++-- 7 files changed, 43 insertions(+), 24 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1c48556f8..836ef2c30 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,6 +21,8 @@ * Malformed Rmd files now cause a lint instead of an error (#571, #575, @AshesITR) * `object_name_linter()` gains a new default style, `"symbols"`, which won't lint all-symbol object names (in particular, that means operator names like `%+%` are skipped; #615, @michaelchirico) * `spaces_inside_linter` ignores spaces preceding trailing comments (#636, @michaelchirico) +* `T_and_F_symbol_linter` is now part of the default linters (#517, #612, @AshesITR) +* `with_defaults()` no longer duplicates the `lintr_function` class when it is already present (#511, #612, @AshesITR) # lintr 2.0.1 diff --git a/R/addins.R b/R/addins.R index 66a6407a1..0612673a9 100644 --- a/R/addins.R +++ b/R/addins.R @@ -1,3 +1,4 @@ +# nocov start addin_lint <- function() { filename <- rstudioapi::getSourceEditorContext() if (filename$path == "") { @@ -8,7 +9,7 @@ addin_lint <- function() { if (length(config_file) == 0) { config_linters <- NULL } else { - config <- read.dcf(config_file, all = T) + config <- read.dcf(config_file, all = TRUE) config_linters <- gsub("\n", "", config[["linters"]]) } linters <- if (length(config_linters) == 0) { @@ -29,3 +30,4 @@ addin_lint_package <- function() { lintr::lint_package(project_path) } +# nocov end diff --git a/R/zzz.R b/R/zzz.R index 9c687b621..37b6d6498 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -60,7 +60,7 @@ with_defaults <- function(..., default = default_linters) { res[] <- lapply(res, function(x) { prev_class <- class(x) - if (inherits(x, "function")) { + if (inherits(x, "function") && !inherits(x, "lintr_function")) { class(x) <- c(prev_class, "lintr_function") } x @@ -71,7 +71,8 @@ with_defaults <- function(..., default = default_linters) { #' #' List of default linters for \code{\link{lint}}. Use \code{\link{with_defaults}} to customize it. #' @export -default_linters <- with_defaults(default = list(), +default_linters <- with_defaults( + default = list(), assignment_linter, closed_curly_linter(), commas_linter, @@ -92,8 +93,10 @@ default_linters <- with_defaults(default = list(), single_quotes_linter, spaces_inside_linter, spaces_left_parentheses_linter, + T_and_F_symbol_linter, trailing_blank_lines_linter, - trailing_whitespace_linter) + trailing_whitespace_linter +) #' Default undesirable functions and operators #' @@ -103,7 +106,8 @@ default_linters <- with_defaults(default = list(), #' @format A named list of character strings. #' @rdname default_undesirable_functions #' @export -all_undesirable_functions <- with_defaults(default = list(), +all_undesirable_functions <- with_defaults( + default = list(), "attach" = "use roxygen2's @importFrom statement in packages, or `::` in scripts", "detach" = "use roxygen2's @importFrom statement in packages, or `::` in scripts", "ifelse" = "use an if () {} else {} block", @@ -126,7 +130,8 @@ all_undesirable_functions <- with_defaults(default = list(), #' @rdname default_undesirable_functions #' @export -default_undesirable_functions <- do.call(with_defaults, c(list(default=list()), +default_undesirable_functions <- do.call(with_defaults, c( + list(default = list()), all_undesirable_functions[c( "attach", "detach", @@ -147,7 +152,8 @@ default_undesirable_functions <- do.call(with_defaults, c(list(default=list()), #' @rdname default_undesirable_functions #' @export -all_undesirable_operators <- with_defaults(default = list(), +all_undesirable_operators <- with_defaults( + default = list(), ":::" = NA, "<<-" = NA, "->>" = NA @@ -155,7 +161,8 @@ all_undesirable_operators <- with_defaults(default = list(), #' @rdname default_undesirable_functions #' @export -default_undesirable_operators <- do.call(with_defaults, c(list(default=list()), +default_undesirable_operators <- do.call(with_defaults, c( + list(default = list()), all_undesirable_operators[c( ":::", "<<-", @@ -174,11 +181,11 @@ settings <- NULL # nocov start .onLoad <- function(libname, pkgname) { op <- options() - op.lintr <- list( + op_lintr <- list( lintr.linter_file = ".lintr" ) - toset <- !(names(op.lintr) %in% names(op)) - if (any(toset)) options(op.lintr[toset]) + toset <- !(names(op_lintr) %in% names(op)) + if (any(toset)) options(op_lintr[toset]) default_settings <<- list( linters = default_linters, @@ -186,7 +193,7 @@ settings <- NULL exclude_start = rex::rex("#", any_spaces, "nolint start"), exclude_end = rex::rex("#", any_spaces, "nolint end"), exclusions = list(), - cache_directory = "~/.R/lintr_cache", # nolint + cache_directory = "~/.R/lintr_cache", comment_token = Sys.getenv("GITHUB_TOKEN", unset = NA) %||% rot( paste0( "0n12nn72507", diff --git a/tests/testthat/default_linter_testcode.R b/tests/testthat/default_linter_testcode.R index 7bdd47971..fce166aef 100644 --- a/tests/testthat/default_linter_testcode.R +++ b/tests/testthat/default_linter_testcode.R @@ -18,26 +18,28 @@ f = function (x,y = 1){} # object_name # object_usage # open_curly +# T_and_F_symbol someComplicatedFunctionWithALongCamelCaseName <- function(x) { y <- 1 - if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && x == NA) {TRUE} else {FALSE} + if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && 5 > 6 && 6 > 7 && x == NA) {T} else {F} } +# no_tab # pipe_continuation # seq_linter # spaces_inside x <- 1:10 x[ 2] 1:length(x) %>% lapply(function(x) x*2) %>% - head() + head() # single_quotes message('single_quotes') # spaces_left_parentheses # trailing_whitespace -y <- 2 +(1:10) +y <- 2 +(1:10) # trailing_blank_lines diff --git a/tests/testthat/dummy_packages/package/R/default_linter_testcode.R b/tests/testthat/dummy_packages/package/R/default_linter_testcode.R index 1a28af5fd..fce166aef 100644 --- a/tests/testthat/dummy_packages/package/R/default_linter_testcode.R +++ b/tests/testthat/dummy_packages/package/R/default_linter_testcode.R @@ -18,26 +18,28 @@ f = function (x,y = 1){} # object_name # object_usage # open_curly +# T_and_F_symbol someComplicatedFunctionWithALongCamelCaseName <- function(x) { y <- 1 - if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && x == NA) {TRUE} else {FALSE} + if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && 5 > 6 && 6 > 7 && x == NA) {T} else {F} } +# no_tab # pipe_continuation # seq_linter # spaces_inside x <- 1:10 x[ 2] 1:length(x) %>% lapply(function(x) x*2) %>% - head() + head() # single_quotes message('single_quotes') # spaces_left_parentheses # trailing_whitespace -y <- 2 +(1:10) +y <- 2 +(1:10) # trailing_blank_lines diff --git a/tests/testthat/dummy_packages/package/data-raw/default_linter_testcode.R b/tests/testthat/dummy_packages/package/data-raw/default_linter_testcode.R index 1a28af5fd..fce166aef 100644 --- a/tests/testthat/dummy_packages/package/data-raw/default_linter_testcode.R +++ b/tests/testthat/dummy_packages/package/data-raw/default_linter_testcode.R @@ -18,26 +18,28 @@ f = function (x,y = 1){} # object_name # object_usage # open_curly +# T_and_F_symbol someComplicatedFunctionWithALongCamelCaseName <- function(x) { y <- 1 - if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && x == NA) {TRUE} else {FALSE} + if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && 5 > 6 && 6 > 7 && x == NA) {T} else {F} } +# no_tab # pipe_continuation # seq_linter # spaces_inside x <- 1:10 x[ 2] 1:length(x) %>% lapply(function(x) x*2) %>% - head() + head() # single_quotes message('single_quotes') # spaces_left_parentheses # trailing_whitespace -y <- 2 +(1:10) +y <- 2 +(1:10) # trailing_blank_lines diff --git a/tests/testthat/dummy_packages/package/inst/data-raw/default_linter_testcode.R b/tests/testthat/dummy_packages/package/inst/data-raw/default_linter_testcode.R index 1a28af5fd..fce166aef 100644 --- a/tests/testthat/dummy_packages/package/inst/data-raw/default_linter_testcode.R +++ b/tests/testthat/dummy_packages/package/inst/data-raw/default_linter_testcode.R @@ -18,26 +18,28 @@ f = function (x,y = 1){} # object_name # object_usage # open_curly +# T_and_F_symbol someComplicatedFunctionWithALongCamelCaseName <- function(x) { y <- 1 - if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && x == NA) {TRUE} else {FALSE} + if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && 5 > 6 && 6 > 7 && x == NA) {T} else {F} } +# no_tab # pipe_continuation # seq_linter # spaces_inside x <- 1:10 x[ 2] 1:length(x) %>% lapply(function(x) x*2) %>% - head() + head() # single_quotes message('single_quotes') # spaces_left_parentheses # trailing_whitespace -y <- 2 +(1:10) +y <- 2 +(1:10) # trailing_blank_lines From 430d28a496e235b8e8b65703f2acaac58e091915 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Drago=C8=99=20Moldovan-Gr=C3=BCnfeld?= Date: Wed, 2 Dec 2020 21:47:00 +0000 Subject: [PATCH 4/4] added lint-changed-files CI workflow (#652) * added lint-changed-files CI workflow * changed job name for consistency and updated file selection glob * simplified linting, no more double exclusion + removed fs dependency * test 12 * undo * revert to using lint_package and exclusion list (all unchanged files) * add .lintr_new more restrictive config file to be applied to newly written / modified code * added NEWS note on the lint-changed-files workflow * remove T_and_F_symbol_linter from .lintr_new --- .github/workflows/lint-changed-files.yaml | 53 +++++++++++++++++++++++ .lintr_new | 10 +++++ NEWS.md | 1 + 3 files changed, 64 insertions(+) create mode 100644 .github/workflows/lint-changed-files.yaml create mode 100644 .lintr_new diff --git a/.github/workflows/lint-changed-files.yaml b/.github/workflows/lint-changed-files.yaml new file mode 100644 index 000000000..d57b6ed4f --- /dev/null +++ b/.github/workflows/lint-changed-files.yaml @@ -0,0 +1,53 @@ +on: + pull_request: + branches: + - main + - master + +name: lint-changed-files + +jobs: + lint-changed-files: + runs-on: macOS-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v2 + + - uses: r-lib/actions/setup-r@v1 + + - name: Query dependencies + run: | + install.packages('remotes') + saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) + writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") + shell: Rscript {0} + + - name: Cache R packages + uses: actions/cache@v2 + with: + path: ${{ env.R_LIBS_USER }} + key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- + + - name: Install dependencies + run: | + install.packages(c("remotes")) + remotes::install_deps(dependencies = TRUE) + remotes::install_cran("gh") + remotes::install_github("jimhester/lintr") + remotes::install_cran("purrr") + shell: Rscript {0} + + - name: Add lintr options + run: cat('\noptions(lintr.linter_file = ".lintr_new")\n', file = "~/.Rprofile", append = TRUE) + shell: Rscript {0} + + - name: Extract and lint files changed by this PR + run: | + files <- gh::gh("GET https://api.github.com/repos/jimhester/lintr/pulls/${{ github.event.pull_request.number }}/files") + changed_files <- purrr::map_chr(files, "filename") + all_files <- list.files(recursive = TRUE) + exclusions_list <- as.list(setdiff(all_files, changed_files)) + lintr::lint_package(exclusions = exclusions_list) + shell: Rscript {0} diff --git a/.lintr_new b/.lintr_new new file mode 100644 index 000000000..a8be72455 --- /dev/null +++ b/.lintr_new @@ -0,0 +1,10 @@ +linters: with_defaults( + line_length_linter = line_length_linter(120) + ) +exclusions: list( + "tests/testthat/dummy_packages", + "tests/testthat/knitr_formats", + "tests/testthat/knitr_malformed", + "inst", + "vignettes" + ) diff --git a/NEWS.md b/NEWS.md index 836ef2c30..f047df08f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # lintr (development version) +* Added a secondary, more restrictive lint workflow - `lint-changed-files` - for newly written / modified code (#641, @dragosmg) * Switched CI from Travis to GitHub Actions, using the full tidyverse recommended R CMD check. Code coverage and linting are implemented using separate GitHub Actions workflows (#572, @dragosmg) * `save_cache` will now recursively create the cache directory; this avoids errors that could arise if any parent directories do not exist (#60, @dankessler). * `extract_r_source` handles Rmd containing unevaluated code blocks with named