From 838e0c62e17ef25ff8b361ec37c0ae91c6a803ea Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 15 Feb 2021 22:40:12 -0800 Subject: [PATCH 01/18] initial formalization of Russ's branch comparison script --- .dev/compare_branches.R | 184 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 184 insertions(+) create mode 100755 .dev/compare_branches.R diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R new file mode 100755 index 0000000000..97a00930c1 --- /dev/null +++ b/.dev/compare_branches.R @@ -0,0 +1,184 @@ +#!/usr/local/bin/Rscript + +# compare the lints obtained before/after a given PR +# the PR is always compared against master + +# arguments +# --linters=linter1,linter2,... +# run the comparison for these linters +# --branch=branch +# run the comparison for master vs this branch +# --pr=pr +# run the comparison for master vs this pr +# --packages=/path/to/package1,/path/to/package2,... +# run the comparison for these packages +# --pkg_dir=pkg_dir +# run the comparison for all packages in dir +# --sample_size +# select a sample of the packages found in +# --packages/--pkg_dir of the given size +# --outfile +# a file to which to write the output + +library(magrittr) +library(dplyr) +library(purrr) +library(tibble) +library(usethis) +library(gert) +library(devtools) + +if(!file.exists("lintr.Rproj")) { + "compare_branches.R should be run inside the lintr-package directory" +} + +args <- strsplit(gsub("^--", "", commandArgs(TRUE)), "=", fixed = TRUE) +args <- setNames( + vapply(args, `[`, character(1L), 2L), + vapply(args, `[`, character(1L), 1L) +) +if ("linters" %in% names(args)) { + linter_names <- strsplit(args["linters"], ",", fixed = TRUE)[[1L]] +} else { + linter_names <- "object_usage_linter" +} +# prioritize "branch" +is_branch <- FALSE +if ("branch" %in% names(args)) { + branch <- args["branch"] + is_branch <- TRUE +} else if ("pr" %in% names(args)) { + pr <- args["pr"] +} else { + pr <- 709L +} + +# prioritize packages +if ("packages" %in% names(args)) { + packages <- strsplit(args["packages"], ",", fixed = TRUE)[[1L]] +} else if ("pkg_dir" %in% names(args)) { + packages <- list.files(normalizePath(args["pkg_dir"]), full.names = TRUE) +} else { + packages <- file.path("~", "proj", "code_as_data", "data", "packages") +} +# filter to (1) package directories or (2) package tar.gz files +packages <- packages[ + file.exists(packages) & + ( + file.exists(file.path(packages, "DESCRIPTION")) | + grepl("^[a-zA-Z0-9.]+_[0-9.-]+\\.tar\\.gz", basename(packages)) + ) +] + +if ("sample_size" %in% names(args)) { + packages <- sample(packages, min(length(packages), as.integer(args["sample_size"]))) +} + +if ("outfile" %in% names(args)) { + outfile <- args["outfile"] +} else { + outfile <- normalizePath( + file.path("~", sprintf("lintr_compare_branches_%d.csv", as.integer(Sys.time()))) + ) +} + +# In lintr directory + +lint_all_packages <- function(pkgs, linter) { + pkg_is_dir <- file.info(pkgs)$isdir + pkg_names <- dplyr::if_else( + pkg_is_dir, + basename(pkgs), + gsub("_.*", "", basename(pkgs)) + ) + + map( + seq_along(pkgs), + function(ii) { + if (!pkg_is_dir[ii]) { + tmp <- file.path(tempdir(), pkg_names[ii]) + on.exit(unlink(tmp, recursive = TRUE)) + utils::untar(pkgs[ii], exdir = tmp) + pkg <- tmp + } + lint_dir(pkg, linters = linter, parse_settings = FALSE) + } + ) %>% + set_names(pkg_names) +} + +format_lints <- function(x) { + x %>% + purrr::map(as_tibble) %>% + dplyr::bind_rows(.id = "package") +} + +run_lints <- function(pkgs, linter) { + format_lints(lint_all_packages(pkgs, linter)) +} + +run_on <- function(what, pkgs, linter_name, ...) { + switch( + what, + master = { + gert::git_branch_checkout("master") + }, + pr = { + usethis::pr_fetch(...) + }, + branch = { + gert::git_branch_checkout(...) + } + ) + devtools::load_all() + + linter <- get(linter_name)() + + run_lints(pkgs, linter) +} + +run_pr_workflow <- function(linter_name, pkgs, pr) { + old_branch <- gert::git_branch() + on.exit(gert::git_branch_checkout(old_branch)) + + dplyr::bind_rows( + main = run_on("master", pkgs, linter_name), + pr = run_on("pr", pkgs, linter_name, pr), + .id = "source" + ) +} + +run_branch_workflow <- function(linter_name, pkgs, branch) { + old_branch <- gert::git_branch() + on.exit(gert::git_branch_checkout(old_branch)) + + dplyr::bind_rows( + main = run_on("master", pkgs, linter_name), + branch = run_on("branch", pkgs, linter_name, branch), + .id = "source" + ) +} + +############################################################################### + +# TODO: handle both command line args and interactive runs +# TODO: handle the case when working directory is not the lintr directory +# TODO: convert to the original branch (if this was not master) +# - at the end of the workflow (currently this always converts back to +# master) +# - and if there is any error when running the workflow +# TODO: save data.frame of lints to file + +############################################################################### + +message(pr) +message(toString(linter_names)) +message("Any package repo found in these directories will be analysed:", toString(packages)) + +if (is_branch) { + lints <- purrr::map_df(linter_names, run_pr_workflow, packages, pr) +} else { + lints <- purrr::map_df(linter_names, run_branch_workflow, packages, branch) +} + +write.csv(lints, outfile, row.names = FALSE) From 443305c5b4438416e61924bf54000e124ed3804e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 15 Feb 2021 22:44:48 -0800 Subject: [PATCH 02/18] tweaks --- .dev/compare_branches.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index 97a00930c1..53c914e614 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -48,7 +48,7 @@ if ("branch" %in% names(args)) { branch <- args["branch"] is_branch <- TRUE } else if ("pr" %in% names(args)) { - pr <- args["pr"] + pr <- as.integer(args["pr"]) } else { pr <- 709L } @@ -78,7 +78,8 @@ if ("outfile" %in% names(args)) { outfile <- args["outfile"] } else { outfile <- normalizePath( - file.path("~", sprintf("lintr_compare_branches_%d.csv", as.integer(Sys.time()))) + file.path("~", sprintf("lintr_compare_branches_%d.csv", as.integer(Sys.time()))), + mustWork = FALSE ) } From d7e22d6334dbf732c8fcc80c67fea44c08d0e8e0 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 15 Feb 2021 22:46:42 -0800 Subject: [PATCH 03/18] tweak again --- .dev/compare_branches.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index 53c914e614..e2bbb31d39 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -144,7 +144,7 @@ run_pr_workflow <- function(linter_name, pkgs, pr) { dplyr::bind_rows( main = run_on("master", pkgs, linter_name), - pr = run_on("pr", pkgs, linter_name, pr), + pr = run_on("pr", pkgs, linter_name, number = pr), .id = "source" ) } @@ -155,7 +155,7 @@ run_branch_workflow <- function(linter_name, pkgs, branch) { dplyr::bind_rows( main = run_on("master", pkgs, linter_name), - branch = run_on("branch", pkgs, linter_name, branch), + branch = run_on("branch", pkgs, linter_name, branch = branch), .id = "source" ) } From b95eef95646b0a36f740e26b235e97a02b265cdd Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 15 Feb 2021 22:57:26 -0800 Subject: [PATCH 04/18] debugging --- .dev/compare_branches.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index e2bbb31d39..1c47258733 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -174,12 +174,12 @@ run_branch_workflow <- function(linter_name, pkgs, branch) { message(pr) message(toString(linter_names)) -message("Any package repo found in these directories will be analysed:", toString(packages)) +message("Any package repo found in these directories will be analysed:", toString(basename(packages))) if (is_branch) { - lints <- purrr::map_df(linter_names, run_pr_workflow, packages, pr) -} else { lints <- purrr::map_df(linter_names, run_branch_workflow, packages, branch) +} else { + lints <- purrr::map_df(linter_names, run_pr_workflow, packages, pr) } write.csv(lints, outfile, row.names = FALSE) From 390f94430fbc6aecd519b3541fe041973be6dda4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 15 Feb 2021 23:33:54 -0800 Subject: [PATCH 05/18] workaround for Depends --- .dev/compare_branches.R | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index 1c47258733..c314118707 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -83,7 +83,14 @@ if ("outfile" %in% names(args)) { ) } -# In lintr directory +# read Depends from DESCRIPTION +get_deps <- function(pkg) { + deps <- read.dcf(file.path(pkg, "DESCRIPTION"), "Depends") + deps <- strsplit(deps, ",", fixed = TRUE)[[1L]] + deps <- trimws(gsub("\\([^)]*\\)", "", deps)) + deps <- deps[deps != "R"] + deps +} lint_all_packages <- function(pkgs, linter) { pkg_is_dir <- file.info(pkgs)$isdir @@ -102,6 +109,11 @@ lint_all_packages <- function(pkgs, linter) { utils::untar(pkgs[ii], exdir = tmp) pkg <- tmp } + # devtools::load_all() may not work for packages with Depends + tryCatch( + find.package(get_deps(pkg)), + warning = function(w) stop("Package dependencies missing:\n", w$message) + ) lint_dir(pkg, linters = linter, parse_settings = FALSE) } ) %>% From 544d787165f1aeda11c4ed5a27aca92e143e1518 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 15 Feb 2021 23:37:46 -0800 Subject: [PATCH 06/18] more tweak --- .dev/compare_branches.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index c314118707..54c941c232 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -106,7 +106,9 @@ lint_all_packages <- function(pkgs, linter) { if (!pkg_is_dir[ii]) { tmp <- file.path(tempdir(), pkg_names[ii]) on.exit(unlink(tmp, recursive = TRUE)) - utils::untar(pkgs[ii], exdir = tmp) + # --strip-components makes sure the output structure is + # /path/to/tmp/pkg/ instead of /path/to/tmp/pkg/pkg + utils::untar(pkgs[ii], exdir = tmp, extras="--strip-components=1") pkg <- tmp } # devtools::load_all() may not work for packages with Depends From 3bae06e3f2d9fef364b6aadbd7b02de8c2b5977d Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 15 Feb 2021 23:38:32 -0800 Subject: [PATCH 07/18] skip empty depends --- .dev/compare_branches.R | 1 + 1 file changed, 1 insertion(+) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index 54c941c232..c0650198d9 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -86,6 +86,7 @@ if ("outfile" %in% names(args)) { # read Depends from DESCRIPTION get_deps <- function(pkg) { deps <- read.dcf(file.path(pkg, "DESCRIPTION"), "Depends") + if (is.na(deps)) return(character()) deps <- strsplit(deps, ",", fixed = TRUE)[[1L]] deps <- trimws(gsub("\\([^)]*\\)", "", deps)) deps <- deps[deps != "R"] From e68841f62ef51d147cadf220397778621b0a8dbc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 16 Feb 2021 00:12:37 -0800 Subject: [PATCH 08/18] add to buildignore --- .Rbuildignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.Rbuildignore b/.Rbuildignore index c965d4ed01..44104f43bc 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,6 +9,7 @@ ^.*\.Rproj$ ^\.Rproj\.user$ ^\.idea$ +^\.dev$ ^\.lintr$ ^\.lintr_new$ ^wercker\.yml$ From e646ecca5564eec531f9a5856d1b836000159491 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 16 Feb 2021 09:34:17 -0800 Subject: [PATCH 09/18] use optparse --- .dev/compare_branches.R | 113 +++++++++++++++++++--------------------- 1 file changed, 55 insertions(+), 58 deletions(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index c0650198d9..3f9c31bf33 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -1,26 +1,8 @@ #!/usr/local/bin/Rscript -# compare the lints obtained before/after a given PR -# the PR is always compared against master - -# arguments -# --linters=linter1,linter2,... -# run the comparison for these linters -# --branch=branch -# run the comparison for master vs this branch -# --pr=pr -# run the comparison for master vs this pr -# --packages=/path/to/package1,/path/to/package2,... -# run the comparison for these packages -# --pkg_dir=pkg_dir -# run the comparison for all packages in dir -# --sample_size -# select a sample of the packages found in -# --packages/--pkg_dir of the given size -# --outfile -# a file to which to write the output - -library(magrittr) +# compare the lints obtained before/after a given PR/branch vs current master + +library(optparse) library(dplyr) library(purrr) library(tibble) @@ -32,34 +14,65 @@ if(!file.exists("lintr.Rproj")) { "compare_branches.R should be run inside the lintr-package directory" } -args <- strsplit(gsub("^--", "", commandArgs(TRUE)), "=", fixed = TRUE) -args <- setNames( - vapply(args, `[`, character(1L), 2L), - vapply(args, `[`, character(1L), 1L) +param_list <- list( + optparse::make_option( + "--linters", + default = "object_usage_linter", + help = "Run the comparison for these linter(s) (comma-separated) [default %default]" + ), + optparse::make_option( + "--branch", + help = "Run the comparison for master vs. this branch" + ), + optparse::make_option( + "--pr", + type = "integer", + help = "Run the comparison for master vs. this PR" + ), + optparse::make_option( + "--packages", + help = "Run the comparison using these packages (comma-separated)" + ), + optparse::make_option( + "--pkg_dir", + help = "Run the comparison using all packages in this directory" + ), + optparse::make_option( + "--sample_size", + type = "integer", + help = "Select a sample of this number of packages from 'packages' or 'pkg_dir'" + ), + optparse::make_option( + "--outfile", + default = file.path("~", sprintf("lintr_compare_branches_%d.csv", as.integer(Sys.time()))), + help = "Destination file to which to write the output" + ) ) -if ("linters" %in% names(args)) { - linter_names <- strsplit(args["linters"], ",", fixed = TRUE)[[1L]] -} else { - linter_names <- "object_usage_linter" -} + +params <- optparse::parse_args(optparse::OptionParse(option_list = param_list)) + +linter_names <- strsplit(params$linters, ",", fixed = TRUE)[[1L]] + # prioritize "branch" is_branch <- FALSE -if ("branch" %in% names(args)) { - branch <- args["branch"] +if (!is.null(params$branch)) { + branch <- params$branch is_branch <- TRUE -} else if ("pr" %in% names(args)) { - pr <- as.integer(args["pr"]) +} else if (!is.null(params$pr)) { + pr <- params$pr } else { - pr <- 709L + message("Please supply a branch (--branch) or a PR number (--pr)") + q("no") } # prioritize packages -if ("packages" %in% names(args)) { - packages <- strsplit(args["packages"], ",", fixed = TRUE)[[1L]] -} else if ("pkg_dir" %in% names(args)) { - packages <- list.files(normalizePath(args["pkg_dir"]), full.names = TRUE) +if (!is.null(params$packages)) { + packages <- strsplit(params$packages, ",", fixed = TRUE)[[1L]] +} else if (!is.null(params$pkg_dir)) { + packages <- list.files(normalizePath(params$pkg_dir), full.names = TRUE) } else { - packages <- file.path("~", "proj", "code_as_data", "data", "packages") + message("Please supply a comma-separated list of packages (--packages) or a directory of packages (--pkg_dir)") + q("no") } # filter to (1) package directories or (2) package tar.gz files packages <- packages[ @@ -70,17 +83,8 @@ packages <- packages[ ) ] -if ("sample_size" %in% names(args)) { - packages <- sample(packages, min(length(packages), as.integer(args["sample_size"]))) -} - -if ("outfile" %in% names(args)) { - outfile <- args["outfile"] -} else { - outfile <- normalizePath( - file.path("~", sprintf("lintr_compare_branches_%d.csv", as.integer(Sys.time()))), - mustWork = FALSE - ) +if (!is.null(params$sample_size)) { + packages <- sample(packages, min(length(packages), params$sample_size)) } # read Depends from DESCRIPTION @@ -176,15 +180,8 @@ run_branch_workflow <- function(linter_name, pkgs, branch) { } ############################################################################### - # TODO: handle both command line args and interactive runs # TODO: handle the case when working directory is not the lintr directory -# TODO: convert to the original branch (if this was not master) -# - at the end of the workflow (currently this always converts back to -# master) -# - and if there is any error when running the workflow -# TODO: save data.frame of lints to file - ############################################################################### message(pr) From d5b8f582c616faf15b1f0a92f50eceeca55ba99a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 16 Feb 2021 23:09:06 -0800 Subject: [PATCH 10/18] consolidate TODO --- .dev/compare_branches.R | 1 - 1 file changed, 1 deletion(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index 3f9c31bf33..a54751551d 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -180,7 +180,6 @@ run_branch_workflow <- function(linter_name, pkgs, branch) { } ############################################################################### -# TODO: handle both command line args and interactive runs # TODO: handle the case when working directory is not the lintr directory ############################################################################### From 9f451272bd648dcbb769e6c872022f308b89a84f Mon Sep 17 00:00:00 2001 From: AshesITR Date: Tue, 16 Feb 2021 09:40:41 +0100 Subject: [PATCH 11/18] add name attribute to Linter class (#753) * add name attribute to Linter class fixes #746 * fix test failures * document() * restore 100% coverage for utils.R * deprecate Lint(linter = ...) and remove all calling instances make expect_lint() resilient to complete removal of the argument * add NEWS bullet * document() * fix lint, collapse with space fix test expectation Co-authored-by: Michael Chirico --- NEWS.md | 3 +- R/T_and_F_symbol_linter.R | 3 +- R/assignment_linter.R | 10 +- R/assignment_spaces_linter.R | 3 +- R/backport_linter.R | 3 +- R/closed_curly_linter.R | 3 +- R/commas_linter.R | 39 +++---- R/comment_linters.R | 4 +- R/cyclocomp_linter.R | 3 +- R/deprecated.R | 17 ++- R/equals_na_linter.R | 2 +- R/expect_lint.R | 5 +- R/extraction_operator_linter.R | 6 +- R/function_left_parentheses.R | 7 +- R/get_source_expressions.R | 12 +- R/implicit_integer_linter.R | 3 +- R/infix_spaces_linter.R | 18 +-- R/line_length_linter.R | 3 +- R/lint.R | 17 ++- R/make_linter_from_regex.R | 4 +- R/missing_argument_linter.R | 3 +- R/missing_package_linter.R | 3 +- R/namespace_linter.R | 15 +-- R/no_tab_linter.R | 1 - R/object_name_linters.R | 21 ++-- R/object_usage_linter.R | 3 +- R/open_curly_linter.R | 114 ++++++++++--------- R/paren_brace_linter.R | 3 +- R/path_linters.R | 14 +-- R/pipe_continuation_linter.R | 3 +- R/semicolon_terminator_linter.R | 5 +- R/seq_linter.R | 3 +- R/single_quotes_linter.R | 3 +- R/spaces_inside_linter.R | 3 +- R/spaces_left_parentheses_linter.R | 3 +- R/sprintf_linter.R | 3 +- R/trailing_blank_lines_linter.R | 38 +++---- R/trailing_whitespace_linter.R | 45 ++++---- R/undesirable_function_linter.R | 4 +- R/undesirable_operator_linter.R | 4 +- R/unneeded_concatenation_linter.R | 1 - R/utils.R | 33 ++++-- man/Lint.Rd | 2 +- man/Linter.Rd | 5 +- tests/testthat/test-error.R | 2 +- tests/testthat/test-lint_file.R | 10 ++ tests/testthat/test-make_linter_from_regex.R | 2 +- tests/testthat/test-methods.R | 41 ++++--- vignettes/creating_linters.Rmd | 34 +++--- 49 files changed, 293 insertions(+), 293 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4bb30098c6..71fe1a5dae 100644 --- a/NEWS.md +++ b/NEWS.md @@ -37,7 +37,8 @@ * `paren_brace_linter` now marks lints at the opening brace instead of the closing parenthesis, making fixing the lints by jumping to source markers easier (#583, @AshesITR) * Lints are now marked with the name of the `linter` that caused them instead of the name of their implementation - function (#664, #673, @AshesITR). + function. + Deprecated the obsolete `linter` argument of `Lint()`. (#664, #673, #746, @AshesITR) * New syntax to exclude only selected linters from linting lines or passages. Use `# nolint: linter_name, linter2_name.` or `# nolint start: linter_name, linter2_name.` in source files or named lists of line numbers in `.lintr`. (#660, @AshesITR) diff --git a/R/T_and_F_symbol_linter.R b/R/T_and_F_symbol_linter.R index 2dd9193795..302937b55b 100644 --- a/R/T_and_F_symbol_linter.R +++ b/R/T_and_F_symbol_linter.R @@ -21,8 +21,7 @@ T_and_F_symbol_linter <- function() { # nolint: object_name_linter. type = "style", message = sprintf("Use %s instead of the symbol %s.", replacement, symbol), line = source_file[["lines"]][[as.character(line_num)]], - ranges = list(c(start_col_num, end_col_num)), - linter = "T_and_F_symbol_linter" + ranges = list(c(start_col_num, end_col_num)) ) } } diff --git a/R/assignment_linter.R b/R/assignment_linter.R index fd62a67117..3fcecbc849 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -2,7 +2,8 @@ #' @export assignment_linter <- function() { Linter(function(source_file) { - lapply(ids_with_token(source_file, "EQ_ASSIGN"), + lapply( + ids_with_token(source_file, "EQ_ASSIGN"), function(id) { parsed <- with_id(source_file, id) Lint( @@ -11,9 +12,8 @@ assignment_linter <- function() { column_number = parsed$col1, type = "style", message = "Use <-, not =, for assignment.", - line = source_file$lines[as.character(parsed$line1)], - linter = "assignment_linter" - ) + line = source_file$lines[as.character(parsed$line1)] + ) }) - }) + }) } diff --git a/R/assignment_spaces_linter.R b/R/assignment_spaces_linter.R index 479f22e916..b66750f1f2 100644 --- a/R/assignment_spaces_linter.R +++ b/R/assignment_spaces_linter.R @@ -24,8 +24,7 @@ assignment_spaces <- function() { column_number = parsed$col1, type = "style", message = "Assignments should only have one space before and after the operator.", - line = source_file$lines[parsed$line1], - linter = "assignment_spaces" + line = source_file$lines[parsed$line1] ) } } diff --git a/R/backport_linter.R b/R/backport_linter.R index a07b19db3e..4c4df88f39 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -40,8 +40,7 @@ backport_linter <- function(r_version = getRversion()) { all_names[ii], names(needs_backport_names)[which(needs_backport[ii, ])], r_version ), line = source_file$lines[[line1]], - ranges = list(c(col1, col2)), - linter = "backport_linter" + ranges = list(c(col1, col2)) ) }) }) diff --git a/R/closed_curly_linter.R b/R/closed_curly_linter.R index 954bd1511a..af7bdbc09b 100644 --- a/R/closed_curly_linter.R +++ b/R/closed_curly_linter.R @@ -58,8 +58,7 @@ closed_curly_linter <- function(allow_single_line = FALSE) { "Closing curly-braces should always be on their own line,", "unless they are followed by an else." ), - line = source_file$lines[as.character(parsed$line1)], - linter = "closed_curly_linter" + line = source_file$lines[as.character(parsed$line1)] )} } ) diff --git a/R/commas_linter.R b/R/commas_linter.R index 61c238f732..086f4cb139 100644 --- a/R/commas_linter.R +++ b/R/commas_linter.R @@ -59,17 +59,15 @@ commas_linter <- function() { !empty_comma && !is_blank_switch) { - lints[[length(lints) + 1L]] <- - Lint( - filename = source_file$filename, - line_number = line_number, - column_number = comma_loc, - type = "style", - message = "Commas should never have a space before.", - line = line, - ranges = list(c(start, end)), - "commas_linter" - ) + lints[[length(lints) + 1L]] <- Lint( + filename = source_file$filename, + line_number = line_number, + column_number = comma_loc, + type = "style", + message = "Commas should never have a space before.", + line = line, + ranges = list(c(start, end)) + ) } } @@ -83,17 +81,14 @@ commas_linter <- function() { source_file$parsed_content$token == "','") if (has_token) { - - lints[[length(lints) + 1L]] <- - Lint( - filename = source_file$filename, - line_number = line_number, - column_number = comma_loc + 1, - type = "style", - message = "Commas should always have a space after.", - line = line, - linter = "commas_linter" - ) + lints[[length(lints) + 1L]] <- Lint( + filename = source_file$filename, + line_number = line_number, + column_number = comma_loc + 1, + type = "style", + message = "Commas should always have a space after.", + line = line + ) } } diff --git a/R/comment_linters.R b/R/comment_linters.R index d046815c19..11a480d8dd 100644 --- a/R/comment_linters.R +++ b/R/comment_linters.R @@ -61,7 +61,6 @@ commented_code_linter <- function() { type = "style", message = "Commented code should be removed.", line = source_file$file_lines[line_number], - linter = "commented_code_linter", ranges = list(column_offset + c(code_candidates[code_candidate, "code.start"], code_candidates[code_candidate, "code.end"])) ) @@ -95,8 +94,7 @@ todo_comment_linter <- function(todo = c("todo", "fixme")) { type = "style", message = "TODO comments should be removed.", line = source_file[["lines"]][[as.character(token[["line1"]])]], - ranges = list(c(token[["col1"]], token[["col2"]])), - linter = "todo_comment_linter" + ranges = list(c(token[["col1"]], token[["col2"]])) ) } ) diff --git a/R/cyclocomp_linter.R b/R/cyclocomp_linter.R index 04ff0a1bc3..603600ab6d 100644 --- a/R/cyclocomp_linter.R +++ b/R/cyclocomp_linter.R @@ -25,8 +25,7 @@ cyclocomp_linter <- function(complexity_limit = 15L) { complexity_limit, ", this has ", complexity, "." ), ranges = list(c(source_file[["column"]][1], source_file[["column"]][1])), - line = source_file$lines[1], - linter = "cyclocomp_linter" + line = source_file$lines[1] ) }) } diff --git a/R/deprecated.R b/R/deprecated.R index 871ae3cec4..282959612b 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -35,6 +35,7 @@ absolute_paths_linter <- function(source_file) { absolute_path_linter(lax = TRUE)(source_file) } class(absolute_paths_linter) <- "linter" +attr(absolute_paths_linter, "name") <- "absolute_paths_linter" #' @describeIn lintr-deprecated Check there are no trailing semicolons. @@ -44,6 +45,7 @@ trailing_semicolons_linter <- function(source_file) { semicolon_terminator_linter(semicolon = "trailing")(source_file) } class(trailing_semicolons_linter) <- "linter" +attr(trailing_semicolons_linter, "name") <- "trailing_semicolons_linter" #' @describeIn lintr-deprecated Check that objects are not in camelCase. @@ -59,10 +61,9 @@ camel_case_linter <- make_object_linter(function(source_file, parsed) { !is_base_function(parsed$text)) { object_lint(source_file, parsed, - "Variable and function names should be all lowercase.", - "camel_case_linter") + "Variable and function names should be all lowercase.") } -}) +}, name = "camel_case_linter") #' @describeIn lintr-deprecated Check that objects are not in snake_case. @@ -78,10 +79,9 @@ snake_case_linter <- make_object_linter(function(source_file, parsed) { !is_base_function(parsed$text)) { object_lint(source_file, parsed, - "Variable and function names should not use underscores.", - "snake_case_linter") + "Variable and function names should not use underscores.") } -}) +}, name = "snake_case_linter") #' @describeIn lintr-deprecated check that objects do not have.multiple.dots. @@ -96,7 +96,6 @@ multiple_dots_linter <- make_object_linter(function(source_file, parsed) { !is_base_function(parsed$text)) { object_lint(source_file, parsed, - "Words within variable and function names should be separated by '_' rather than '.'.", - "multiple_dots_linter") + "Words within variable and function names should be separated by '_' rather than '.'.") } -}) +}, name = "multiple_dots_linter") diff --git a/R/equals_na_linter.R b/R/equals_na_linter.R index 8a36315b1c..224c9d7f19 100644 --- a/R/equals_na_linter.R +++ b/R/equals_na_linter.R @@ -19,6 +19,6 @@ equals_na_linter <- function() { lapply(bad_expr, xml_nodes_to_lint, source_file, message = "Use is.na for comparisons to NA (not == or !=)", - linter = "equals_na_linter", type = "warning") + type = "warning") }) } diff --git a/R/expect_lint.R b/R/expect_lint.R index 6f0e558891..3241600cd1 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -70,8 +70,9 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { } local({ - itr <- 0L #nolint - lint_fields <- names(formals(Lint)) + itr <- 0L + # keep 'linter' as a field even if we remove the deprecated argument from Lint() in the future + lint_fields <- unique(c(names(formals(Lint)), "linter")) Map(function(lint, check) { itr <<- itr + 1L lapply(names(check), function(field) { diff --git a/R/extraction_operator_linter.R b/R/extraction_operator_linter.R index 3d3bae3050..80263ef9c5 100644 --- a/R/extraction_operator_linter.R +++ b/R/extraction_operator_linter.R @@ -3,8 +3,8 @@ #' @export extraction_operator_linter <- function() { Linter(function(source_file) { - tokens <- source_file[["parsed_content"]] <- - filter_out_token_type(source_file[["parsed_content"]], "expr") + tokens <- source_file[["parsed_content"]] <- filter_out_token_type(source_file[["parsed_content"]], "expr") + lapply( ids_with_token(source_file, c("'$'", "'['"), fun = `%in%`), function(token_num) { @@ -14,6 +14,7 @@ extraction_operator_linter <- function() { end_col_num <- token[["col2"]] line_num <- token[["line1"]] line <- source_file[["lines"]][[as.character(line_num)]] + Lint( filename = source_file[["filename"]], line_number = line_num, @@ -21,7 +22,6 @@ extraction_operator_linter <- function() { type = "warning", message = sprintf("Use `[[` instead of `%s` to extract an element.", token[["text"]]), line = line, - linter = "extraction_operator_linter", ranges = list(c(start_col_num, end_col_num)) ) } diff --git a/R/function_left_parentheses.R b/R/function_left_parentheses.R index 40553f4207..d739b29bd3 100644 --- a/R/function_left_parentheses.R +++ b/R/function_left_parentheses.R @@ -34,12 +34,11 @@ function_left_parentheses_linter <- function() { # nolint: object_length_linter. column_number = parsed$col1, type = "style", message = "Remove spaces before the left parenthesis in a function call.", - line = line, - linter = "function_left_parentheses_linter" + line = line ) } } - - }) + } + ) }) } diff --git a/R/get_source_expressions.R b/R/get_source_expressions.R index 95123810fe..878365c294 100644 --- a/R/get_source_expressions.R +++ b/R/get_source_expressions.R @@ -106,8 +106,7 @@ get_source_expressions <- function(filename) { column_number = 1, type = "error", message = e$message, - line = "", - linter = "error" + line = "" ) ) # nocov end @@ -123,8 +122,7 @@ get_source_expressions <- function(filename) { column_number = column_number, type = "error", message = e$message, - line = source_file$lines[[line_number]], - linter = "error" + line = source_file$lines[[line_number]] ) ) } @@ -148,8 +146,7 @@ get_source_expressions <- function(filename) { column_number = column_number, type = "error", message = message_info$message, - line = line, - linter = "error" + line = line ) } @@ -178,8 +175,7 @@ get_source_expressions <- function(filename) { column_number = column_number, type = "error", message = message_info$message, - line = source_file$lines[line_number], - linter = "error" + line = source_file$lines[line_number] ) } diff --git a/R/implicit_integer_linter.R b/R/implicit_integer_linter.R index f9625e76dc..b3f04ebbbb 100644 --- a/R/implicit_integer_linter.R +++ b/R/implicit_integer_linter.R @@ -19,8 +19,7 @@ implicit_integer_linter <- function() { message = "Integers should not be implicit. Use the form 1L for integers or 1.0 for doubles.", line = source_file[["lines"]][[as.character(line_num)]], - ranges = list(c(start_col_num, end_col_num)), - linter = "implicit_integer_linter" + ranges = list(c(start_col_num, end_col_num)) ) } } diff --git a/R/infix_spaces_linter.R b/R/infix_spaces_linter.R index 34db276811..11fdb1d55c 100644 --- a/R/infix_spaces_linter.R +++ b/R/infix_spaces_linter.R @@ -21,32 +21,29 @@ infix_tokens <- c( "'*'", # * : unary multiplication NULL - ) +) #' @describeIn linters Check that infix operators are surrounded by spaces. #' @export infix_spaces_linter <- function() { Linter(function(source_file) { - lapply(ids_with_token(source_file, infix_tokens, fun = `%in%`), + lapply( + ids_with_token(source_file, infix_tokens, fun = `%in%`), function(id) { parsed <- with_id(source_file, id) line <- source_file$lines[as.character(parsed$line1)] around_operator <- substr(line, parsed$col1 - 1L, parsed$col2 + 1L) - non_space_before <- re_matches(around_operator, rex(start, non_space)) - newline_after <- unname(nchar(line)) %==% parsed$col2 - non_space_after <- re_matches(around_operator, rex(non_space, end)) if (non_space_before || (!newline_after && non_space_after)) { # we only should check spacing if the operator is infix, # which only happens if there is more than one sibling - is_infix <- - length(siblings(source_file$parsed_content, parsed$id, 1)) > 1L + is_infix <- length(siblings(source_file$parsed_content, parsed$id, 1)) > 1L start <- end <- parsed$col1 @@ -65,13 +62,10 @@ infix_spaces_linter <- function() { type = "style", message = "Put spaces around all infix operators.", line = line, - ranges = list(c(start, end)), - linter = "infix_spaces_linter" - ) - + ranges = list(c(start, end)) + ) } } - }) }) } diff --git a/R/line_length_linter.R b/R/line_length_linter.R index 7c71408ef0..e05b3bd617 100644 --- a/R/line_length_linter.R +++ b/R/line_length_linter.R @@ -20,8 +20,7 @@ line_length_linter <- function(length = 80L) { type = "style", message = lint_message, line = source_file$file_lines[long_line], - ranges = list(c(1L, line_lengths[long_line])), - linter = "line_length_linter" + ranges = list(c(1L, line_lengths[long_line])) ) }) }) diff --git a/R/lint.R b/R/lint.R index cf3195cdb0..fcd08cb8d5 100644 --- a/R/lint.R +++ b/R/lint.R @@ -278,11 +278,13 @@ lint_package <- function(path = ".", relative_path = TRUE, ..., lints } - define_linters <- function(linters = NULL) { if (is.null(linters)) { linters <- settings$linters names(linters) <- auto_names(linters) + } else if (inherits(linters, "linter")) { + linters <- list(linters) + names(linters) <- attr(linters[[1L]], "name", exact = TRUE) } else if (!is.list(linters)) { name <- deparse(substitute(linters)) linters <- list(linters) @@ -307,7 +309,7 @@ validate_linter_object <- function(linter, name) { new <- "linters classed as 'linter' (see ?Linter)" lintr_deprecated(old = old, new = new, version = "2.0.1.9001", type = "") - linter <- Linter(linter) + linter <- Linter(linter, name = name) } } else { stop(gettextf("Expected '%s' to be of class 'linter', not '%s'", @@ -381,12 +383,19 @@ pkg_name <- function(path = find_package()) { #' @param message message used to describe the lint error #' @param line code source where the lint occurred #' @param ranges a list of ranges on the line that should be emphasized. -#' @param linter name of linter that created the Lint object. +#' @param linter deprecated. No longer used. #' @return an object of class 'lint'. #' @export Lint <- function(filename, line_number = 1L, column_number = 1L, # nolint: object_name_linter. type = c("style", "warning", "error"), message = "", line = "", ranges = NULL, linter = "") { + if (!missing(linter)) { + lintr_deprecated( + old = "Using the `linter` argument of `Lint()`", + version = "2.0.1.9001", + type = "" + ) + } type <- match.arg(type) @@ -399,7 +408,7 @@ Lint <- function(filename, line_number = 1L, column_number = 1L, # nolint: objec message = message, line = line, ranges = ranges, - linter = linter + linter = NA_character_ ), class = "lint") } diff --git a/R/make_linter_from_regex.R b/R/make_linter_from_regex.R index 1c8db43317..6efe893731 100644 --- a/R/make_linter_from_regex.R +++ b/R/make_linter_from_regex.R @@ -1,5 +1,4 @@ make_linter_from_regex <- function(regex, - lint_name, lint_type, lint_msg, ignore_strings = TRUE) { @@ -39,8 +38,7 @@ make_linter_from_regex <- function(regex, type = lint_type, message = lint_msg, line = source_file[["lines"]][[as.character(line_number)]], - ranges = list(c(start, end)), - linter = lint_name + ranges = list(c(start, end)) ) } ) diff --git a/R/missing_argument_linter.R b/R/missing_argument_linter.R index bc8baf34f9..60dc2cdcda 100644 --- a/R/missing_argument_linter.R +++ b/R/missing_argument_linter.R @@ -32,8 +32,7 @@ missing_argument_linter <- function(except = c("switch", "alist")) { type = "warning", message = "Missing argument in function call.", line = source_file$file_lines[line1[[i]]], - ranges = list(c(col1[[i]], col2[[i]])), - linter = "missing_argument_linter" + ranges = list(c(col1[[i]], col2[[i]])) ) } }) diff --git a/R/missing_package_linter.R b/R/missing_package_linter.R index d3f0575d88..064b65f39c 100644 --- a/R/missing_package_linter.R +++ b/R/missing_package_linter.R @@ -38,8 +38,7 @@ missing_package_linter <- function() { type = "warning", message = sprintf("Package '%s' is not installed.", pkg_names[[i]]), line = source_file$file_lines[line1[[i]]], - ranges = list(c(col1[[i]], col2[[i]])), - linter = "missing_package_linter" + ranges = list(c(col1[[i]], col2[[i]])) ) }) }) diff --git a/R/namespace_linter.R b/R/namespace_linter.R index 6a16393c35..3b69b12c0c 100644 --- a/R/namespace_linter.R +++ b/R/namespace_linter.R @@ -48,8 +48,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { type = "warning", message = sprintf("'%s' is not exported from {%s}.", syms[[i]], pkgs[[i]]), line = source_file$file_lines[line1], - ranges = list(c(col1, col2)), - linter = "namespace_linter" + ranges = list(c(col1, col2)) )) } } @@ -69,8 +68,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { message = sprintf("'%s' is exported from {%s}. Use %s::%s instead.", syms[[i]], pkgs[[i]], pkgs[[i]], syms[[i]]), line = source_file$file_lines[line1], - ranges = list(c(col1, col2)), - linter = "namespace_linter" + ranges = list(c(col1, col2)) )) } } else { @@ -84,8 +82,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { type = "warning", message = sprintf("'%s' does not exist in {%s}.", syms[[i]], pkgs[[i]]), line = source_file$file_lines[line1], - ranges = list(c(col1, col2)), - linter = "namespace_linter" + ranges = list(c(col1, col2)) )) } } @@ -101,8 +98,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { type = "warning", message = conditionMessage(ns), line = source_file$file_lines[line1], - ranges = list(c(col1, col2)), - linter = "namespace_linter" + ranges = list(c(col1, col2)) )) # nocov end } @@ -118,8 +114,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { type = "warning", message = sprintf("Package '%s' is not installed.", pkgs[[i]]), line = source_file$file_lines[line1], - ranges = list(c(col1, col2)), - linter = "namespace_linter" + ranges = list(c(col1, col2)) )) } }) diff --git a/R/no_tab_linter.R b/R/no_tab_linter.R index 6f04cf7e46..3c07afd015 100644 --- a/R/no_tab_linter.R +++ b/R/no_tab_linter.R @@ -4,7 +4,6 @@ #' @export no_tab_linter <- make_linter_from_regex( regex = rex(start, zero_or_more(regex("\\s")), one_or_more("\t")), - lint_name = "no_tab_linter", lint_type = "style", lint_msg = "Use spaces to indent, not tabs." ) diff --git a/R/object_name_linters.R b/R/object_name_linters.R index 8bb43f4b08..aac9ceea80 100644 --- a/R/object_name_linters.R +++ b/R/object_name_linters.R @@ -68,8 +68,7 @@ object_name_linter <- function(styles = c("snake_case", "symbols")) { assignments[!matches_a_style], object_lint2, source_file, - lint_msg, - "object_name_linter" + lint_msg ) }) } @@ -105,7 +104,7 @@ strip_names <- function(x) { x } -object_lint2 <- function(expr, source_file, message, type) { +object_lint2 <- function(expr, source_file, message) { symbol <- xml2::as_list(expr) Lint( filename = source_file$filename, @@ -115,11 +114,11 @@ object_lint2 <- function(expr, source_file, message, type) { message = message, line = source_file$file_lines[as.numeric(symbol@line1)], ranges = list(as.numeric(c(symbol@col1, symbol@col2))), - linter = type - ) + ) } -make_object_linter <- function(fun) { +make_object_linter <- function(fun, name = linter_auto_name()) { + force(name) Linter(function(source_file) { token_nums <- ids_with_token( @@ -147,7 +146,7 @@ make_object_linter <- function(fun) { } } ) - }) + }, name = name) } known_generic_regex <- rex( @@ -266,7 +265,7 @@ is_special_function <- function(x) { x %in% special_funs } -object_lint <- function(source_file, token, message, type) { +object_lint <- function(source_file, token, message) { Lint( filename = source_file$filename, line_number = token$line1, @@ -274,8 +273,7 @@ object_lint <- function(source_file, token, message, type) { type = "style", message = message, line = source_file$lines[as.character(token$line1)], - ranges = list(c(token$col1, token$col2)), - linter = type + ranges = list(c(token$col1, token$col2)) ) } @@ -304,8 +302,7 @@ object_length_linter <- function(length = 30L) { object_lint( source_file, token, - paste0("Variable and function names should not be longer than ", length, " characters."), - "object_length_linter" + paste0("Variable and function names should not be longer than ", length, " characters.") ) } }) diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 661bcf0bdc..4da681d88e 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -70,8 +70,7 @@ object_usage_linter <- function() { type = "warning", message = row$message, line = line, - ranges = list(c(location$start, location$end)), - linter = "object_usage_linter" + ranges = list(c(location$start, location$end)) ) }) }) diff --git a/R/open_curly_linter.R b/R/open_curly_linter.R index 262bc259cc..db61ab314e 100644 --- a/R/open_curly_linter.R +++ b/R/open_curly_linter.R @@ -3,61 +3,63 @@ #' @export open_curly_linter <- function(allow_single_line = FALSE) { Linter(function(source_file) { - lapply(ids_with_token(source_file, "'{'"), - function(id) { - - parsed <- with_id(source_file, id) - - tokens_before <- source_file$parsed_content$token[ - source_file$parsed_content$line1 == parsed$line1 & - source_file$parsed_content$col1 < parsed$col1] - - tokens_after <- source_file$parsed_content$token[ - source_file$parsed_content$line1 == parsed$line1 & - source_file$parsed_content$col1 > parsed$col1 & - source_file$parsed_content$token != "COMMENT"] - - if (isTRUE(allow_single_line) && - "'}'" %in% tokens_after) { - return() - } - - line <- source_file$lines[as.character(parsed$line1)] - - # the only tokens should be the { and the start of the expression. - some_before <- length(tokens_before) %!=% 0L - some_after <- length(tokens_after) %!=% 0L - - content_after <- unname(substr(line, parsed$col1 + 1L, nchar(line))) - content_before <- unname(substr(line, 1, parsed$col1 - 1L)) - - only_comment <- rex::re_matches(content_after, rex::rex(any_spaces, "#", something, end)) - - double_curly <- rex::re_matches(content_after, rex::rex(start, "{")) || - rex::re_matches(content_before, rex::rex("{", end)) - - if (double_curly) { - return() - } - - whitespace_after <- - unname(substr(line, parsed$col1 + 1L, parsed$col1 + 1L)) %!=% "" - - if (!some_before || some_after || (whitespace_after && !only_comment)) { - Lint( - filename = source_file$filename, - line_number = parsed$line1, - column_number = parsed$col1, - type = "style", - message = paste( - "Opening curly braces should never go on their own line and", - "should always be followed by a new line." - ), - line = line, - linter = "open_curly_linter" - ) - } - - }) + lapply( + ids_with_token(source_file, "'{'"), + function(id) { + + parsed <- with_id(source_file, id) + + tokens_before <- source_file$parsed_content$token[ + source_file$parsed_content$line1 == parsed$line1 & + source_file$parsed_content$col1 < parsed$col1] + + tokens_after <- source_file$parsed_content$token[ + source_file$parsed_content$line1 == parsed$line1 & + source_file$parsed_content$col1 > parsed$col1 & + source_file$parsed_content$token != "COMMENT"] + + if (isTRUE(allow_single_line) && + "'}'" %in% tokens_after) { + return() + } + + line <- source_file$lines[as.character(parsed$line1)] + + # the only tokens should be the { and the start of the expression. + some_before <- length(tokens_before) %!=% 0L + some_after <- length(tokens_after) %!=% 0L + + content_after <- unname(substr(line, parsed$col1 + 1L, nchar(line))) + content_before <- unname(substr(line, 1, parsed$col1 - 1L)) + + only_comment <- rex::re_matches(content_after, rex::rex(any_spaces, "#", something, end)) + + double_curly <- rex::re_matches(content_after, rex::rex(start, "{")) || + rex::re_matches(content_before, rex::rex("{", end)) + + if (double_curly) { + return() + } + + whitespace_after <- + unname(substr(line, parsed$col1 + 1L, parsed$col1 + 1L)) %!=% "" + + if (!some_before || + some_after || + (whitespace_after && !only_comment)) { + Lint( + filename = source_file$filename, + line_number = parsed$line1, + column_number = parsed$col1, + type = "style", + message = paste( + "Opening curly braces should never go on their own line and", + "should always be followed by a new line." + ), + line = line + ) + } + } + ) }) } diff --git a/R/paren_brace_linter.R b/R/paren_brace_linter.R index 6b0c4df13a..70c450597a 100644 --- a/R/paren_brace_linter.R +++ b/R/paren_brace_linter.R @@ -34,8 +34,7 @@ paren_brace_linter <- function() { type = "style", message = "There should be a space between right parenthesis and an opening curly brace.", line = line, - ranges = list(as.numeric(c(x@col1, x@col2))), - "paren_brace_linter" + ranges = list(as.numeric(c(x@col1, x@col2))) ) } ) diff --git a/R/path_linters.R b/R/path_linters.R index 94f744405a..cb17ed7b46 100644 --- a/R/path_linters.R +++ b/R/path_linters.R @@ -139,7 +139,8 @@ split_path <- function(path, sep="/|\\\\") { } #' @include utils.R -make_path_linter <- function(path_function, message, linter) { +make_path_linter <- function(path_function, message, linter, name = linter_auto_name()) { + force(name) Linter(function(source_file) { lapply( ids_with_token(source_file, "STR_CONST"), @@ -161,13 +162,12 @@ make_path_linter <- function(path_function, message, linter) { type = "warning", message = message, line = source_file[["lines"]][[as.character(token[["line1"]])]], - ranges = list(c(start, end)), - linter = linter + ranges = list(c(start, end)) ) } } ) - }) + }, name = name) } #' @describeIn linters Check that no absolute paths are used (e.g. "/var", "C:\\System", "~/docs"). @@ -178,8 +178,7 @@ absolute_path_linter <- function(lax = TRUE) { path_function = function(path) { is_absolute_path(path) && is_valid_long_path(path, lax) }, - message = "Do not use absolute paths.", - linter = "absolute_path_linter" + message = "Do not use absolute paths." ) } @@ -191,7 +190,6 @@ nonportable_path_linter <- function(lax = TRUE) { is_path(path) && is_valid_long_path(path, lax) && path != "/" && re_matches(path, rex(one_of("/", "\\"))) }, - message = "Use file.path() to construct portable file paths.", - linter = "nonportable_filepath_linter" + message = "Use file.path() to construct portable file paths." ) } diff --git a/R/pipe_continuation_linter.R b/R/pipe_continuation_linter.R index 2014e5d8e0..91f777ab07 100644 --- a/R/pipe_continuation_linter.R +++ b/R/pipe_continuation_linter.R @@ -67,8 +67,7 @@ pipe_continuation_linter <- function() { " unless the full pipeline fits on one line." ), line = line, - ranges = list(as.numeric(c(x@col1, x@col2))), - "pipe_continuation_linter" + ranges = list(as.numeric(c(x@col1, x@col2))) ) }) }) diff --git a/R/semicolon_terminator_linter.R b/R/semicolon_terminator_linter.R index 1815c9d4e6..31416be5f3 100644 --- a/R/semicolon_terminator_linter.R +++ b/R/semicolon_terminator_linter.R @@ -22,6 +22,7 @@ semicolon_terminator_linter <- function(semicolon = c("compound", "trailing")) { } else { "Compound semicolons are not needed. Replace them by a newline." } + Lint( filename = source_file[["filename"]], line_number = token[["line1"]], @@ -29,8 +30,7 @@ semicolon_terminator_linter <- function(semicolon = c("compound", "trailing")) { type = "style", message = msg, line = source_file[["lines"]][[as.character(token[["line1"]])]], - ranges = list(c(token[["col1"]], token[["col2"]])), - linter = "semicolon_linter" + ranges = list(c(token[["col1"]], token[["col2"]])) ) }, split(tokens, seq_len(nrow(tokens))), @@ -39,7 +39,6 @@ semicolon_terminator_linter <- function(semicolon = c("compound", "trailing")) { }) } - is_trailing_sc <- function(sc_tokens, source_file) { line_str <- source_file[["lines"]][as.character(sc_tokens[["line1"]])] tail_str <- substr(line_str, sc_tokens[["col1"]] + 1L, nchar(line_str)) diff --git a/R/seq_linter.R b/R/seq_linter.R index 3cda75f667..f0d89e81df 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -50,8 +50,7 @@ seq_linter <- function() { message = paste0(f1, ":", f2, " is likely to be wrong in the empty ", "edge case, use seq_len."), line = source_file$lines[line1], - ranges = list(c(as.integer(col1), as.integer(col2))), - linter = "seq_linter" + ranges = list(c(as.integer(col1), as.integer(col2))) ) } ) diff --git a/R/single_quotes_linter.R b/R/single_quotes_linter.R index b5287273b8..4f79fa4981 100644 --- a/R/single_quotes_linter.R +++ b/R/single_quotes_linter.R @@ -27,8 +27,7 @@ single_quotes_linter <- function() { type = "style", message = "Only use double-quotes.", line = line, - ranges = list(c(col1, col2)), - linter = "single_quotes_linter" + ranges = list(c(col1, col2)) ) }) } diff --git a/R/spaces_inside_linter.R b/R/spaces_inside_linter.R index d2933b9b61..c2dddac31f 100644 --- a/R/spaces_inside_linter.R +++ b/R/spaces_inside_linter.R @@ -47,8 +47,7 @@ spaces_inside_linter <- function() { column_number = if (substr(line, start, start) == " ") start else start + 1L, type = "style", message = "Do not place spaces around code in parentheses or square brackets.", - line = line, - linter = "spaces_inside_linter" + line = line ) } } diff --git a/R/spaces_left_parentheses_linter.R b/R/spaces_left_parentheses_linter.R index fec917bac5..b9df350d85 100644 --- a/R/spaces_left_parentheses_linter.R +++ b/R/spaces_left_parentheses_linter.R @@ -53,8 +53,7 @@ spaces_left_parentheses_linter <- function() { column_number = parsed$col1, type = "style", message = "Place a space before left parenthesis, except in a function call.", - line = line, - linter = "spaces_left_parentheses_linter" + line = line ) } } diff --git a/R/sprintf_linter.R b/R/sprintf_linter.R index 3457b40067..4e63e3c861 100644 --- a/R/sprintf_linter.R +++ b/R/sprintf_linter.R @@ -53,8 +53,7 @@ sprintf_linter <- function() { type = "warning", message = conditionMessage(res), line = source_file$file_lines[line1], - ranges = list(c(col1, col2)), - linter = "sprintf_linter" + ranges = list(c(col1, col2)) ) } } diff --git a/R/trailing_blank_lines_linter.R b/R/trailing_blank_lines_linter.R index 275edb11c7..4d0a255b0f 100644 --- a/R/trailing_blank_lines_linter.R +++ b/R/trailing_blank_lines_linter.R @@ -4,38 +4,34 @@ trailing_blank_lines_linter <- function() { Linter(function(source_file) { blanks <- re_matches(source_file$file_lines, - rex(start, any_spaces, end)) + rex(start, any_spaces, end)) line_number <- length(source_file$file_lines) lints <- list() while (line_number > 0L && (is.na(blanks[[line_number]]) || isTRUE(blanks[[line_number]]))) { if (!is.na(blanks[[line_number]])) { - lints[[length(lints) + 1L]] <- - Lint( - filename = source_file$filename, - line_number = line_number, - column_number = 1, - type = "style", - message = "Trailing blank lines are superfluous.", - line = source_file$file_lines[[line_number]], - linter = "trailing_blank_lines_linter" - ) + lints[[length(lints) + 1L]] <- Lint( + filename = source_file$filename, + line_number = line_number, + column_number = 1, + type = "style", + message = "Trailing blank lines are superfluous.", + line = source_file$file_lines[[line_number]] + ) } line_number <- line_number - 1L } if (identical(source_file$terminal_newline, FALSE)) { # could use isFALSE, but needs backports last_line <- tail(source_file$file_lines, 1L) - lints[[length(lints) + 1L]] <- - Lint( - filename = source_file$filename, - line_number = length(source_file$file_lines), - column_number = nchar(last_line) + 1L, - type = "style", - message = "Missing terminal newline.", - line = last_line, - linter = "trailing_blank_lines_linter" - ) + lints[[length(lints) + 1L]] <- Lint( + filename = source_file$filename, + line_number = length(source_file$file_lines), + column_number = nchar(last_line) + 1L, + type = "style", + message = "Missing terminal newline.", + line = last_line + ) } lints }) diff --git a/R/trailing_whitespace_linter.R b/R/trailing_whitespace_linter.R index a7d37e2127..778ce65673 100644 --- a/R/trailing_whitespace_linter.R +++ b/R/trailing_whitespace_linter.R @@ -3,34 +3,35 @@ #' @export trailing_whitespace_linter <- function() { Linter(function(source_file) { - res <- re_matches(source_file$lines, + res <- re_matches( + source_file$lines, rex(capture(name = "space", some_of(" ", regex("\\t"))), or(newline, end)), global = TRUE, - locations = TRUE) + locations = TRUE + ) lapply(seq_along(source_file$lines), function(itr) { - mapply( - FUN = function(start, end) { - if (is.na(start)) { - return() - } - line_number <- names(source_file$lines)[itr] - Lint( - filename = source_file$filename, - line_number = line_number, - column_number = start, - type = "style", - message = "Trailing whitespace is superfluous.", - line = source_file$lines[as.character(line_number)], - ranges = list(c(start, end)), - linter = "trailing_whitespace_linter" - ) - }, - start = res[[itr]]$space.start, - end = res[[itr]]$space.end, - SIMPLIFY = FALSE + mapply( + FUN = function(start, end) { + if (is.na(start)) { + return() + } + line_number <- names(source_file$lines)[itr] + Lint( + filename = source_file$filename, + line_number = line_number, + column_number = start, + type = "style", + message = "Trailing whitespace is superfluous.", + line = source_file$lines[as.character(line_number)], + ranges = list(c(start, end)) ) + }, + start = res[[itr]]$space.start, + end = res[[itr]]$space.end, + SIMPLIFY = FALSE + ) }) }) diff --git a/R/undesirable_function_linter.R b/R/undesirable_function_linter.R index 9d27f8dac4..65f3b2021c 100644 --- a/R/undesirable_function_linter.R +++ b/R/undesirable_function_linter.R @@ -29,6 +29,7 @@ undesirable_function_linter <- function(fun = default_undesirable_functions, if (!is.na(alt_fun)) { msg <- c(msg, sprintf("As an alternative, %s.", alt_fun)) } + Lint( filename = source_file[["filename"]], line_number = line_num, @@ -36,8 +37,7 @@ undesirable_function_linter <- function(fun = default_undesirable_functions, type = "warning", message = paste0(msg, collapse = " "), line = source_file[["lines"]][[as.character(line_num)]], - ranges = list(c(start_col_num, end_col_num)), - linter = "undesirable_function_linter" + ranges = list(c(start_col_num, end_col_num)) ) } } diff --git a/R/undesirable_operator_linter.R b/R/undesirable_operator_linter.R index 32941cb464..d4510bcd68 100644 --- a/R/undesirable_operator_linter.R +++ b/R/undesirable_operator_linter.R @@ -29,6 +29,7 @@ undesirable_operator_linter <- function(op = default_undesirable_operators) { if (!is.na(alt_op)) { msg <- c(msg, sprintf("As an alternative, %s.", alt_op)) } + Lint( filename = source_file[["filename"]], line_number = line_num, @@ -36,8 +37,7 @@ undesirable_operator_linter <- function(op = default_undesirable_operators) { type = "warning", message = paste0(msg, collapse = " "), line = source_file[["lines"]][[as.character(line_num)]], - ranges = list(c(start_col_num, end_col_num)), - linter = "undesirable_function_linter" + ranges = list(c(start_col_num, end_col_num)) ) } } diff --git a/R/unneeded_concatenation_linter.R b/R/unneeded_concatenation_linter.R index 43e031a833..471de86e03 100644 --- a/R/unneeded_concatenation_linter.R +++ b/R/unneeded_concatenation_linter.R @@ -24,7 +24,6 @@ unneeded_concatenation_linter <- function() { type = "warning", message = if (num_args) msg_const else msg_empty, line = line, - linter = "unneeded_concatenation_linter", ranges = list(c(start_col_num, end_col_num)) ) } diff --git a/R/utils.R b/R/utils.R index 24b99407c7..fd397ff766 100644 --- a/R/utils.R +++ b/R/utils.R @@ -62,13 +62,30 @@ names2 <- function(x) { names(x) %||% rep("", length(x)) } +linter_auto_name <- function(which = -3L) { + call <- sys.call(which = which) + nm <- paste(deparse(call, 500L), collapse = " ") + regex <- rex(start, one_or_more(alnum %or% "." %or% "_")) + if (re_matches(nm, regex)) { + match <- re_matches(nm, regex, locations = TRUE) + nm <- substr(nm, start = 1L, stop = match[1L, "end"]) + } + nm +} + auto_names <- function(x) { nms <- names2(x) missing <- nms == "" if (all(!missing)) return(nms) - deparse2 <- function(x) paste(deparse(x, 500L), collapse = "") - defaults <- vapply(x[missing], deparse2, character(1), USE.NAMES = FALSE) + default_name <- function(x) { + if (inherits(x, "linter")) { + attr(x, "name", exact = TRUE) + } else { + paste(deparse(x, 500L), collapse = " ") + } + } + defaults <- vapply(x[missing], default_name, character(1), USE.NAMES = FALSE) nms[missing] <- defaults nms @@ -183,7 +200,7 @@ unescape <- function(str, q="`") { } # convert an XML match into a Lint -xml_nodes_to_lint <- function(xml, source_file, message, linter, +xml_nodes_to_lint <- function(xml, source_file, message, type = c("style", "warning", "error")) { type <- match.arg(type, c("style", "warning", "error")) line1 <- xml2::xml_attr(xml, "line1")[1] @@ -201,8 +218,7 @@ xml_nodes_to_lint <- function(xml, source_file, message, linter, type = type, message = message, line = source_file$lines[line1], - ranges = list(c(col1, col2)), - linter = linter + ranges = list(c(col1, col2)) )) } @@ -219,11 +235,14 @@ reset_lang <- function(old_lang) { #' Create a \code{linter} closure #' @param fun A function that takes a source file and returns \code{lint} objects. +#' @param name Default name of the Linter. +#' Lints produced by the linter will be labelled with \code{name} by default. #' @return The same function with its class set to 'linter'. #' @export -Linter <- function(fun) { # nolint: object_name_linter. +Linter <- function(fun, name = linter_auto_name()) { # nolint: object_name_linter. if (!is.function(fun) || length(formals(args(fun))) != 1L) { stop("`fun` must be a function taking exactly one argument.", call. = FALSE) } - structure(fun, class = "linter") + force(name) + structure(fun, class = "linter", name = name) } diff --git a/man/Lint.Rd b/man/Lint.Rd index b6acc5b3b7..d9279b2e52 100644 --- a/man/Lint.Rd +++ b/man/Lint.Rd @@ -30,7 +30,7 @@ Lint( \item{ranges}{a list of ranges on the line that should be emphasized.} -\item{linter}{name of linter that created the Lint object.} +\item{linter}{deprecated. No longer used.} } \value{ an object of class 'lint'. diff --git a/man/Linter.Rd b/man/Linter.Rd index acd60cfcb7..c075bff1d2 100644 --- a/man/Linter.Rd +++ b/man/Linter.Rd @@ -4,10 +4,13 @@ \alias{Linter} \title{Create a \code{linter} closure} \usage{ -Linter(fun) +Linter(fun, name = linter_auto_name()) } \arguments{ \item{fun}{A function that takes a source file and returns \code{lint} objects.} + +\item{name}{Default name of the Linter. +Lints produced by the linter will be labelled with \code{name} by default.} } \value{ The same function with its class set to 'linter'. diff --git a/tests/testthat/test-error.R b/tests/testthat/test-error.R index 47e715ab97..92c0d353a5 100644 --- a/tests/testthat/test-error.R +++ b/tests/testthat/test-error.R @@ -8,7 +8,7 @@ test_that("returns the correct linting", { function() { b", rex("unexpected end of input"), - structure(function(...) NULL, class = "linter") + structure(function(...) NULL, class = "linter", name = "null") ) linter <- equals_na_linter() diff --git a/tests/testthat/test-lint_file.R b/tests/testthat/test-lint_file.R index 899dd6b04d..2226adf42a 100644 --- a/tests/testthat/test-lint_file.R +++ b/tests/testthat/test-lint_file.R @@ -142,6 +142,16 @@ test_that("compatibility warnings work", { fixed = TRUE ) + # Trigger compatibility in auto_names() + expect_warning( + expect_lint( + "a == NA", + "Use is.na", + linters = list(unclass(equals_na_linter())) + ), + fixed = "The use of linters of class 'function'" + ) + expect_error( expect_warning( lint("a <- 1\n", linters = function(two, arguments) NULL), diff --git a/tests/testthat/test-make_linter_from_regex.R b/tests/testthat/test-make_linter_from_regex.R index 1cd9e76c44..48fa3b9abb 100644 --- a/tests/testthat/test-make_linter_from_regex.R +++ b/tests/testthat/test-make_linter_from_regex.R @@ -1,5 +1,5 @@ test_that("test make_linter_from_regex works", { - linter <- make_linter_from_regex("-", "no_dash_linter", "style", "Silly lint.")() + linter <- make_linter_from_regex("-", "style", "Silly lint.")() expect_lint("a <- 2L", "Silly lint.", linter) expect_lint("a = '2-3'", NULL, linter) }) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index 716c5d48f6..d1132b7c8a 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -22,27 +22,35 @@ test_that("it returns the input trimmed to the last full lint if one exists with test_that("as.data.frame.lints", { # A minimum lint expect_is( - l1 <- Lint("dummy.R", - line_number = 1L, - type = "style", - message = "", - line = ""), + l1 <- Lint( + "dummy.R", + line_number = 1L, + type = "style", + message = "", + line = "" + ), "lint" ) # A larger lint expect_is( - l2 <- Lint("dummy.R", - line_number = 2L, - column_number = 6L, - type = "error", - message = "Under no circumstances is the use of foobar allowed.", - line = "a <- 1", - ranges = list(c(1, 2), c(10, 20)), - linter = "custom_linter"), + l2 <- Lint( + "dummy.R", + line_number = 2L, + column_number = 6L, + type = "error", + message = "Under no circumstances is the use of foobar allowed.", + line = "a <- 1", + ranges = list(c(1, 2), c(10, 20))), "lint" ) + expect_warning( + Lint("dummy.R", linter = "deprecated"), + regexp = "deprecated", + fixed = TRUE + ) + # Convert lints to data.frame lints <- structure(list(l1, l2), class = "lints") expect_is( @@ -57,8 +65,9 @@ test_that("as.data.frame.lints", { type = c("style", "error"), message = c("", "Under no circumstances is the use of foobar allowed."), line = c("", "a <- 1"), - linter = c("", "custom_linter"), - stringsAsFactors = FALSE) + linter = c(NA_character_, NA_character_), # These are assigned in lint() now. + stringsAsFactors = FALSE + ) expect_equal( df, @@ -92,7 +101,7 @@ test_that("print.lint works", { l <- Lint( filename = "tmp", line_number = 1L, column_number = 3L, type = "warning", message = "this is a lint", - line = c(`1` = "\t\t1:length(x)"), ranges = list(c(3L, 3L)), linter = "lnt" + line = c(`1` = "\t\t1:length(x)"), ranges = list(c(3L, 3L)) ) expect_output(print(l), " 1:length(x)", fixed = TRUE) }) diff --git a/vignettes/creating_linters.Rmd b/vignettes/creating_linters.Rmd index 200910539b..279e5a96a2 100644 --- a/vignettes/creating_linters.Rmd +++ b/vignettes/creating_linters.Rmd @@ -16,21 +16,22 @@ A good example of a simple linter is the `assignment_linter`. #' @describeIn linters Check that '<-' is always used for assignment. #' @export assignment_linter <- function() { -Linter(function(source_file) { - lapply(ids_with_token(source_file, "EQ_ASSIGN"), - function(id) { - parsed <- source_file$parsed_content[id, ] - Lint( - filename = source_file$filename, - line_number = parsed$line1, - column_number = parsed$col1, - type = "style", - message = "Use <-, not =, for assignment.", - line = source_file$lines[parsed$line1], - linter = "assignment_linter" + Linter(function(source_file) { + lapply( + ids_with_token(source_file, "EQ_ASSIGN"), + function(id) { + parsed <- source_file$parsed_content[id, ] + Lint( + filename = source_file$filename, + line_number = parsed$line1, + column_number = parsed$col1, + type = "style", + message = "Use <-, not =, for assignment.", + line = source_file$lines[parsed$line1] ) - }) -}) + } + ) + }) } ``` @@ -86,9 +87,8 @@ Lint( column_number = parsed$col1, type = "style", message = "Use <-, not =, for assignment.", - line = source_file$lines[parsed$line1], - linter = "assignment_linter" - ) + line = source_file$lines[parsed$line1] +) ``` Lastly, build a `lint` object which describes the issue. See `?Lint` for a description of the arguments. You do not have to return a lint for every From 97037feabf2f7207a858bcc5d04489eb714f91ba Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 16 Feb 2021 21:44:34 -0800 Subject: [PATCH 12/18] typo in optparse funciton skip Depends except on object_usage_linter typo need check higher up forgot to supply arg just exit early if Depends unavailable provide an interactive() experience for debugging tweak --- .dev/compare_branches.R | 60 ++++++++++++++++++++++++++++++++--------- 1 file changed, 47 insertions(+), 13 deletions(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index a54751551d..eeb292ecf9 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -22,24 +22,39 @@ param_list <- list( ), optparse::make_option( "--branch", + default = if (interactive()) { + readline("Name a branch to compare to master (or skip to enter a PR#): ") + }, help = "Run the comparison for master vs. this branch" ), optparse::make_option( "--pr", + default = if (interactive()) { + as.integer(readline("Name a PR # to compare to master (skip if you've entered a branch): ")) + }, type = "integer", help = "Run the comparison for master vs. this PR" ), optparse::make_option( "--packages", - help = "Run the comparison using these packages (comma-separated)" + default = if (interactive()) { + readline("Provide a comma-separated list of packages (skip to provide a directory): ") + }, + help = "Run the comparison using these packages (comma-separated)" ), optparse::make_option( "--pkg_dir", + default = if (interactive()) { + readline("Provide a directory where to select packages (skip if already provided as a list): ") + }, help = "Run the comparison using all packages in this directory" ), optparse::make_option( "--sample_size", type = "integer", + default = if (interactive()) { + as.integer(readline("Enter the number of packages to include (skip to include all): ")) + }, help = "Select a sample of this number of packages from 'packages' or 'pkg_dir'" ), optparse::make_option( @@ -49,7 +64,13 @@ param_list <- list( ) ) -params <- optparse::parse_args(optparse::OptionParse(option_list = param_list)) +params <- optparse::parse_args(optparse::OptionParser(option_list = param_list)) +# treat any skipped arguments from the prompt as missing +if (interactive()) { + for (opt in c("branch", "pr", "packages", "pkg_dir", "sample_size")) { + if (params[[opt]] == "") params[[opt]] = NULL + } +} linter_names <- strsplit(params$linters, ",", fixed = TRUE)[[1L]] @@ -97,7 +118,7 @@ get_deps <- function(pkg) { deps } -lint_all_packages <- function(pkgs, linter) { +lint_all_packages <- function(pkgs, linter, check_depends) { pkg_is_dir <- file.info(pkgs)$isdir pkg_names <- dplyr::if_else( pkg_is_dir, @@ -116,11 +137,22 @@ lint_all_packages <- function(pkgs, linter) { utils::untar(pkgs[ii], exdir = tmp, extras="--strip-components=1") pkg <- tmp } - # devtools::load_all() may not work for packages with Depends - tryCatch( - find.package(get_deps(pkg)), - warning = function(w) stop("Package dependencies missing:\n", w$message) - ) + # object_usage_linter requires running package code, which may + # not work if the package has unavailable Depends + if (check_depends) { + try_deps <- tryCatch( + find.package(get_deps(pkg)), + error = identity, warning = identity + ) + if (inherits(e, c("warning", "error")) { + warning(sprintf( + "Some package Dependencies for %s were unavailable: %s; skipping", + pkg_names[ii], + gsub("there (?:are no packages|is no package) called ", "", e$message) + )) + return(NULL) + } + } lint_dir(pkg, linters = linter, parse_settings = FALSE) } ) %>% @@ -129,12 +161,12 @@ lint_all_packages <- function(pkgs, linter) { format_lints <- function(x) { x %>% - purrr::map(as_tibble) %>% + purrr::map(tibble::as_tibble) %>% dplyr::bind_rows(.id = "package") } -run_lints <- function(pkgs, linter) { - format_lints(lint_all_packages(pkgs, linter)) +run_lints <- function(pkgs, linter, check_depends) { + format_lints(lint_all_packages(pkgs, linter, check_depends)) } run_on <- function(what, pkgs, linter_name, ...) { @@ -154,7 +186,9 @@ run_on <- function(what, pkgs, linter_name, ...) { linter <- get(linter_name)() - run_lints(pkgs, linter) + check_depends <- linter_name %in% c("object_usage_linter", "object_name_linter") + + run_lints(pkgs, linter, check_depends = check_depends) } run_pr_workflow <- function(linter_name, pkgs, pr) { @@ -193,4 +227,4 @@ if (is_branch) { lints <- purrr::map_df(linter_names, run_pr_workflow, packages, pr) } -write.csv(lints, outfile, row.names = FALSE) +write.csv(lints, params$outfile, row.names = FALSE) From b8c069fc818a5aabbb7d0cc82ce4ce4c9c712a68 Mon Sep 17 00:00:00 2001 From: AshesITR Date: Tue, 16 Feb 2021 09:40:41 +0100 Subject: [PATCH 13/18] add name attribute to Linter class (#753) * add name attribute to Linter class fixes #746 * fix test failures * document() * restore 100% coverage for utils.R * deprecate Lint(linter = ...) and remove all calling instances make expect_lint() resilient to complete removal of the argument * add NEWS bullet * document() * fix lint, collapse with space fix test expectation Co-authored-by: Michael Chirico From da0d8453bca3746b45afa7900d47a75ba46fbb11 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 16 Feb 2021 23:15:53 -0800 Subject: [PATCH 14/18] typo --- .dev/compare_branches.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index eeb292ecf9..1d18ea1c32 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -144,7 +144,7 @@ lint_all_packages <- function(pkgs, linter, check_depends) { find.package(get_deps(pkg)), error = identity, warning = identity ) - if (inherits(e, c("warning", "error")) { + if (inherits(e, c("warning", "error"))) { warning(sprintf( "Some package Dependencies for %s were unavailable: %s; skipping", pkg_names[ii], From ed416ebe07a95d25bef112628982b945de685531 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 16 Feb 2021 23:16:12 -0800 Subject: [PATCH 15/18] vestigial variable name not working from command line testing more debugging Rscript sucks progress -- we need to skip missing Imports too more progress -- skip on platforms without tcl/tk need testing again need to exit early --- .dev/compare_branches.R | 44 +++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 15 deletions(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index 1d18ea1c32..79fc77b7e0 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -10,7 +10,7 @@ library(usethis) library(gert) library(devtools) -if(!file.exists("lintr.Rproj")) { +if (!file.exists("lintr.Rproj")) { "compare_branches.R should be run inside the lintr-package directory" } @@ -68,7 +68,7 @@ params <- optparse::parse_args(optparse::OptionParser(option_list = param_list)) # treat any skipped arguments from the prompt as missing if (interactive()) { for (opt in c("branch", "pr", "packages", "pkg_dir", "sample_size")) { - if (params[[opt]] == "") params[[opt]] = NULL + if (params[[opt]] == "") params[[opt]] <- NULL } } @@ -82,8 +82,7 @@ if (!is.null(params$branch)) { } else if (!is.null(params$pr)) { pr <- params$pr } else { - message("Please supply a branch (--branch) or a PR number (--pr)") - q("no") + stop("Please supply a branch (--branch) or a PR number (--pr)") } # prioritize packages @@ -92,8 +91,7 @@ if (!is.null(params$packages)) { } else if (!is.null(params$pkg_dir)) { packages <- list.files(normalizePath(params$pkg_dir), full.names = TRUE) } else { - message("Please supply a comma-separated list of packages (--packages) or a directory of packages (--pkg_dir)") - q("no") + stop("Please supply a comma-separated list of packages (--packages) or a directory of packages (--pkg_dir)") } # filter to (1) package directories or (2) package tar.gz files packages <- packages[ @@ -110,8 +108,9 @@ if (!is.null(params$sample_size)) { # read Depends from DESCRIPTION get_deps <- function(pkg) { - deps <- read.dcf(file.path(pkg, "DESCRIPTION"), "Depends") - if (is.na(deps)) return(character()) + deps <- read.dcf(file.path(pkg, "DESCRIPTION"), c("Imports", "Depends")) + deps <- toString(deps[!is.na(deps)]) + if (deps == "") return(character()) deps <- strsplit(deps, ",", fixed = TRUE)[[1L]] deps <- trimws(gsub("\\([^)]*\\)", "", deps)) deps <- deps[deps != "R"] @@ -129,6 +128,7 @@ lint_all_packages <- function(pkgs, linter, check_depends) { map( seq_along(pkgs), function(ii) { + cat(pkg_names[ii], "\n") if (!pkg_is_dir[ii]) { tmp <- file.path(tempdir(), pkg_names[ii]) on.exit(unlink(tmp, recursive = TRUE)) @@ -138,17 +138,27 @@ lint_all_packages <- function(pkgs, linter, check_depends) { pkg <- tmp } # object_usage_linter requires running package code, which may - # not work if the package has unavailable Depends + # not work if the package has unavailable Depends; + # object_name_linter also tries to run loadNamespace on Imports + # found in the target package's NAMESPACE file if (check_depends) { + pkg_deps <- get_deps(pkg) + if ("tcltk" %in% pkg_deps && !capabilities("tcltk")) { + warning(sprintf( + "Package %s depends on tcltk, which is not available (via capabilities())", + pkg_names[ii] + )) + return(NULL) + } try_deps <- tryCatch( - find.package(get_deps(pkg)), + find.package(pkg_deps), error = identity, warning = identity ) - if (inherits(e, c("warning", "error"))) { + if (inherits(try_deps, c("warning", "error"))) { warning(sprintf( "Some package Dependencies for %s were unavailable: %s; skipping", pkg_names[ii], - gsub("there (?:are no packages|is no package) called ", "", e$message) + gsub("there (?:are no packages|is no package) called ", "", try_deps$message) )) return(NULL) } @@ -217,9 +227,13 @@ run_branch_workflow <- function(linter_name, pkgs, branch) { # TODO: handle the case when working directory is not the lintr directory ############################################################################### -message(pr) -message(toString(linter_names)) -message("Any package repo found in these directories will be analysed:", toString(basename(packages))) +message("Comparing the output of the following linters: ", toString(linter_names)) +if (is_branch) { + message("Comparing branch ", branch, " to master") +} else { + message("Comparing PR#", pr, " to master") +} +message("Comparing output of lint_dir run for the following packages: ", toString(basename(packages))) if (is_branch) { lints <- purrr::map_df(linter_names, run_branch_workflow, packages, branch) From 604344211168f45028547b45756474600cd14117 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 17 Feb 2021 00:35:51 -0800 Subject: [PATCH 16/18] skip directories with encoding issues --- .dev/compare_branches.R | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index 79fc77b7e0..e8668c3db0 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -106,6 +106,18 @@ if (!is.null(params$sample_size)) { packages <- sample(packages, min(length(packages), params$sample_size)) } +# test if nchar(., "chars") works as intended +# for all files in dir (see #541) +test_encoding <- function(dir) { + tryCatch({ + lapply( + list.files(dir, pattern = "(?i)\\.r(?:md)?$", recursive = TRUE, full.names = TRUE), + function(x) nchar(readLines(x)) + ) + TRUE + }, error = function(x) FALSE) +} + # read Depends from DESCRIPTION get_deps <- function(pkg) { deps <- read.dcf(file.path(pkg, "DESCRIPTION"), c("Imports", "Depends")) @@ -137,6 +149,13 @@ lint_all_packages <- function(pkgs, linter, check_depends) { utils::untar(pkgs[ii], exdir = tmp, extras="--strip-components=1") pkg <- tmp } + if (test_encoding(pkg)) { + warning(sprintf( + "Package %s has some files with unknown encoding; skipping", + pkg_names[ii] + )) + return(NULL) + } # object_usage_linter requires running package code, which may # not work if the package has unavailable Depends; # object_name_linter also tries to run loadNamespace on Imports @@ -145,7 +164,7 @@ lint_all_packages <- function(pkgs, linter, check_depends) { pkg_deps <- get_deps(pkg) if ("tcltk" %in% pkg_deps && !capabilities("tcltk")) { warning(sprintf( - "Package %s depends on tcltk, which is not available (via capabilities())", + "Package %s depends on tcltk, which is not available (via capabilities()); skipping", pkg_names[ii] )) return(NULL) From e0d5f7b0d148cba560c4c033872e10aa51dd1b73 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 17 Feb 2021 00:38:34 -0800 Subject: [PATCH 17/18] switch conditions --- .dev/compare_branches.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index e8668c3db0..eb6145ca42 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -112,10 +112,10 @@ test_encoding <- function(dir) { tryCatch({ lapply( list.files(dir, pattern = "(?i)\\.r(?:md)?$", recursive = TRUE, full.names = TRUE), - function(x) nchar(readLines(x)) + function(x) nchar(readLines(x, warn = FALSE)) ) - TRUE - }, error = function(x) FALSE) + FALSE + }, error = function(x) TRUE) } # read Depends from DESCRIPTION From e4042984d4edb10fb0ccdbc8eb1d6863b4f9d54b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 17 Feb 2021 00:54:35 -0800 Subject: [PATCH 18/18] remove tracing --- .dev/compare_branches.R | 1 - 1 file changed, 1 deletion(-) diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index eb6145ca42..3d4647d2a1 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -140,7 +140,6 @@ lint_all_packages <- function(pkgs, linter, check_depends) { map( seq_along(pkgs), function(ii) { - cat(pkg_names[ii], "\n") if (!pkg_is_dir[ii]) { tmp <- file.path(tempdir(), pkg_names[ii]) on.exit(unlink(tmp, recursive = TRUE))