diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index c57070bef..110d148cb 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -29,12 +29,9 @@ jobs: - {os: macOS-latest, r: 'release'} - {os: windows-latest, r: 'release'} - # Use 3.6 to trigger usage of RTools35 - - {os: windows-latest, r: '3.6'} # use 4.1 to check with rtools40's older compiler - {os: windows-latest, r: '4.1'} - # Use older ubuntu to maximise backward compatibility - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release', locale: 'en_US'} - {os: ubuntu-latest, r: 'release', http-user-agent: 'release', locale: 'zh_CN'} @@ -43,7 +40,6 @@ jobs: - {os: ubuntu-latest, r: 'oldrel-2'} - {os: ubuntu-latest, r: 'oldrel-3'} - {os: ubuntu-latest, r: 'oldrel-4'} - - {os: ubuntu-latest, r: '3.6'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} @@ -72,7 +68,6 @@ jobs: http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - # `{patrick}` imports `{purrr}`, and so needs to be ignored on R < 3.5 - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: | diff --git a/.github/workflows/check-all-examples.yaml b/.github/workflows/check-all-examples.yaml index 36415fc90..11b762f8a 100644 --- a/.github/workflows/check-all-examples.yaml +++ b/.github/workflows/check-all-examples.yaml @@ -9,9 +9,9 @@ on: push: - branches: [main, master] + branches: main pull_request: - branches: [main, master] + branches: main name: check-all-examples @@ -32,11 +32,13 @@ jobs: with: pak-version: devel extra-packages: | - any::devtools + any::pkgload local::. - name: Run examples run: | options(crayon.enabled = TRUE) - devtools::run_examples(fresh = TRUE, run_dontrun = TRUE, run_donttest = TRUE) + pkgload::load_all() + setwd("man") + for (rd in list.files(pattern = "\\.Rd")) pkgload::run_example(rd, run_dontrun = TRUE, run_donttest = TRUE, quiet = TRUE) shell: Rscript {0} diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 6ab847c84..32b3f16ba 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -21,6 +21,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: | + any::cyclocomp r-lib/lintr local::. needs: lint diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 921325d8e..3d75fb082 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -39,7 +39,7 @@ jobs: - name: Deploy to GitHub pages 🚀 if: github.event_name != 'pull_request' - uses: JamesIves/github-pages-deploy-action@v4.5.0 + uses: JamesIves/github-pages-deploy-action@v4.6.3 with: clean: false branch: gh-pages diff --git a/.github/workflows/test-coverage-examples.yaml b/.github/workflows/test-coverage-examples.yaml new file mode 100644 index 000000000..b0c58c2f0 --- /dev/null +++ b/.github/workflows/test-coverage-examples.yaml @@ -0,0 +1,71 @@ +on: + schedule: + # * is a special character in YAML so you have to quote this string + # Trigger once a month at 10:00 on the first day of every month + - cron: "00 10 1 * *" + +name: test-coverage-examples + +jobs: + test-coverage-examples: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: | + any::covr + local::. + + - name: Test example coverage + run: | + options(crayon.enabled = TRUE) + library(covr) + files_to_exclude <- c( + # examples present but not run + "R/lint.R", + "R/use_lintr.R", + # mostly internal utilities + "R/actions.R", + "R/cache.R", + "R/deprecated.R", + "R/exclude.R", + "R/extract.R", + "R/ids_with_token.R", + "R/lintr-deprecated.R", + "R/make_linter_from_regex.R", + "R/make_linter_from_xpath.R", + "R/namespace.R", + "R/methods.R", + "R/settings.R", + "R/shared_constants.R", + "R/with.R", + "R/with_id.R", + "R/zzz.R" + ) + coverage <- covr::package_coverage( + type = "examples", + quiet = TRUE, + commentDonttest = FALSE, + commentDontrun = FALSE, + line_exclusions = files_to_exclude + ) + print(coverage) + percent_coverage <- as.integer(covr::percent_coverage(coverage)) + threshold <- 90 + cli::cli_rule() + if (percent_coverage < threshold) { + cli::cli_abort("Code coverage using examples ({percent_coverage}%) is below the required threshold ({threshold}%).") + } else { + cli::cli_alert_success("Code coverage using examples ({percent_coverage}%) is above the required threshold ({threshold}%).") + } + cli::cli_rule() + shell: Rscript {0} diff --git a/.github/workflows/test-package-vigilant.yaml b/.github/workflows/test-package-vigilant.yaml index d7c7c7047..414385293 100644 --- a/.github/workflows/test-package-vigilant.yaml +++ b/.github/workflows/test-package-vigilant.yaml @@ -27,7 +27,13 @@ jobs: - name: Run Tests run: | ## -------------------------------------------------------------------- - options(crayon.enabled = TRUE, warn = 2L) + options( + crayon.enabled = TRUE, + warn = 2L, + warnPartialMatchArgs = TRUE, + warnPartialMatchAttr = TRUE, + warnPartialMatchDollar = TRUE + ) if (Sys.getenv("_R_CHECK_FORCE_SUGGESTS_", "") == "") Sys.setenv("_R_CHECK_FORCE_SUGGESTS_" = "false") testthat::test_dir("tests") shell: Rscript {0} diff --git a/.lintr b/.lintr index e9b2a3cb0..dd04ff1d4 100644 --- a/.lintr +++ b/.lintr @@ -14,7 +14,11 @@ linters: all_linters( undesirable_function_linter(modify_defaults( defaults = default_undesirable_functions, library = NULL, - options = NULL + options = NULL, + message = "use cli::cli_inform()", + warning = "use cli::cli_warn()", + stop = "use cli::cli_abort()", + normalizePath = "use normalize_path()" )), undesirable_operator_linter(modify_defaults( defaults = default_undesirable_operators, @@ -25,6 +29,8 @@ linters: all_linters( absolute_path_linter = NULL, library_call_linter = NULL, nonportable_path_linter = NULL, + # We now require R>=4.0.0 + strings_as_factors_linter = NULL, todo_comment_linter = NULL, # TODO(#2327): Enable this. unreachable_code_linter = NULL diff --git a/COPYING b/COPYING index c5ea39cc4..e9dd69174 100644 --- a/COPYING +++ b/COPYING @@ -1,4 +1,4 @@ -Copyright (c) 2014-2022, James Hester +Copyright (c) 2014-2024, James Hester Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/DESCRIPTION b/DESCRIPTION index 152323e62..4831fe875 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: lintr Title: A 'Linter' for R Code -Version: 3.1.1.9000 +Version: 3.1.2.9000 Authors@R: c( person("Jim", "Hester", , role = "aut"), person("Florent", "Angly", role = "aut", @@ -18,14 +18,14 @@ Description: Checks adherence to a given style, syntax errors and possible 'RStudio IDE', 'Emacs', 'Vim', 'Sublime Text', 'Atom' and 'Visual Studio Code'. License: MIT + file LICENSE -URL: https://github.com/r-lib/lintr, https://lintr.r-lib.org +URL: https://lintr.r-lib.org, https://github.com/r-lib/lintr BugReports: https://github.com/r-lib/lintr/issues Depends: - R (>= 3.6) + R (>= 4.0) Imports: backports (>= 1.1.7), + cli (>= 3.4.0), codetools, - cyclocomp, digest, glue, knitr, @@ -36,7 +36,7 @@ Imports: xmlparsedata (>= 1.0.5) Suggests: bookdown, - cli, + cyclocomp, jsonlite, patrick (>= 0.2.0), rlang, @@ -202,6 +202,7 @@ Collate: 'with.R' 'with_id.R' 'xml_nodes_to_lints.R' + 'xml_utils.R' 'yoda_test_linter.R' 'zzz.R' Language: en-US diff --git a/LICENSE b/LICENSE index 80d496dc7..0812fef1d 100644 --- a/LICENSE +++ b/LICENSE @@ -1,2 +1,2 @@ -YEAR: 2014-2016 +YEAR: 2014-2024 COPYRIGHT HOLDER: James Hester diff --git a/NAMESPACE b/NAMESPACE index 00d9ad2e0..6b5c46937 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,11 +1,5 @@ # Generated by roxygen2: do not edit by hand - -if (getRversion() >= "4.0.0") { - importFrom(tools, R_user_dir) -} else { - importFrom(backports, R_user_dir) -} S3method("[",lints) S3method(as.data.frame,lints) S3method(format,lint) @@ -57,6 +51,7 @@ export(expect_length_linter) export(expect_lint) export(expect_lint_free) export(expect_named_linter) +export(expect_no_lint) export(expect_not_linter) export(expect_null_linter) export(expect_s3_class_linter) @@ -171,7 +166,9 @@ export(with_id) export(xml_nodes_to_lints) export(xp_call_name) export(yoda_test_linter) -importFrom(cyclocomp,cyclocomp) +importFrom(cli,cli_abort) +importFrom(cli,cli_inform) +importFrom(cli,cli_warn) importFrom(glue,glue) importFrom(glue,glue_collapse) importFrom(rex,character_class) @@ -180,6 +177,7 @@ importFrom(rex,re_substitutes) importFrom(rex,regex) importFrom(rex,rex) importFrom(stats,na.omit) +importFrom(tools,R_user_dir) importFrom(utils,capture.output) importFrom(utils,getParseData) importFrom(utils,getTxtProgressBar) diff --git a/NEWS.md b/NEWS.md index 39004d946..e7871d097 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,13 +14,19 @@ * Adjusted various lint messages for consistency in readability (#1330, @MichaelChirico). In general, we favor lint messages to be phrased like "Action, reason" to but the "what" piece of the message front-and-center. This may be a breaking change for code that tests the specific phrasing of lints. * `extraction_operator_linter()` is deprecated. Although switching from `$` to `[[` has some robustness benefits for package code, it can lead to non-idiomatic code in many contexts (e.g. R6 classes, Shiny applications, etc.) (#2409, @IndrajeetPatil). To enable the detection of the `$` operator for extraction through partial matching, use `options(warnPartialMatchDollar = TRUE)`. * `unnecessary_nested_if_linter()` is deprecated and subsumed into the new/more general `unnecessary_nesting_linter()`. -* Drop support for posting GitHub comments from inside Travis, Wercker, and Jenkins CI tools (spurred by #2148, @MichaelChirico). We rely on GitHub Actions for linting in CI, and don't see any active users relying on these alternatives. We welcome and encourage community contributions to get support for different CI system going again. +* Drop support for posting GitHub comments from inside GitHub comment bot, Travis, Wercker, and Jenkins CI tools (spurred by #2148, @MichaelChirico). We rely on GitHub Actions for linting in CI, and don't see any active users relying on these alternatives. We welcome and encourage community contributions to get support for different CI system going again. +* `cyclocomp_linter()` is no longer part of the default linters (#2555, @IndrajeetPatil) because the tidyverse style guide doesn't contain any guidelines on meeting certain complexity requirements. Note that users with `cyclocomp_linter()` in their configs may now need to install {cyclocomp} intentionally, in particular in CI/CD pipelines. +* `scalar_in_linter` is now configurable to allow other `%in%` like operators to be linted. The data.table operator `%chin%` is no longer linted by default; use `in_operators = "%chin%"` to continue linting it. (@F-Noelle) +* `lint()` and friends now normalize paths to forward slashes on Windows (@olivroy, #2613). ## Bug fixes +* `expect_identical_linter()` also skips `expect_equal()` comparison to _negative_ non-integers like `-1.034` (#2411, @Bisaloo). This is a parity fix since _positive_ reals have always been skipped because "high-precision" comparisons are typically done to get tests within `tolerance`, so `expect_identical()` is not a great substitution. * `object_name_linter()` no longer errors when user-supplied `regexes=` have capture groups (#2188, @MichaelChirico). * `.lintr` config validation correctly accepts regular expressions which only compile under `perl = TRUE` (#2375, @MichaelChirico). These have always been valid (since `rex::re_matches()`, which powers the lint exclusion logic, also uses this setting), but the new up-front validation in v3.1.1 incorrectly used `perl = FALSE`. * `.lintr` configs set by option `lintr.linter_file` or environment variable `R_LINTR_LINTER_FILE` can point to subdirectories (#2512, @MichaelChirico). +* `indentation_linter()` returns `ranges[1L]==1L` when the offending line has 0 spaces (#2550, @MichaelChirico). +* `literal_coercion_linter()` doesn't surface a warning about NAs during coercion for code like `as.integer("a")` (#2566, @MichaelChirico). ## Changes to default linters @@ -50,6 +56,9 @@ * `vector_logic_linter()` is extended to recognize incorrect usage of scalar operators `&&` and `||` inside subsetting expressions like `dplyr::filter(x, A && B)` (#2166, @MichaelChirico). * `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico). * `brace_linter()`' has a new argument `function_bodies` (default `"multi_line"`) which controls whether to require function bodies to be wrapped in curly braces, with the options `"always"`, `"multi_line"` (only require curly braces when a function body spans over multiple lines), `"not_inline"` (only require curly braces when a function body starts on a new line) and `"never"` (#1807, #2240, @salim-b). +* `make_linter_from_xpath()` errors up front when `lint_message` is missing (instead of delaying this error until the linter is used, #2541, @MichaelChirico). +* `paste_linter()` is extended to recommend using `paste()` instead of `paste0()` for simply aggregating a character vector with `collapse=`, i.e., when `sep=` is irrelevant (#1108, @MichaelChirico). +* `expect_no_lint()` was added as new function to cover the typical use case of expecting no lint message, akin to the recent {testthat} functions like `expect_no_warning()` (#2580, @F-Noelle). ### New linters @@ -72,6 +81,15 @@ * `one_call_pipe_linter()` for discouraging one-step pipelines like `x |> as.character()` (#2330 and part of #884, @MichaelChirico). * `object_overwrite_linter()` for discouraging re-use of upstream package exports as local variables (#2344, #2346 and part of #884, @MichaelChirico and @AshesITR). +### Lint accuracy fixes: removing false positives + +* `object_name_linter()` and `object_length_linter()` ignore {rlang} name injection like `x |> mutate("{new_name}" := foo(col))` (#1926, @MichaelChirico). No checking is applied in such cases. {data.table} in-place assignments like `DT[, "sPoNGeBob" := "friend"]` are still eligible for lints. + +## Notes + +* All user-facing messages are now prepared using the `{cli}` package (#2418, @IndrajeetPatil). All messages have been reviewed and updated to be more informative and consistent. +* {lintr} now depends on R version 4.0.0. It already does so implicitly due to recursive upstream dependencies requiring this version; we've simply made that dependency explicit and up-front (#2569, @MichaelChirico). + # lintr 3.1.2 ## New and improved features diff --git a/R/absolute_path_linter.R b/R/absolute_path_linter.R index a27ebc1ea..38fffd40b 100644 --- a/R/absolute_path_linter.R +++ b/R/absolute_path_linter.R @@ -8,9 +8,7 @@ #' * contain at least two path elements, with one having at least two characters and #' * contain only alphanumeric chars (including UTF-8), spaces, and win32-allowed punctuation #' -#' @examplesIf getRversion() >= "4.0" -#' # Following examples use raw character constant syntax introduced in R 4.0. -#' +#' @examples #' # will produce lints #' lint( #' text = 'R"--[/blah/file.txt]--"', diff --git a/R/addins.R b/R/addins.R index d47b4fc95..5aaee41ae 100644 --- a/R/addins.R +++ b/R/addins.R @@ -1,11 +1,12 @@ # nocov start addin_lint <- function() { if (!requireNamespace("rstudioapi", quietly = TRUE)) { - stop("'rstudioapi' is required for add-ins.", call. = FALSE) + cli_abort("{.pkg rstudioapi} is required for add-ins.") } filename <- rstudioapi::getSourceEditorContext() if (filename$path == "") { - return("Current source has no path. Please save before continue") + cli_warn("Current source has no path. Please save before continuing.") + return(flatten_lints(list())) } lint(filename$path) @@ -13,11 +14,11 @@ addin_lint <- function() { addin_lint_package <- function() { if (!requireNamespace("rstudioapi", quietly = TRUE)) { - stop("'rstudioapi' is required for add-ins.", call. = FALSE) + cli_abort("{.pkg rstudioapi} is required for add-ins.") } project <- rstudioapi::getActiveProject() if (is.null(project)) { - message("No project found, passing current directory") + cli_inform("No project found, passing current directory.") project_path <- getwd() } else { project_path <- project diff --git a/R/backport_linter.R b/R/backport_linter.R index 3c1eaeaeb..4d1e81d0b 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -30,6 +30,11 @@ #' linters = backport_linter("4.0.0") #' ) #' +#' lint( +#' text = "str2lang(x)", +#' linters = backport_linter("3.2.0", except = "str2lang") +#' ) +#' #' @evalRd rd_tags("backport_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' @export @@ -93,7 +98,11 @@ normalize_r_version <- function(r_version) { version_names <- c("devel", "release", paste0("oldrel-", seq_len(length(minor_versions) - 2L))) if (!r_version %in% version_names) { # This can only trip if e.g. oldrel-99 is requested - stop("`r_version` must be a version number or one of ", toString(sQuote(version_names)), call. = FALSE) + cli_abort(c( + "{.arg r_version} is not valid:", + i = "It must be a version number or one of {.str {version_names}}.", + x = "You entered {.str {r_version}} instead." + )) } requested_version <- minor_versions[match(r_version, table = version_names)] available_patches <- all_versions[startsWith(all_versions, requested_version)] @@ -105,13 +114,13 @@ normalize_r_version <- function(r_version) { } else if (is.character(r_version)) { r_version <- R_system_version(r_version, strict = TRUE) } else if (!inherits(r_version, "R_system_version")) { - stop("`r_version` must be a R version number, returned by R_system_version(), or a string.", call. = FALSE) + cli_abort("{.arg r_version} must be an R version number, returned by {.fun R_system_version}, or a string.") } if (r_version < "3.0.0") { - warning( - "It is not recommended to depend on an R version older than 3.0.0. Resetting 'r_version' to 3.0.0.", - call. = FALSE - ) + cli_warn(c( + x = "Depending on an R version older than {.val 3.0.0} is not recommended.", + i = "Resetting {.arg r_version} to {.val 3.0.0}." + )) r_version <- R_system_version("3.0.0") } r_version diff --git a/R/cache.R b/R/cache.R index 1db84212e..b177f4305 100644 --- a/R/cache.R +++ b/R/cache.R @@ -53,10 +53,9 @@ load_cache <- function(file, path = NULL) { invokeRestart("muffleWarning") }, error = function(e) { - warning( - "Could not load cache file '", file, "':\n", - conditionMessage(e), - call. = FALSE + cli_warn( + "Could not load cache file {.file {file}}:", + parent = e ) } ) diff --git a/R/condition_call_linter.R b/R/condition_call_linter.R index 8b13c8a92..188247edb 100644 --- a/R/condition_call_linter.R +++ b/R/condition_call_linter.R @@ -4,7 +4,7 @@ #' recommendation of the tidyverse design guide regarding displaying error #' calls. #' -#' @param display_call Logical specifying expected behaviour regarding `call.` +#' @param display_call Logical specifying expected behavior regarding `call.` #' argument in conditions. #' - `NA` forces providing `call. =` but ignores its value (this can be used in #' cases where you expect a mix of `call. = FALSE` and `call. = TRUE`) diff --git a/R/cyclocomp_linter.R b/R/cyclocomp_linter.R index c5563646f..5a64156bd 100644 --- a/R/cyclocomp_linter.R +++ b/R/cyclocomp_linter.R @@ -1,11 +1,11 @@ #' Cyclomatic complexity linter #' -#' Check for overly complicated expressions. See [cyclocomp::cyclocomp()]. +#' Check for overly complicated expressions. See `cyclocomp()` function from `{cyclocomp}`. #' -#' @param complexity_limit Maximum cyclomatic complexity, default 15. Expressions more complex -#' than this are linted. See [cyclocomp::cyclocomp()]. +#' @param complexity_limit Maximum cyclomatic complexity, default `15`. Expressions more complex +#' than this are linted. #' -#' @examples +#' @examplesIf requireNamespace("cyclocomp", quietly = TRUE) #' # will produce lints #' lint( #' text = "if (TRUE) 1 else 2", @@ -23,6 +23,15 @@ #' @export cyclocomp_linter <- function(complexity_limit = 15L) { Linter(linter_level = "expression", function(source_expression) { + # nocov start + if (!requireNamespace("cyclocomp", quietly = TRUE)) { + cli::cli_abort(c( + "Cyclocomp complexity is computed using {.fn cyclocomp::cyclocomp}.", + i = "Please install the needed {.pkg cyclocomp} package." + )) + } + # nocov end + complexity <- try_silently( cyclocomp::cyclocomp(parse(text = source_expression$content)) ) diff --git a/R/deprecated.R b/R/deprecated.R index 78ceefd75..a8b26e3c9 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -15,6 +15,6 @@ lintr_deprecated <- function(what, alternative = NULL, version = NULL, ". ", if (length(alternative) > 0L) c("Use ", alternative, " instead.") ) - msg <- paste0(msg, collapse = "") + msg <- paste(msg, collapse = "") signal(msg, call. = FALSE, domain = NA) } diff --git a/R/exclude.R b/R/exclude.R index a5462c290..25a924cea 100644 --- a/R/exclude.R +++ b/R/exclude.R @@ -30,6 +30,8 @@ #' " a character vector of files to exclude or a vector of lines to exclude.", #' NULL #' ) +#' +#' @keywords internal exclude <- function(lints, exclusions = settings$exclusions, linter_names = NULL, ...) { if (length(lints) <= 0L) { return(lints) @@ -100,6 +102,7 @@ line_info <- function(line_numbers, type = c("start", "end")) { #' @param linter_names Names of active linters. #' #' @return A possibly named list of excluded lines, possibly for specific linters. +#' @keywords internal parse_exclusions <- function(file, exclude = settings$exclude, exclude_next = settings$exclude_next, @@ -127,9 +130,12 @@ parse_exclusions <- function(file, if (length(starts) > 0L) { if (length(starts) != length(ends)) { - starts_msg <- line_info(starts, type = "start") - ends_msg <- line_info(ends, type = "end") - stop(file, " has ", starts_msg, " but only ", ends_msg, " for exclusion from linting!", call. = FALSE) + starts_msg <- line_info(starts, type = "start") # nolint: object_usage_linter. TODO(#2252). + ends_msg <- line_info(ends, type = "end") # nolint: object_usage_linter. TODO(#2252). + cli_abort(c( + i = "Equal number of line starts and ends expected for exclusion from linting.", + x = "{.file {file}} has {.strong {starts_msg}} and {.strong {ends_msg}}." + )) } for (i in seq_along(starts)) { @@ -200,13 +206,11 @@ add_exclusions <- function(exclusions, lines, linters_string, exclude_linter_sep idxs <- pmatch(excluded_linters, linter_names, duplicates.ok = TRUE) matched <- !is.na(idxs) if (!all(matched)) { - bad <- excluded_linters[!matched] - warning( - "Could not find linter", if (length(bad) > 1L) "s" else "", " named ", - glue_collapse(sQuote(bad), sep = ", ", last = " and "), - " in the list of active linters. Make sure the linter is uniquely identified by the given name or prefix.", - call. = FALSE - ) + bad <- excluded_linters[!matched] # nolint: object_usage_linter. TODO(#2252). + cli_warn(c( + x = "Could not find linter{?s} named {.field {bad}} in the list of active linters.", + i = "Make sure the linter is uniquely identified by the given name or prefix." + )) } excluded_linters[matched] <- linter_names[idxs[matched]] } @@ -248,7 +252,6 @@ normalize_exclusions <- function(x, normalize_path = TRUE, x <- as.list(x) unnamed <- !nzchar(names2(x)) if (any(unnamed)) { - # must be character vectors of length 1 bad <- vapply( seq_along(x), function(i) { @@ -258,12 +261,10 @@ normalize_exclusions <- function(x, normalize_path = TRUE, ) if (any(bad)) { - stop( - "Full file exclusions must be character vectors of length 1. items: ", - toString(which(bad)), - " are not!", - call. = FALSE - ) + cli_abort(c( + i = "Full file exclusions must be {.cls character} vectors of length 1.", + x = "Items at the following indices are not: {.val {which(bad)}}." + )) } # Normalize unnamed entries to list( = list(Inf), ...) names(x)[unnamed] <- x[unnamed] @@ -278,12 +279,10 @@ normalize_exclusions <- function(x, normalize_path = TRUE, bad <- full_line_exclusions & !are_numeric if (any(bad)) { - stop( - "Full line exclusions must be numeric or integer vectors. items: ", - toString(which(bad)), - " are not!", - call. = FALSE - ) + cli_abort(c( + i = "Full line exclusions must be {.cls numeric} or {.cls integer} vectors.", + x = "Items at the following indices are not: {.val {which(bad)}}." + )) } # Normalize list( = c()) to @@ -327,7 +326,7 @@ normalize_exclusions <- function(x, normalize_path = TRUE, paths[rel_path] <- file.path(root, paths[rel_path]) names(x) <- paths x <- x[file.exists(paths)] # remove exclusions for non-existing files - names(x) <- normalizePath(names(x)) # get full path for remaining files + names(x) <- normalize_path(names(x)) # get full path for remaining files } remove_line_duplicates( diff --git a/R/expect_identical_linter.R b/R/expect_identical_linter.R index 4ca6bf04a..e4befe6ce 100644 --- a/R/expect_identical_linter.R +++ b/R/expect_identical_linter.R @@ -60,18 +60,38 @@ expect_identical_linter <- function() { # - skip cases like expect_equal(x, 1.02) or the constant vector version # where a numeric constant indicates inexact testing is preferable # - skip calls using dots (`...`); see tests - expect_equal_xpath <- " + non_integer <- glue::glue(" + NUM_CONST[contains(text(), '.')] + or ( + OP-MINUS + and count(expr) = 1 + and expr[NUM_CONST[contains(text(), '.')]] + ) + ") + + expect_equal_xpath <- glue::glue(" parent::expr[not( following-sibling::EQ_SUB or following-sibling::expr[ - expr[1][SYMBOL_FUNCTION_CALL[text() = 'c']] - and expr[NUM_CONST[contains(text(), '.')]] + ( + expr[1][SYMBOL_FUNCTION_CALL[text() = 'c']] + and expr[{non_integer}] + ) or ( + {non_integer} + ) or ( + OP-MINUS + and count(expr) = 1 + and expr[ + expr[1][SYMBOL_FUNCTION_CALL[text() = 'c']] + and expr[{non_integer}] + ] + ) or ( + SYMBOL[text() = '...'] + ) ] - or following-sibling::expr[NUM_CONST[contains(text(), '.')]] - or following-sibling::expr[SYMBOL[text() = '...']] )] /parent::expr - " + ") expect_true_xpath <- " parent::expr /following-sibling::expr[1][expr[1]/SYMBOL_FUNCTION_CALL[text() = 'identical']] diff --git a/R/expect_lint.R b/R/expect_lint.R index 2cc8e1f9e..7bc1b65fd 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -1,6 +1,8 @@ #' Lint expectation #' -#' This is an expectation function to test that the lints produced by `lint` satisfy a number of checks. +#' These are expectation functions to test specified linters on sample code in the `testthat` testing framework. +#' * `expect_lint` asserts that specified lints are generated. +#' * `expect_no_lint` asserts that no lints are generated. #' #' @param content a character vector for the file content to be linted, each vector element representing a line of #' text. @@ -22,7 +24,7 @@ #' @return `NULL`, invisibly. #' @examples #' # no expected lint -#' expect_lint("a", NULL, trailing_blank_lines_linter()) +#' expect_no_lint("a", trailing_blank_lines_linter()) #' #' # one expected lint #' expect_lint("a\n", "trailing blank", trailing_blank_lines_linter()) @@ -41,10 +43,12 @@ #' @export expect_lint <- function(content, checks, ..., file = NULL, language = "en") { if (!requireNamespace("testthat", quietly = TRUE)) { - stop( # nocov start - "'expect_lint' is designed to work within the 'testthat' testing framework, but 'testthat' is not installed.", - call. = FALSE - ) # nocov end + # nocov start + cli_abort( + # nolint next: line_length_linter. + "{.fun expect_lint} and {.fun expect_no_lint} are designed to work within the {.pkg testthat} testing framework, which is not installed." + ) + # nocov end } old_lang <- set_lang(language) on.exit(reset_lang(old_lang)) @@ -61,7 +65,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { lints <- lint(file, ...) n_lints <- length(lints) - lint_str <- if (n_lints) paste0(c("", lints), collapse = "\n") else "" + lint_str <- if (n_lints) paste(c("", lints), collapse = "\n") else "" wrong_number_fmt <- "got %d lints instead of %d%s" if (is.null(checks)) { @@ -88,10 +92,10 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { itr <<- itr + 1L lapply(names(check), function(field) { if (!field %in% lint_fields) { - stop(sprintf( - "check #%d had an invalid field: \"%s\"\nValid fields are: %s\n", - itr, field, toString(lint_fields) - ), call. = FALSE) + cli_abort(c( + x = "Check {.val {itr}} has an invalid field: {.field {field}}.", + i = "Valid fields are: {.field {lint_fields}}." + )) } check <- check[[field]] value <- lint[[field]] @@ -106,11 +110,10 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { isTRUE(all.equal(value, check)) } if (!is.logical(ok)) { - stop( - "Invalid regex result, did you mistakenly have a capture group in the regex? ", - "Be sure to escape parenthesis with `[]`", - call. = FALSE - ) + cli_abort(c( + x = "Invalid regex result. Did you mistakenly have a capture group in the regex?", + i = "You can match parentheses with a character class, i.e. inside `[]`." + )) } testthat::expect(ok, msg) }) @@ -123,11 +126,16 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { invisible(NULL) } +#' @rdname expect_lint +#' @export +expect_no_lint <- function(content, ..., file = NULL, language = "en") { + expect_lint(content, NULL, ..., file = file, language = language) +} #' Test that the package is lint free #' #' This function is a thin wrapper around lint_package that simply tests there are no -#' lints in the package. It can be used to ensure that your tests fail if the package +#' lints in the package. It can be used to ensure that your tests fail if the package #' contains lints. #' #' @param ... arguments passed to [lint_package()] diff --git a/R/extract.R b/R/extract.R index 4c21e41df..c9aa57b70 100644 --- a/R/extract.R +++ b/R/extract.R @@ -51,7 +51,7 @@ get_knitr_pattern <- function(filename, lines) { ("knitr" %:::% "detect_pattern")(lines, tolower(("knitr" %:::% "file_ext")(filename))), warning = function(cond) { if (!grepl("invalid UTF-8", conditionMessage(cond), fixed = TRUE)) { - warning(cond, call. = FALSE) + cli_warn(cond) } invokeRestart("muffleWarning") } @@ -119,8 +119,8 @@ filter_chunk_end_positions <- function(starts, ends) { bad_end_indexes <- grep("starts", names(code_ends), fixed = TRUE) if (length(bad_end_indexes) > 0L) { bad_start_positions <- positions[code_start_indexes[bad_end_indexes]] - # This error message is formatted like a parse error - stop(sprintf( + # This error message is formatted like a parse error; don't use {cli} + stop(sprintf( # nolint: undesirable_function_linter ":%1$d:1: Missing chunk end for chunk (maybe starting at line %1$d).\n", bad_start_positions[1L] ), call. = FALSE) diff --git a/R/get_source_expressions.R b/R/get_source_expressions.R index bc83712d5..ec8a4d406 100644 --- a/R/get_source_expressions.R +++ b/R/get_source_expressions.R @@ -636,8 +636,7 @@ fix_eq_assigns <- function(pc) { parent = integer(n_expr), token = character(n_expr), terminal = logical(n_expr), - text = character(n_expr), - stringsAsFactors = FALSE + text = character(n_expr) ) for (i in seq_len(n_expr)) { diff --git a/R/implicit_integer_linter.R b/R/implicit_integer_linter.R index 49e57c52e..90e2a3cf3 100644 --- a/R/implicit_integer_linter.R +++ b/R/implicit_integer_linter.R @@ -62,7 +62,7 @@ implicit_integer_linter <- function(allow_colon = FALSE) { is_negative <- !is.na(xml_find_first(number_expr, "parent::expr/preceding-sibling::OP-MINUS")) lint_message <- - sprintf("Use %1$dL or %1$d.0 to avoid implicit integers.", ((-1L) ^ is_negative) * as.integer(number)) + sprintf("Use %1$dL or %1$d.0 to avoid implicit integers.", ((-1L)^is_negative) * as.integer(number)) xml_nodes_to_lints( number_expr, diff --git a/R/indentation_linter.R b/R/indentation_linter.R index f5496d0a7..a89f3da7c 100644 --- a/R/indentation_linter.R +++ b/R/indentation_linter.R @@ -276,9 +276,13 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al ) lint_lines <- unname(as.integer(names(source_expression$file_lines)[bad_lines])) lint_ranges <- cbind( - pmin(expected_indent_levels[bad_lines] + 1L, indent_levels[bad_lines]), + # when indent_levels==0, need to start ranges at column 1. + pmax( + pmin(expected_indent_levels[bad_lines] + 1L, indent_levels[bad_lines]), + 1L + ), # If the expected indent is larger than the current line width, the lint range would become invalid. - # Therefor, limit range end to end of line. + # Therefore, limit range end to end of line. pmin( pmax(expected_indent_levels[bad_lines], indent_levels[bad_lines]), nchar(source_expression$file_lines[bad_lines]) + 1L diff --git a/R/inner_combine_linter.R b/R/inner_combine_linter.R index b83a120a3..bac85955e 100644 --- a/R/inner_combine_linter.R +++ b/R/inner_combine_linter.R @@ -6,6 +6,13 @@ #' preferred so that the most expensive part of the operation ([as.Date()]) #' is applied only once. #' +#' Note that [strptime()] has one idiosyncrasy to be aware of, namely that +#' auto-detected `format=` is set by the first matching input, which means +#' that a case like `c(as.POSIXct("2024-01-01"), as.POSIXct("2024-01-01 01:02:03"))` +#' gives different results to `as.POSIXct(c("2024-01-01", "2024-01-01 01:02:03"))`. +#' This false positive is rare; a workaround where possible is to use +#' consistent formatting, i.e., `"2024-01-01 00:00:00"` in the example. +#' #' @examples #' # will produce lints #' lint( diff --git a/R/lint.R b/R/lint.R index 4435cb081..042fbeaca 100644 --- a/R/lint.R +++ b/R/lint.R @@ -52,7 +52,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = close(con) } - filename <- normalizePath(filename, mustWork = !inline_data) # to ensure a unique file in cache + filename <- normalize_path(filename, mustWork = !inline_data) # to ensure a unique file in cache source_expressions <- get_source_expressions(filename, lines) if (isTRUE(parse_settings)) { @@ -88,7 +88,10 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = lints[[length(lints) + 1L]] <- withCallingHandlers( get_lints(expr, linter, linters[[linter]], lint_cache, source_expressions$lines), error = function(cond) { - stop("Linter '", linter, "' failed in ", filename, ": ", conditionMessage(cond), call. = FALSE) + cli_abort( + "Linter {.fn linter} failed in {.file {filename}}:", + parent = cond + ) } ) } @@ -160,9 +163,10 @@ lint_dir <- function(path = ".", ..., pattern = pattern ) - # normalizePath ensures names(exclusions) and files have the same names for the same files. + # normalize_path ensures names(exclusions) and files have the same names for the same files. + # It also ensures all paths have forward slash # Otherwise on windows, files might incorrectly not be excluded in to_exclude - files <- normalizePath(dir( + files <- normalize_path(dir( path, pattern = pattern, recursive = TRUE, @@ -195,7 +199,7 @@ lint_dir <- function(path = ".", ..., lints <- reorder_lints(lints) if (relative_path) { - path <- normalizePath(path, mustWork = FALSE) + path <- normalize_path(path, mustWork = FALSE) lints[] <- lapply( lints, function(x) { @@ -237,15 +241,17 @@ lint_package <- function(path = ".", ..., parse_settings = TRUE, show_progress = NULL) { if (length(path) > 1L) { - stop("Only linting one package at a time is supported.", call. = FALSE) + cli_abort(c( + x = "Only linting one package at a time is supported.", + i = "Instead, {.val {length(path)}} package paths were provided." + )) } pkg_path <- find_package(path) if (is.null(pkg_path)) { - warning( - sprintf("Didn't find any R package searching upwards from '%s'.", normalizePath(path)), - call. = FALSE - ) + cli_warn(c( + i = "Didn't find any R package searching upwards from {.file {normalize_path(path)}}" + )) return(NULL) } @@ -269,7 +275,7 @@ lint_package <- function(path = ".", ..., ) if (isTRUE(relative_path)) { - path <- normalizePath(pkg_path, mustWork = FALSE) + path <- normalize_path(pkg_path, mustWork = FALSE) lints[] <- lapply( lints, function(x) { @@ -335,10 +341,10 @@ validate_linter_object <- function(linter, name) { return(linter) } if (!is.function(linter)) { - stop(gettextf( - "Expected '%s' to be a function of class 'linter', not a %s of class '%s'", - name, typeof(linter), class(linter)[[1L]] - ), call. = FALSE) + cli_abort(c( + i = "Expected {.fn {name}} to be a function of class {.cls linter}.", + x = "Instead, it is {.obj_type_friendly {linter}}." + )) } if (is_linter_factory(linter)) { what <- "Passing linters as variables" @@ -401,17 +407,17 @@ Lint <- function(filename, line_number = 1L, column_number = 1L, # nolint: objec } if (length(line) != 1L || !is.character(line)) { - stop("`line` must be a string.", call. = FALSE) + cli_abort("{.arg line} must be a string.", call. = FALSE) } max_col <- max(nchar(line) + 1L, 1L, na.rm = TRUE) if (!is_number(column_number) || column_number < 0L || column_number > max_col) { - stop(sprintf( - "`column_number` must be an integer between 0 and nchar(line) + 1 (%d). It was %s.", - max_col, column_number - ), call. = FALSE) + cli_abort(" + {.arg column_number} must be an integer between {.val {0}} and {.val {max_col}} ({.code nchar(line) + 1}), + not {.obj_type_friendly {column_number}}. + ") } if (!is_number(line_number) || line_number < 1L) { - stop(sprintf("`line_number` must be a positive integer. It was %s.", line_number), call. = FALSE) + cli_abort("{.arg line_number} must be a positive integer, not {.obj_type_friendly {line_number}}.") } check_ranges(ranges, max_col) @@ -422,7 +428,7 @@ Lint <- function(filename, line_number = 1L, column_number = 1L, # nolint: objec line_number = as.integer(line_number), column_number = as.integer(column_number), type = type, - message = message, + message = message, # nolint: undesirable_function_linter line = line, ranges = ranges, linter = NA_character_ @@ -441,28 +447,35 @@ is_valid_range <- function(range, max_col) { range[[2L]] <= max_col } -check_ranges <- function(ranges, max_col) { +check_ranges <- function(ranges, max_col, call = parent.frame()) { if (is.null(ranges)) { return() } if (!is.list(ranges)) { - stop("`ranges` must be NULL or a list.", call. = FALSE) + cli_abort( + "{.arg ranges} must be {.code NULL} or a list, not {.obj_type_friendly {ranges}}.", + call = call + ) } for (range in ranges) { if (!is_number(range, 2L)) { - stop("`ranges` must only contain length 2 integer vectors without NAs.", call. = FALSE) + cli_abort( + "{.arg ranges} must only contain integer vectors of length 2 without {.code NA}s.", + call = call + ) } else if (!is_valid_range(range, max_col)) { - stop(sprintf( - "All entries in `ranges` must satisfy 0 <= range[1L] <= range[2L] <= nchar(line) + 1 (%d).", max_col - ), call. = FALSE) + cli_abort( + "{.arg ranges} must satisfy {.val {0}} <= range[1L] <= range[2L] <= {.val {max_col}} (nchar(line) + 1).", + call = call + ) } } } rstudio_source_markers <- function(lints) { if (!requireNamespace("rstudioapi", quietly = TRUE)) { - stop("'rstudioapi' is required for rstudio_source_markers().", call. = FALSE) # nocov + cli_abort("{.pkg rstudioapi} is required for {.fn rstudio_source_markers}.") # nocov } # package path will be NULL unless it is a relative path @@ -555,14 +568,14 @@ checkstyle_output <- function(lints, filename = "lintr_results.xml") { #' @export sarif_output <- function(lints, filename = "lintr_results.sarif") { if (!requireNamespace("jsonlite", quietly = TRUE)) { - stop("'jsonlite' is required to produce SARIF reports, please install to continue.", call. = FALSE) # nocov + cli_abort("{.pkg jsonlite} is required to produce SARIF reports. Please install to continue.") # nocov } # package path will be `NULL` unless it is a relative path package_path <- attr(lints, "path") if (is.null(package_path)) { - stop("Package path needs to be a relative path.", call. = FALSE) + cli_abort("Package path needs to be a relative path.") } # setup template @@ -666,7 +679,7 @@ highlight_string <- function(message, column_number = NULL, ranges = NULL) { } fill_with <- function(character = " ", length = 1L) { - paste0(collapse = "", rep.int(character, length)) + paste(collapse = "", rep.int(character, length)) } has_positional_logical <- function(dots) { diff --git a/R/linter_tags.R b/R/linter_tags.R index 3bf581013..451ddd565 100644 --- a/R/linter_tags.R +++ b/R/linter_tags.R @@ -49,13 +49,13 @@ #' @export available_linters <- function(packages = "lintr", tags = NULL, exclude_tags = "deprecated") { if (!is.character(packages)) { - stop("`packages` must be a character vector.", call. = FALSE) + cli_abort("{.arg packages} must be a {.cls character} vector.") } if (!is.null(tags) && !is.character(tags)) { - stop("`tags` must be a character vector.", call. = FALSE) + cli_abort("{.arg tags} must be a {.cls character} vector.") } if (!is.null(exclude_tags) && !is.character(exclude_tags)) { - stop("`exclude_tags` must be a character vector.", call. = FALSE) + cli_abort("{.arg exclude_tags} must be a {.cls character} vector.") } # any tags specified explicitly will not be excluded (#1959) @@ -82,11 +82,7 @@ available_linters <- function(packages = "lintr", tags = NULL, exclude_tags = "d } build_available_linters <- function(available, package, tags, exclude_tags) { - available_df <- data.frame( - linter = available[["linter"]], - package, - stringsAsFactors = FALSE - ) + available_df <- data.frame(linter = available[["linter"]], package) available_df$tags <- strsplit(available[["tags"]], split = " ", fixed = TRUE) if (!is.null(tags)) { matches_tags <- vapply(available_df$tags, function(linter_tags) any(linter_tags %in% tags), logical(1L)) @@ -108,7 +104,7 @@ build_available_linters <- function(available, package, tags, exclude_tags) { #' `data.frame` constructors don't handle zero-row list-columns properly, so supply `tags` afterwards. #' @noRd empty_linters <- function() { - empty_df <- data.frame(linter = character(), package = character(), stringsAsFactors = FALSE) + empty_df <- data.frame(linter = character(), package = character()) empty_df$tags <- list() empty_df } @@ -117,13 +113,10 @@ validate_linter_db <- function(available, package) { # Check that the csv file contains two character columns, named 'linter' and 'tags'. # Otherwise, fallback to an empty data frame. if (!all(c("linter", "tags") %in% colnames(available))) { - warning( - "`linters.csv` must contain the columns 'linter' and 'tags'.\nPackage '", - package, "' is missing ", - paste0("'", setdiff(c("linter", "tags"), names(available)), "'", collapse = " and "), - ".", - call. = FALSE - ) + cli_warn(c( + i = "{.file linters.csv} must contain the columns {.val {c('linter', 'tags')}}.", + x = "Package {.pkg package} is missing {.str {setdiff(c('linter', 'tags'), names(available))}}." + )) return(FALSE) } nrow(available) > 0L @@ -153,7 +146,7 @@ rd_tags <- function(linter_name) { linters <- available_linters(exclude_tags = NULL) tags <- platform_independent_sort(linters[["tags"]][[match(linter_name, linters[["linter"]])]]) if (length(tags) == 0L) { - stop("tags are required, but found none for ", linter_name, call. = FALSE) + cli_abort("Tags are required, but found none for {.fn linter_name}.") } c( @@ -172,7 +165,7 @@ rd_linters <- function(tag_name) { linters <- available_linters(tags = tag_name) tagged <- platform_independent_sort(linters[["linter"]]) if (length(tagged) == 0L) { - stop("No linters found associated with tag ", tag_name, call. = FALSE) + cli_abort("No linters found associated with tag {.emph tag_name}.") } c( diff --git a/R/lintr-package.R b/R/lintr-package.R index 898db1445..70f8d0d11 100644 --- a/R/lintr-package.R +++ b/R/lintr-package.R @@ -8,20 +8,15 @@ "_PACKAGE" ## lintr namespace: start -#' @importFrom cyclocomp cyclocomp +#' @importFrom cli cli_inform cli_abort cli_warn #' @importFrom glue glue glue_collapse #' @importFrom rex rex regex re_matches re_substitutes character_class #' @importFrom stats na.omit +#' @importFrom tools R_user_dir #' @importFrom utils capture.output getParseData getTxtProgressBar globalVariables head relist #' setTxtProgressBar tail txtProgressBar #' @importFrom xml2 as_list #' xml_attr xml_children xml_find_all xml_find_chr xml_find_lgl xml_find_num xml_find_first xml_name xml_text -#' @rawNamespace -#' if (getRversion() >= "4.0.0") { -#' importFrom(tools, R_user_dir) -#' } else { -#' importFrom(backports, R_user_dir) -#' } ## lintr namespace: end NULL diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index 63eb245c3..bfc93fefe 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -97,9 +97,14 @@ literal_coercion_linter <- function() { needs_prefix <- is_rlang_coercer & !startsWith(coercion_str, "rlang::") coercion_str[needs_prefix] <- paste0("rlang::", coercion_str[needs_prefix]) } - # the linter logic & rlang requirement should ensure that it's safe to run eval() here + # the linter logic & rlang requirement should ensure that it's safe to run eval() here; + # suppressWarnings() is for cases like 'as.integer("a")' which have an NA result, #2566. # TODO(#2473): Avoid a recommendation like '1' that clashes with implicit_integer_linter(). - literal_equivalent_str <- vapply(str2expression(coercion_str), function(expr) deparse1(eval(expr)), character(1L)) + literal_equivalent_str <- vapply( + str2expression(coercion_str), + function(expr) deparse1(suppressWarnings(eval(expr))), + character(1L) + ) lint_message <- sprintf( "Use %s instead of %s, i.e., use literals directly where possible, instead of coercion.", literal_equivalent_str, report_str diff --git a/R/make_linter_from_regex.R b/R/make_linter_from_regex.R index 59bd37de4..afcbf8f43 100644 --- a/R/make_linter_from_regex.R +++ b/R/make_linter_from_regex.R @@ -34,12 +34,12 @@ make_linter_from_regex <- function(regex, #' Determine if a regex match is covered by an expression in a source_expression #' -#' @param match The position where a regex match was observed. -#' match must have entries "start", "end", and "line_number". -#' @param source_expression A source_expression -#' @param token_type Restrict analysis to tokens of this type, for example, -#' with token_type = "STR_CONST" you can check that a regex match occurs -#' within a string +#' @param match The position where a regex match was observed. +#' It must have the following elements: `"start"`, `"end"`, and `"line_number"`. +#' @param source_expression A source_expression. +#' @param token_type Restrict analysis to tokens of this type, for example, +#' with `token_type = "STR_CONST"` you can check that a regex match occurs +#' within a string. #' @noRd is_match_covered <- function(match, source_expression, token_type = "STR_CONST") { line_number <- match$line_number diff --git a/R/make_linter_from_xpath.R b/R/make_linter_from_xpath.R index e707247d9..1ddb673a5 100644 --- a/R/make_linter_from_xpath.R +++ b/R/make_linter_from_xpath.R @@ -19,7 +19,8 @@ make_linter_from_xpath <- function(xpath, level <- match.arg(level) stopifnot( - "xpath should be a character string" = is.character(xpath) && length(xpath) == 1L && !is.na(xpath) + "xpath should be a character string" = is.character(xpath) && length(xpath) == 1L && !is.na(xpath), + "lint_message is required" = !missing(lint_message) ) xml_key <- if (level == "expression") "xml_parsed_content" else "full_xml_parsed_content" @@ -55,7 +56,8 @@ make_linter_from_function_xpath <- function(function_names, stopifnot( "function_names should be a character vector" = is.character(function_names) && length(function_names) > 0L, - "xpath should be a character string" = is.character(xpath) && length(xpath) == 1L && !is.na(xpath) + "xpath should be a character string" = is.character(xpath) && length(xpath) == 1L && !is.na(xpath), + "lint_message is required" = !missing(lint_message) ) function() { diff --git a/R/methods.R b/R/methods.R index 4ff71c0a1..46e8ed804 100644 --- a/R/methods.R +++ b/R/methods.R @@ -163,8 +163,7 @@ as.data.frame.lints <- function(x, row.names = NULL, optional = FALSE, ...) { # type = vapply(x, `[[`, character(1L), "type"), message = vapply(x, `[[`, character(1L), "message"), line = vapply(x, `[[`, character(1L), "line"), - linter = vapply(x, `[[`, character(1L), "linter"), - stringsAsFactors = FALSE + linter = vapply(x, `[[`, character(1L), "linter") ) } @@ -198,7 +197,7 @@ summary.lints <- function(object, ...) { ) tbl <- table(filenames, types) filenames <- rownames(tbl) - res <- as.data.frame.matrix(tbl, stringsAsFactors = FALSE, row.names = NULL) + res <- as.data.frame.matrix(tbl, row.names = NULL) res$filenames <- filenames %||% character() nms <- colnames(res) res[order(res$filenames), c("filenames", nms[nms != "filenames"])] diff --git a/R/namespace.R b/R/namespace.R index a3fba3146..01ae56328 100644 --- a/R/namespace.R +++ b/R/namespace.R @@ -24,18 +24,18 @@ safe_get_exports <- function(ns) { # importFrom directives appear as list(ns, imported_funs) if (length(ns) > 1L) { - return(data.frame(pkg = ns[[1L]], fun = ns[[2L]], stringsAsFactors = FALSE)) + return(data.frame(pkg = ns[[1L]], fun = ns[[2L]])) } # relevant only if there are any exported objects fun <- getNamespaceExports(ns) if (length(fun) > 0L) { - data.frame(pkg = ns, fun = fun, stringsAsFactors = FALSE) + data.frame(pkg = ns, fun = fun) } } empty_namespace_data <- function() { - data.frame(pkg = character(), fun = character(), stringsAsFactors = FALSE) + data.frame(pkg = character(), fun = character()) } # filter namespace_imports() for S3 generics @@ -64,11 +64,7 @@ exported_s3_generics <- function(path = find_package(".")) { return(empty_namespace_data()) } - data.frame( - pkg = basename(path), - fun = unique(namespace_data$S3methods[, 1L]), - stringsAsFactors = FALSE - ) + data.frame(pkg = basename(path), fun = unique(namespace_data$S3methods[, 1L])) } is_s3_generic <- function(fun) { diff --git a/R/namespace_linter.R b/R/namespace_linter.R index d6579a86a..c64a39bfe 100644 --- a/R/namespace_linter.R +++ b/R/namespace_linter.R @@ -84,11 +84,7 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) { # nocov start if (any(failed_namespace)) { - stop( - "Failed to retrieve namespaces for one or more of the packages used with `::` or `:::`. ", - "Please report the issue at https://github.com/r-lib/lintr/issues.", - call. = FALSE - ) + cli_abort_internal("Failed to retrieve namespaces for one or more of the packages used with `::` or `:::`. ") } # nocov end diff --git a/R/object_name_linter.R b/R/object_name_linter.R index bb506692d..54cbb523d 100644 --- a/R/object_name_linter.R +++ b/R/object_name_linter.R @@ -92,7 +92,7 @@ object_name_linter <- function(styles = c("snake_case", "symbols"), regexes = ch } if (length(regexes) > 0L) { if (!is.character(regexes)) { - stop("`regexes` must be a character vector.", call. = FALSE) + cli_abort("{.arg regexes} must be a {.cls character} vector.") } rx_names <- names2(regexes) missing_name <- !nzchar(rx_names) @@ -102,7 +102,7 @@ object_name_linter <- function(styles = c("snake_case", "symbols"), regexes = ch style_list <- c(style_list, as.list(regexes)) } if (length(style_list) == 0L) { - stop("At least one style must be specified using `styles` or `regexes`.", call. = FALSE) + cli_abort("At least one style must be specified using {.arg styles} or {.arg regexes}.") } lint_message <- paste0( diff --git a/R/object_overwrite_linter.R b/R/object_overwrite_linter.R index 6c2eaa27d..099129ed5 100644 --- a/R/object_overwrite_linter.R +++ b/R/object_overwrite_linter.R @@ -56,7 +56,7 @@ object_overwrite_linter <- function( allow_names = character()) { for (package in packages) { if (!requireNamespace(package, quietly = TRUE)) { - stop("Package '", package, "' is not available.", call. = FALSE) + cli_abort("Package {.pkg {package}} is required, but not available.") } } pkg_exports <- lapply( @@ -66,8 +66,7 @@ object_overwrite_linter <- function( ) pkg_exports <- data.frame( package = rep(packages, lengths(pkg_exports)), - name = unlist(pkg_exports), - stringsAsFactors = FALSE + name = unlist(pkg_exports) ) # Take the first among duplicate names, e.g. 'plot' resolves to base::plot, not graphics::plot diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 21cb1151e..6b9466eff 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -210,11 +210,11 @@ parse_check_usage <- function(expression, is_missing <- is.na(res$message) if (any(is_missing)) { # TODO(#2474): Remove this. - warning( - "Possible bug in lintr: Couldn't parse usage message ", sQuote(vals[is_missing][[1L]]), ". ", - "Ignoring ", sum(is_missing), " usage warnings. Please report an issue at https://github.com/r-lib/lintr/issues.", - call. = FALSE - ) + missing_msg <- vals[is_missing][[1L]] # nolint: object_usage_linter. TODO(#2252). + cli_warn(c( + x = "Couldn't parse usage message {.str {missing_msg}}. Ignoring {.val {sum(is_missing)}} usage warnings.", + i = "Please report a possible bug at {.url https://github.com/r-lib/lintr/issues}." + )) } # nocov end res <- res[!is_missing, ] diff --git a/R/outer_negation_linter.R b/R/outer_negation_linter.R index f9f5a6715..71dc7773e 100644 --- a/R/outer_negation_linter.R +++ b/R/outer_negation_linter.R @@ -1,6 +1,6 @@ #' Require usage of `!any(x)` over `all(!x)`, `!all(x)` over `any(!x)` #' -#' `any(!x)` is logically equivalent to `!any(x)`; ditto for the equivalence of +#' `any(!x)` is logically equivalent to `!all(x)`; ditto for the equivalence of #' `all(!x)` and `!any(x)`. Negating after aggregation only requires inverting #' one logical value, and is typically more readable. #' diff --git a/R/paste_linter.R b/R/paste_linter.R index cd054a068..ca5d0dd81 100644 --- a/R/paste_linter.R +++ b/R/paste_linter.R @@ -58,6 +58,11 @@ #' linters = paste_linter(allow_file_path = "never") #' ) #' +#' lint( +#' text = 'paste0(x, collapse = "")', +#' linters = paste_linter() +#' ) +#' #' # okay #' lint( #' text = 'paste0("a", "b")', @@ -99,6 +104,11 @@ #' linters = paste_linter() #' ) #' +#' lint( +#' text = 'paste(x, collapse = "")', +#' linters = paste_linter() +#' ) +#' #' @seealso [linters] for a complete list of linters available in lintr. #' @export paste_linter <- function(allow_empty_sep = FALSE, @@ -157,6 +167,16 @@ paste_linter <- function(allow_empty_sep = FALSE, empty_paste_note <- 'Note that paste() converts empty inputs to "", whereas file.path() leaves it empty.' + paste0_collapse_xpath <- glue::glue(" + parent::expr + /parent::expr[ + SYMBOL_SUB[text() = 'collapse'] + and count(expr) = + 3 - count(preceding-sibling::*[self::PIPE or self::SPECIAL[{ xp_text_in_table(magrittr_pipes) }]]) + and not(expr/SYMBOL[text() = '...']) + ] + ") + Linter(linter_level = "expression", function(source_expression) { paste_calls <- source_expression$xml_find_function_calls("paste") paste0_calls <- source_expression$xml_find_function_calls("paste0") @@ -219,6 +239,14 @@ paste_linter <- function(allow_empty_sep = FALSE, type = "warning" ) + paste0_collapse_expr <- xml_find_all(paste0_calls, paste0_collapse_xpath) + paste0_collapse_lints <- xml_nodes_to_lints( + paste0_collapse_expr, + source_expression = source_expression, + lint_message = "Use paste(), not paste0(), to collapse a character vector when sep= is not used.", + type = "warning" + ) + if (check_file_paths) { paste_sep_slash_expr <- paste_sep_expr[paste_sep_value == "/"] optional_lints <- c(optional_lints, xml_nodes_to_lints( @@ -248,7 +276,7 @@ paste_linter <- function(allow_empty_sep = FALSE, )) } - c(optional_lints, paste0_sep_lints, paste_strrep_lints) + c(optional_lints, paste0_sep_lints, paste_strrep_lints, paste0_collapse_lints) }) } diff --git a/R/path_utils.R b/R/path_utils.R index d9c47a99c..f8ac2ac6f 100644 --- a/R/path_utils.R +++ b/R/path_utils.R @@ -108,10 +108,10 @@ is_valid_long_path <- function(path, lax = FALSE) { split_paths <- function(path, sep = "/|\\\\") { if (!is.character(path)) { - stop("argument 'path' should be a character vector", call. = FALSE) + cli_abort("Argument {.arg path} should be a {.cls character} vector.") } if (!is.character(sep) || length(sep) != 1L || !nzchar(sep)) { - stop("argument 'sep' should be a non-empty regular expression character string", call. = FALSE) + cli_abort("Argument {.arg sep} should be a non-empty regular expression character string.") } Map(split_path, strsplit(path, sep), substr(path, 1L, 1L)) } @@ -133,6 +133,12 @@ split_path <- function(dirs, prefix) { dirs[nzchar(dirs)] } +#' Simple wrapper around normalizePath to ensure forward slash on Windows +#' https://github.com/r-lib/lintr/pull/2613 +#' @noRd +# nolint next: undesirable_function_linter, object_name_linter. +normalize_path <- function(path, mustWork = NA) normalizePath(path = path, winslash = "/", mustWork = mustWork) + #' @include utils.R path_linter_factory <- function(path_function, message, linter, name = linter_auto_name()) { force(name) @@ -150,7 +156,7 @@ path_linter_factory <- function(path_function, message, linter, name = linter_au line_number = token[["line1"]], column_number = path_start, type = "warning", - message = message, + message = message, # nolint: undesirable_function_linter line = source_expression[["lines"]][[as.character(token[["line1"]])]], ranges = list(c(path_start, path_end)) ) diff --git a/R/scalar_in_linter.R b/R/scalar_in_linter.R index 77ca70285..e6c9faace 100644 --- a/R/scalar_in_linter.R +++ b/R/scalar_in_linter.R @@ -1,12 +1,14 @@ #' Block usage like x %in% "a" #' #' `vector %in% set` is appropriate for matching a vector to a set, but if -#' that set has size 1, `==` is more appropriate. `%chin%` from `{data.table}` -#' is matched as well. +#' that set has size 1, `==` is more appropriate. #' #' `scalar %in% vector` is OK, because the alternative (`any(vector == scalar)`) #' is more circuitous & potentially less clear. #' +#' @param in_operators Character vector of additional infix operators that behave like the `%in%` operator, +#' e.g. `{data.table}`'s `%chin%` operator. +#' #' @examples #' # will produce lints #' lint( @@ -16,7 +18,7 @@ #' #' lint( #' text = "x %chin% 'a'", -#' linters = scalar_in_linter() +#' linters = scalar_in_linter(in_operators = "%chin%") #' ) #' #' # okay @@ -28,22 +30,24 @@ #' @evalRd rd_tags("scalar_in_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' @export -scalar_in_linter <- function() { +scalar_in_linter <- function(in_operators = NULL) { # TODO(#2085): Extend to include other cases where the RHS is clearly a scalar # NB: all of logical, integer, double, hex, complex are parsed as NUM_CONST - xpath <- " - //SPECIAL[text() = '%in%' or text() = '%chin%'] + xpath <- glue(" + //SPECIAL[{xp_text_in_table(c('%in%', {in_operators}))}] /following-sibling::expr[NUM_CONST[not(starts-with(text(), 'NA'))] or STR_CONST] /parent::expr - " + ") Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content bad_expr <- xml_find_all(xml, xpath) in_op <- xml_find_chr(bad_expr, "string(SPECIAL)") - lint_msg <- - paste0("Use == to match length-1 scalars, not ", in_op, ". Note that == preserves NA where ", in_op, " does not.") + lint_msg <- glue( + "Use comparison operators (e.g. ==, !=, etc.) to match length-1 scalars instead of {in_op}. ", + "Note that comparison operators preserve NA where {in_op} does not." + ) xml_nodes_to_lints( bad_expr, diff --git a/R/semicolon_linter.R b/R/semicolon_linter.R index 5faf5e12c..1e0297917 100644 --- a/R/semicolon_linter.R +++ b/R/semicolon_linter.R @@ -64,10 +64,10 @@ semicolon_linter <- function(allow_compound = FALSE, allow_trailing = FALSE) { msg_compound <- "Replace compound semicolons by a newline." if (allow_compound && allow_trailing) { - stop( - "At least one of `allow_compound` or `allow_trailing` must be FALSE, otherwise no lints can be generated.", - call. = FALSE - ) + cli_abort(c( + x = "At least one of {.arg allow_compound} or {.arg allow_trailing} must be `FALSE`.", + i = "No lints can be generated otherwise." + )) } else if (allow_compound && !allow_trailing) { # lint only trailing xpath <- "//OP-SEMICOLON[not(@line1 = following-sibling::*[1]/@line1)]" diff --git a/R/settings.R b/R/settings.R index 167fcd6ac..9bd7da159 100644 --- a/R/settings.R +++ b/R/settings.R @@ -61,7 +61,8 @@ #' ``` #' #' @param filename Source file to be linted. -read_settings <- function(filename) { +#' @param call Passed to malformed to ensure linear trace. +read_settings <- function(filename, call = parent.frame()) { reset_settings() config_file <- find_config(filename) @@ -71,7 +72,7 @@ read_settings <- function(filename) { default_settings[["encoding"]] <- default_encoding } - config <- read_config_file(config_file) + config <- read_config_file(config_file, call = call) validate_config_file(config, config_file, default_settings) for (setting in names(default_settings)) { @@ -89,43 +90,52 @@ read_settings <- function(filename) { } } -read_config_file <- function(config_file) { +#' @param call Passed to malformed to ensure linear trace. +#' @noRd +read_config_file <- function(config_file, call = parent.frame()) { if (is.null(config_file)) { return(NULL) } + # clickable link for eventual error messages. + malformed_file <- link_config_file(config_file) # nolint: object_usage_linter. TODO(#2252). config <- new.env() if (endsWith(config_file, ".R")) { load_config <- function(file) sys.source(file, config, keep.source = FALSE, keep.parse.data = FALSE) malformed <- function(e) { - stop("Malformed config file, ensure it is valid R syntax\n ", conditionMessage(e), call. = FALSE) + cli_abort( + "Malformed config file ({malformed_file}), ensure it is valid R syntax.", + parent = e, + call = call + ) } } else { load_config <- function(file) { dcf_values <- read.dcf(file, all = TRUE) for (setting in names(dcf_values)) { - parsed_setting <- tryCatch( + parsed_setting <- withCallingHandlers( str2lang(dcf_values[[setting]]), error = function(e) { - stop("Malformed config setting '", setting, "':\n ", conditionMessage(e), call. = FALSE) + cli_abort( + "Malformed config setting {.field {setting}}:", + parent = e + ) } ) setting_value <- withCallingHandlers( tryCatch( eval(parsed_setting), error = function(e) { - stop( - "Error from config setting '", setting, "' in '", format(conditionCall(e)), "':\n", - " ", conditionMessage(e), - call. = FALSE + cli_abort( + "Error from config setting {.code {setting}}.", + parent = e ) } ), warning = function(w) { - warning( - "Warning from config setting '", setting, "' in '", format(conditionCall(w)), "':\n", - " ", conditionMessage(w), - call. = FALSE + cli_warn( + "Warning from config setting {.code {setting}}.", + parent = w ) invokeRestart("muffleWarning") } @@ -134,7 +144,11 @@ read_config_file <- function(config_file) { } } malformed <- function(e) { - stop("Malformed config file:\n ", conditionMessage(e), call. = FALSE) + cli_abort( + "Malformed config file ({malformed_file}):", + parent = e, + call = call + ) } } withCallingHandlers( @@ -143,7 +157,10 @@ read_config_file <- function(config_file) { error = malformed ), warning = function(w) { - warning("Warning encountered while loading config:\n ", conditionMessage(w), call. = FALSE) + cli::cli_warn( + "Warning encountered while loading config:", + parent = w + ) invokeRestart("muffleWarning") } ) @@ -153,10 +170,9 @@ read_config_file <- function(config_file) { validate_config_file <- function(config, config_file, defaults) { matched <- names(config) %in% names(defaults) if (!all(matched)) { - warning( - "Found unused settings in config '", config_file, "': ", toString(names(config)[!matched]), - call. = FALSE - ) + unused_settings <- names(config)[!matched] # nolint: object_usage_linter. TODO(#2252). + config_link <- link_config_file(config_file) # nolint: object_usage_linter. TODO(#2252). + cli_warn("Found unused settings in config file ({config_link}): {.field unused_settings}") } validate_regex(config, @@ -181,7 +197,10 @@ validate_keys <- function(config, keys, test, what) { next } if (!test(val)) { - stop("Setting '", key, "' should be ", what, ", not '", toString(val), "'.", call. = FALSE) + cli_abort(c( + i = "Setting {.code {key}} should be {.strong {what}}.", + x = "Instead, it is {.field {val}}." + )) } } } @@ -205,11 +224,11 @@ validate_linters <- function(linters) { is_linters <- vapply(linters, is_linter, logical(1L)) if (!all(is_linters)) { - stop( - "Setting 'linters' should be a list of linters, but found non-linters at elements ", - toString(which(!is_linters)), ".", - call. = FALSE - ) + non_linters <- which(!is_linters) # nolint: object_usage_linter. TODO(#2252). + cli_abort(c( + i = "Setting {.arg linters} should be a list of linters.", + x = "Found non-linters at elements: {.str {non_linters}}." + )) } } @@ -223,11 +242,11 @@ validate_exclusions <- function(exclusions) { unnamed_is_string <- vapply(exclusions[!has_names], function(x) is.character(x) && length(x) == 1L && !is.na(x), logical(1L)) if (!all(unnamed_is_string)) { - stop( - "Unnamed entries of setting 'exclusions' should be strings naming files or directories, check entries: ", - toString(which(!has_names)[!unnamed_is_string]), ".", - call. = FALSE - ) + problematic_entries <- which(!has_names)[!unnamed_is_string] # nolint: object_usage_linter. TODO(#2252). + cli_abort(c( + i = "Unnamed entries of setting {.arg exclusions} should be strings naming files or directories.", + x = "Check exclusions: {.str {problematic_entries}}." + )) } for (ii in which(has_names)) validate_named_exclusion(exclusions, ii) } @@ -240,11 +259,10 @@ validate_named_exclusion <- function(exclusions, idx) { valid_entry <- is.numeric(entry) && !anyNA(entry) } if (!all(valid_entry)) { - stop( - "Named entries of setting 'exclusions' should designate line numbers for exclusion, ", - "check exclusion: ", idx, ".", - call. = FALSE - ) + cli_abort(c( + i = "Named entries of setting {.arg exclusions} should designate line numbers for exclusion.", + x = "Check exclusions: {idx}." + )) } } @@ -287,3 +305,10 @@ get_encoding_from_dcf <- function(file) { NULL } + +link_config_file <- function(path) { + cli::style_hyperlink( + cli::col_blue(basename(path)), + paste0("file://", path) + ) +} diff --git a/R/settings_utils.R b/R/settings_utils.R index 9489ea24e..02564efe5 100644 --- a/R/settings_utils.R +++ b/R/settings_utils.R @@ -8,7 +8,7 @@ has_rproj <- function(path) { } find_package <- function(path, allow_rproj = FALSE, max_depth = 2L) { - path <- normalizePath(path, mustWork = !allow_rproj) + path <- normalize_path(path, mustWork = !allow_rproj) if (allow_rproj) { found <- function(path) has_description(path) || has_rproj(path) } else { @@ -68,7 +68,7 @@ find_config <- function(filename) { dirname(filename) } - path <- normalizePath(path, mustWork = FALSE) + path <- normalize_path(path, mustWork = FALSE) # NB: This vector specifies a priority order for where to find the configs, # i.e. the first location where a config exists is chosen and configs which diff --git a/R/shared_constants.R b/R/shared_constants.R index 006c8f2fd..3dc20d615 100644 --- a/R/shared_constants.R +++ b/R/shared_constants.R @@ -115,7 +115,7 @@ get_token_replacement <- function(token_content, token_type) { # r_string gives the operator as you would write it in R code. # styler: off -infix_metadata <- data.frame(stringsAsFactors = FALSE, matrix(byrow = TRUE, ncol = 2L, c( +infix_metadata <- data.frame(matrix(byrow = TRUE, ncol = 2L, c( "OP-PLUS", "+", "OP-MINUS", "-", "OP-TILDE", "~", @@ -203,7 +203,7 @@ object_name_xpath <- local({ xp_assignment_target_fmt <- paste0( "not(parent::expr[OP-DOLLAR or OP-AT])", "and %1$s::expr[", - " following-sibling::LEFT_ASSIGN", + " following-sibling::LEFT_ASSIGN%2$s", " or preceding-sibling::RIGHT_ASSIGN", " or following-sibling::EQ_ASSIGN", "]", @@ -213,9 +213,15 @@ object_name_xpath <- local({ "])" ) + # strings on LHS of := are only checked if they look like data.table usage DT[, "a" := ...] + dt_walrus_cond <- "[ + text() != ':=' + or parent::expr/preceding-sibling::OP-LEFT-BRACKET + ]" + glue(" - //SYMBOL[ {sprintf(xp_assignment_target_fmt, 'ancestor')} ] - | //STR_CONST[ {sprintf(xp_assignment_target_fmt, 'parent')} ] + //SYMBOL[ {sprintf(xp_assignment_target_fmt, 'ancestor', '')} ] + | //STR_CONST[ {sprintf(xp_assignment_target_fmt, 'parent', dt_walrus_cond)} ] | //SYMBOL_FORMALS ") }) @@ -268,14 +274,16 @@ extract_glued_symbols <- function(expr, interpret_glue) { } unexpected_glue_parse_error <- function(cond) { - stop("Unexpected failure to parse glue call, please report: ", conditionMessage(cond), call. = FALSE) # nocov + cli_abort(c( + x = "Unexpected failure to parse glue call.", + i = "Please report: {conditionMessage(cond)}" + )) # nocov } glue_parse_failure_warning <- function(cond) { - warning( - "Evaluating glue expression while testing for local variable usage failed: ", conditionMessage(cond), - "\nPlease ensure correct glue syntax, e.g., matched delimiters.", - call. = FALSE - ) + cli_warn(c( + x = "Evaluating glue expression while testing for local variable usage failed: {conditionMessage(cond)}", + i = "Please ensure correct glue syntax, e.g., matched delimiters." + )) NULL } glue_symbol_extractor <- function(text, envir, data) { diff --git a/R/tree_utils.R b/R/tree_utils.R index 58024b48d..984ab8fcc 100644 --- a/R/tree_utils.R +++ b/R/tree_utils.R @@ -9,12 +9,11 @@ generate_top_level_map <- function(pc) { while ((prev_length <- length(i_not_assigned)) > 0L) { # nolint: implicit_assignment_linter. TODO(#2015): remove this. tl_parent[i_not_assigned] <- pc$parent[match(tl_parent[i_not_assigned], pc$id)] i_not_assigned <- which(!tl_parent %in% tl_ids) - if (length(i_not_assigned) >= prev_length) { # nocov start - stop( - "Logical error: unassigned set did not shrink. Check file syntax and please report as a lintr bug.", - call. = FALSE - ) - } # nocov end + # nocov start + if (length(i_not_assigned) >= prev_length) { + cli_abort_internal("Logical error: unassigned set did not shrink. Check file syntax.") + } + # nocov end } tl_parent } diff --git a/R/undesirable_function_linter.R b/R/undesirable_function_linter.R index 762ecda5d..e565283f2 100644 --- a/R/undesirable_function_linter.R +++ b/R/undesirable_function_linter.R @@ -1,7 +1,6 @@ #' Undesirable function linter #' -#' Report the use of undesirable functions (e.g. [base::return()], [base::options()], or -#' [base::sapply()]) and suggest an alternative. +#' Report the use of undesirable functions and suggest an alternative. #' #' @param fun Named character vector. `names(fun)` correspond to undesirable functions, #' while the values give a description of why the function is undesirable. @@ -59,10 +58,10 @@ undesirable_function_linter <- function(fun = default_undesirable_functions, symbol_is_undesirable = TRUE) { stopifnot(is.logical(symbol_is_undesirable)) if (is.null(names(fun)) || !all(nzchar(names(fun))) || length(fun) == 0L) { - stop( - "'fun' should be a non-empty named character vector; use missing elements to indicate default messages.", - call. = FALSE - ) + cli_abort(c( + x = "{.arg fun} should be a non-empty named character vector.", + i = "Use missing elements to indicate default messages." + )) } xp_condition <- xp_and( diff --git a/R/undesirable_operator_linter.R b/R/undesirable_operator_linter.R index 734e6c485..e3fb7186e 100644 --- a/R/undesirable_operator_linter.R +++ b/R/undesirable_operator_linter.R @@ -44,10 +44,10 @@ #' @export undesirable_operator_linter <- function(op = default_undesirable_operators) { if (is.null(names(op)) || !all(nzchar(names(op))) || length(op) == 0L) { - stop( - "'op' should be a non-empty named character vector; use missing elements to indicate default messages.", - call. = FALSE - ) + cli_abort(c( + x = "{.arg op} should be a non-empty named character vector.", + i = "Use missing elements to indicate default messages." + )) } # infix must be handled individually below; non-assignment `=` are always OK operator_nodes <- infix_metadata$xml_tag_exact[ @@ -61,7 +61,7 @@ undesirable_operator_linter <- function(op = default_undesirable_operators) { } if (length(operator_nodes) == 0L) { - stop("Did not recognize any valid operators in request for: ", toString(names(op)), call. = FALSE) + cli_abort("Did not recognize any valid operators in request for: {.str {names(op)}}") } xpath <- paste(paste0("//", operator_nodes), collapse = " | ") diff --git a/R/unnecessary_nesting_linter.R b/R/unnecessary_nesting_linter.R index 0fdbe61fa..653406881 100644 --- a/R/unnecessary_nesting_linter.R +++ b/R/unnecessary_nesting_linter.R @@ -91,7 +91,7 @@ #' #' @evalRd rd_tags("unnecessary_nesting_linter") #' @seealso -#' - [cyclocomp_linter()] for another linter that penalizes overly complexcode. +#' - [cyclocomp_linter()] for another linter that penalizes overly complex code. #' - [linters] for a complete list of linters available in lintr. #' @export unnecessary_nesting_linter <- function( @@ -197,7 +197,7 @@ unnecessary_nesting_linter <- function( collapse = " | " ) - unnecessary_else_brace_xpath <- "//IF/parent::expr[parent::expr[preceding-sibling::ELSE and count(expr) = 1]]" + unnecessary_else_brace_xpath <- "//IF/parent::expr[parent::expr[preceding-sibling::ELSE and count(expr) = 1]]" Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content diff --git a/R/use_lintr.R b/R/use_lintr.R index d72711b5e..73dc72e38 100644 --- a/R/use_lintr.R +++ b/R/use_lintr.R @@ -25,9 +25,9 @@ #' lintr::lint_dir() #' } use_lintr <- function(path = ".", type = c("tidyverse", "full")) { - config_file <- normalizePath(file.path(path, lintr_option("linter_file")), mustWork = FALSE) + config_file <- normalize_path(file.path(path, lintr_option("linter_file")), mustWork = FALSE) if (file.exists(config_file)) { - stop("Found an existing configuration file at '", config_file, "'.", call. = FALSE) + cli_abort("Found an existing configuration file at {.file {config_file}}.") } type <- match.arg(type) the_config <- switch( diff --git a/R/utils.R b/R/utils.R index 8d2f92378..d23fc8902 100644 --- a/R/utils.R +++ b/R/utils.R @@ -72,7 +72,7 @@ auto_names <- function(x) { if (is_linter(x)) { attr(x, "name", exact = TRUE) } else { - paste(deparse(x, 500L), collapse = " ") + deparse1(x) } } defaults <- vapply(x[empty], default_name, character(1L), USE.NAMES = FALSE) @@ -86,17 +86,6 @@ names2 <- function(x) { names(x) %||% rep("", length(x)) } -safe_parse_to_xml <- function(parsed_content) { - if (is.null(parsed_content)) { - return(xml2::xml_missing()) - } - tryCatch( - xml2::read_xml(xmlparsedata::xml_parse_data(parsed_content)), - # use xml_missing so that code doesn't always need to condition on XML existing - error = function(e) xml2::xml_missing() - ) -} - get_content <- function(lines, info) { lines[is.na(lines)] <- "" @@ -111,7 +100,7 @@ get_content <- function(lines, info) { lines[length(lines)] <- substr(lines[length(lines)], 1L, info$col2) lines[1L] <- substr(lines[1L], info$col1, nchar(lines[1L])) } - paste0(collapse = "\n", lines) + paste(lines, collapse = "\n") } logical_env <- function(x) { @@ -167,7 +156,7 @@ reset_lang <- function(old_lang) { #' @export Linter <- function(fun, name = linter_auto_name(), linter_level = c(NA_character_, "file", "expression")) { # nolint: object_name, line_length. if (!is.function(fun) || length(formals(args(fun))) != 1L) { - stop("`fun` must be a function taking exactly one argument.", call. = FALSE) + cli_abort("{.arg fun} must be a function taking exactly one argument.") } linter_level <- match.arg(linter_level) force(name) @@ -209,10 +198,9 @@ platform_independent_sort <- function(x) x[platform_independent_order(x)] #' Extract text from `STR_CONST` nodes #' #' Convert `STR_CONST` `text()` values into R strings. This is useful to account for arbitrary -#' character literals valid since R 4.0, e.g. `R"------[hello]------"`, which is parsed in -#' R as `"hello"`. It is quite cumbersome to write XPaths allowing for strings like this, -#' so whenever your linter logic requires testing a `STR_CONST` node's value, use this -#' function. +#' character literals, e.g. `R"------[hello]------"`, which is parsed in R as `"hello"`. +#' It is quite cumbersome to write XPaths allowing for strings like this, so whenever your +#' linter logic requires testing a `STR_CONST` node's value, use this function. #' NB: this is also properly vectorized on `s`, and accepts a variety of inputs. Empty inputs #' will become `NA` outputs, which helps ensure that `length(get_r_string(s)) == length(s)`. #' @@ -226,19 +214,18 @@ platform_independent_sort <- function(x) x[platform_independent_order(x)] #' writeLines("c('a', 'b')", tmp) #' expr_as_xml <- get_source_expressions(tmp)$expressions[[1L]]$xml_parsed_content #' writeLines(as.character(expr_as_xml)) -#' get_r_string(expr_as_xml, "expr[2]") # "a" -#' get_r_string(expr_as_xml, "expr[3]") # "b" +#' get_r_string(expr_as_xml, "expr[2]") +#' get_r_string(expr_as_xml, "expr[3]") #' unlink(tmp) #' -#' # more importantly, extract strings under R>=4 raw strings -#' @examplesIf getRversion() >= "4.0.0" -#' tmp4.0 <- tempfile() -#' writeLines("c(R'(a\\b)', R'--[a\\\"\'\"\\b]--')", tmp4.0) -#' expr_as_xml4.0 <- get_source_expressions(tmp4.0)$expressions[[1L]]$xml_parsed_content -#' writeLines(as.character(expr_as_xml4.0)) -#' get_r_string(expr_as_xml4.0, "expr[2]") # "a\\b" -#' get_r_string(expr_as_xml4.0, "expr[3]") # "a\\\"'\"\\b" -#' unlink(tmp4.0) +#' # more importantly, extract raw strings correctly +#' tmp_raw <- tempfile() +#' writeLines("c(R'(a\\b)', R'--[a\\\"\'\"\\b]--')", tmp_raw) +#' expr_as_xml_raw <- get_source_expressions(tmp_raw)$expressions[[1L]]$xml_parsed_content +#' writeLines(as.character(expr_as_xml_raw)) +#' get_r_string(expr_as_xml_raw, "expr[2]") +#' get_r_string(expr_as_xml_raw, "expr[3]") +#' unlink(tmp_raw) #' #' @export get_r_string <- function(s, xpath = NULL) { @@ -257,18 +244,6 @@ get_r_string <- function(s, xpath = NULL) { out } -#' str2lang, but for xml children. -#' -#' [xml2::xml_text()] is deceptively close to obviating this helper, but it collapses -#' text across lines. R is _mostly_ whitespace-agnostic, so this only matters in some edge cases, -#' in particular when there are comments within an expression (`` node). See #1919. -#' -#' @noRd -xml2lang <- function(x) { - x_strip_comments <- xml_find_all(x, ".//*[not(self::COMMENT or self::expr)]") - str2lang(paste(xml_text(x_strip_comments), collapse = " ")) -} - is_linter <- function(x) inherits(x, "linter") is_tainted <- function(lines) { @@ -287,9 +262,13 @@ check_dots <- function(dot_names, ref_calls, ref_help = as.character(sys.call(-1 if (all(is_valid)) { return(invisible()) } - stop( - "Found unknown arguments in ...: ", toString(dot_names[!is_valid]), ".\n", - "Check for typos and see ?", ref_help, " for valid arguments.", - call. = FALSE - ) + invalid_args <- dot_names[!is_valid] # nolint: object_usage_linter. TODO(#2252). + cli_abort(c( + x = "Found unknown arguments in `...`: {.arg {invalid_args}}.", + i = "Check for typos and see ?{ref_help} for valid arguments." + )) +} + +cli_abort_internal <- function(...) { + cli_abort(..., .internal = TRUE) } diff --git a/R/with.R b/R/with.R index 8a036c1b4..16d34fc7b 100644 --- a/R/with.R +++ b/R/with.R @@ -31,8 +31,11 @@ #' names(my_undesirable_functions) #' @export modify_defaults <- function(defaults, ...) { - if (missing(defaults) || !is.list(defaults) || !all(nzchar(names2(defaults)))) { - stop("`defaults` must be a named list.", call. = FALSE) + if (missing(defaults)) { + cli_abort("{.arg defaults} is a required argument, but is missing.") + } + if (!is.list(defaults) || !all(nzchar(names2(defaults)))) { + cli_abort("{.arg defaults} must be a named list, not {.obj_type_friendly {defaults}}.") } vals <- list(...) nms <- names2(vals) @@ -43,13 +46,10 @@ modify_defaults <- function(defaults, ...) { to_null <- vapply(vals, is.null, logical(1L)) if (!all(nms[to_null] %in% names(defaults))) { - bad_nms <- setdiff(nms[to_null], names(defaults)) - is_are <- if (length(bad_nms) > 1L) "are" else "is" - warning( - "Trying to remove ", glue_collapse(sQuote(bad_nms), sep = ", ", last = " and "), - ", which ", is_are, " not in `defaults`.", - call. = FALSE - ) + bad_nms <- setdiff(nms[to_null], names(defaults)) # nolint: object_usage_linter. TODO(#2252). + cli_warn(c( + i = "Trying to remove {.field {bad_nms}}, which {?is/are} not in {.arg defaults}." + )) } is.na(vals) <- nms == vals @@ -93,7 +93,7 @@ modify_defaults <- function(defaults, ...) { #' @export linters_with_tags <- function(tags, ..., packages = "lintr", exclude_tags = "deprecated") { if (!is.character(tags) && !is.null(tags)) { - stop("`tags` must be a character vector, or NULL.", call. = FALSE) + cli_abort("{.arg tags} must be a character vector, or {.code NULL}, not {.obj_type_friendly {tags}}.") } tagged_linters <- list() @@ -103,12 +103,11 @@ linters_with_tags <- function(tags, ..., packages = "lintr", exclude_tags = "dep available <- available_linters(packages = package, tags = tags, exclude_tags = exclude_tags) if (nrow(available) > 0L) { if (!all(available$linter %in% ns_exports)) { - missing_linters <- setdiff(available$linter, ns_exports) - stop( - "Linters ", glue_collapse(sQuote(missing_linters), sep = ", ", last = " and "), - " advertised by `available_linters()` but not exported by package ", package, ".", - call. = FALSE - ) + missing_linters <- setdiff(available$linter, ns_exports) # nolint: object_usage_linter. TODO(#2252). + cli_abort(c( + x = "Can't find linters {.fn {missing_linters}}.", + i = "These are advertised by {.fn available_linters}, but are not exported by package {.pkg {package}}." + )) } linter_factories <- mget(available$linter, envir = pkg_ns) linters <- Map( @@ -181,11 +180,14 @@ all_linters <- function(..., packages = "lintr") { linters_with_defaults <- function(..., defaults = default_linters) { dots <- list(...) if (missing(defaults) && "default" %in% names(dots)) { - warning( - "'default' is not an argument to linters_with_defaults(). Did you mean 'defaults'? ", - "This warning will be removed when with_defaults() is fully deprecated.", - call. = FALSE - ) + cli_warn(c( + x = " + {.arg default} is not an argument to {.help [{.fn linters_with_defaults}](lintr::linters_with_defaults)}. + ", + i = "Did you mean {.arg defaults}?", + # make message more subtle + cli::col_silver("This warning will be removed when {.fun with_defaults} is fully deprecated.") + )) defaults <- dots$default nms <- names2(dots) missing_index <- !nzchar(nms, keepNA = TRUE) @@ -211,9 +213,9 @@ call_linter_factory <- function(linter_factory, linter_name, package) { linter <- tryCatch( linter_factory(), error = function(e) { - stop( - "Could not create linter with ", package, "::", linter_name, "(): ", conditionMessage(e), - call. = FALSE + cli_abort( + "Could not create linter with {.fun {package}::{linter_name}}.", + parent = e ) } ) diff --git a/R/xml_nodes_to_lints.R b/R/xml_nodes_to_lints.R index 323a0f5be..a893662bb 100644 --- a/R/xml_nodes_to_lints.R +++ b/R/xml_nodes_to_lints.R @@ -53,17 +53,19 @@ xml_nodes_to_lints <- function(xml, source_expression, lint_message, class(lints) <- "lints" return(lints) } else if (!is_node(xml)) { - stop( - "Expected an xml_nodeset, a list of xml_nodes, or an xml_node, instead got an object of class(es): ", - toString(class(xml)), - call. = FALSE - ) + cli_abort(c( + x = "Expected an {.cls xml_nodeset}, a {.cls list} of xml_nodes, or an {.cls xml_node}.", + i = "Instead got {.obj_type_friendly {xml}}." + )) } type <- match.arg(type, c("style", "warning", "error")) line1 <- xml_attr(xml, "line1") col1 <- xp_find_location(xml, range_start_xpath) if (is.na(col1)) { - warning("Could not find range start for lint. Defaulting to start of line.", call. = FALSE) + cli_warn(c( + x = "Could not find range start for lint.", + i = "Defaulting to start of line." + )) col1 <- 1L } @@ -73,7 +75,10 @@ xml_nodes_to_lints <- function(xml, source_expression, lint_message, if (xml_attr(xml, "line2") == line1) { col2 <- xp_find_location(xml, range_end_xpath) if (is.na(col2)) { - warning("Could not find range end for lint. Defaulting to width 1.", call. = FALSE) + cli_warn(c( + x = "Could not find range end for lint.", + i = "Defaulting to width 1." + )) col2 <- col1 } } else { @@ -82,7 +87,10 @@ xml_nodes_to_lints <- function(xml, source_expression, lint_message, column_number <- xp_find_location(xml, column_number_xpath) if (is.na(column_number)) { - warning("Could not find location for lint. Defaulting to start of range.", call. = FALSE) + cli_warn(c( + x = "Could not find location for lint.", + i = "Defaulting to start of range." + )) column_number <- col1 } @@ -96,10 +104,3 @@ xml_nodes_to_lints <- function(xml, source_expression, lint_message, ranges = list(c(col1, col2)) ) } - -is_node <- function(xml) inherits(xml, "xml_node") -is_nodeset <- function(xml) inherits(xml, "xml_nodeset") -is_nodeset_like <- function(xml) { - is_nodeset(xml) || - (is.list(xml) && all(vapply(xml, is_node, logical(1L)))) -} diff --git a/R/xml_utils.R b/R/xml_utils.R new file mode 100644 index 000000000..3b0546da6 --- /dev/null +++ b/R/xml_utils.R @@ -0,0 +1,32 @@ +# utils for working with XML + +#' str2lang, but for xml children. +#' +#' [xml2::xml_text()] is deceptively close to obviating this helper, but it collapses +#' text across lines. R is _mostly_ whitespace-agnostic, so this only matters in some edge cases, +#' in particular when there are comments within an expression (`` node). See #1919. +#' +#' @noRd +xml2lang <- function(x) { + x_strip_comments <- xml_find_all(x, ".//*[not(self::COMMENT or self::expr)]") + str2lang(paste(xml_text(x_strip_comments), collapse = " ")) +} + + +safe_parse_to_xml <- function(parsed_content) { + if (is.null(parsed_content)) { + return(xml2::xml_missing()) + } + tryCatch( + xml2::read_xml(xmlparsedata::xml_parse_data(parsed_content)), + # use xml_missing so that code doesn't always need to condition on XML existing + error = function(e) xml2::xml_missing() + ) +} + +is_node <- function(xml) inherits(xml, "xml_node") +is_nodeset <- function(xml) inherits(xml, "xml_nodeset") +is_nodeset_like <- function(xml) { + is_nodeset(xml) || + (is.list(xml) && all(vapply(xml, is_node, logical(1L)))) +} diff --git a/R/xp_utils.R b/R/xp_utils.R index b96a39f57..e72bedc85 100644 --- a/R/xp_utils.R +++ b/R/xp_utils.R @@ -83,11 +83,10 @@ xp_call_name <- function(expr, depth = 1L, condition = NULL) { ) is_valid_expr <- is_node(expr) || is_nodeset(expr) if (!is_valid_expr) { - stop( - "Expected an xml_nodeset or an xml_node, instead got an object of class(es): ", - toString(class(expr)), - call. = FALSE - ) + cli_abort(c( + i = "{.arg expr} must be an {.cls xml_nodeset} or an {.cls xml_node}.", + x = "Instead, it is {.obj_type_friendly {expr}}." + )) } if (is.null(condition)) { diff --git a/R/zzz.R b/R/zzz.R index c8b658510..e281353db 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -17,7 +17,6 @@ default_linters <- modify_defaults( brace_linter(), commas_linter(), commented_code_linter(), - cyclocomp_linter(), equals_na_linter(), function_left_parentheses_linter(), indentation_linter(), @@ -169,9 +168,9 @@ default_undesirable_functions <- all_undesirable_functions[names(all_undesirable rd_auto_link <- function(x) { x <- unlist(x) - x <- gsub("([a-zA-Z0-9.]+)::([a-zA-Z0-9._]+)\\(\\)", "\\\\code{\\\\link[\\1:\\2]{\\1::\\2()}}", x) - x <- gsub("([^:a-zA-Z0-9._])([a-zA-Z0-9._]+)\\(\\)", "\\1\\\\code{\\\\link[=\\2]{\\2()}}", x) - x <- gsub("`([^`]+)`", "\\\\code{\\1}", x) + x <- gsub(R"{([a-zA-Z0-9.]+)::([a-zA-Z0-9._]+)\(\)}", R"(\\code{\\link[\1:\2]{\1::\2()}})", x) + x <- gsub(R"{([^:a-zA-Z0-9._])([a-zA-Z0-9._]+)\(\)}", R"(\1\\code{\\link[=\2]{\2()}})", x) + x <- gsub("`([^`]+)`", R"(\\code{\1})", x) x } @@ -182,7 +181,7 @@ rd_undesirable_functions <- function() { "The following functions are sometimes regarded as undesirable:", "\\itemize{", sprintf( - "\\item \\code{\\link[=%1$s]{%1$s()}} As an alternative, %2$s.", + R"(\item \code{\link[=%1$s]{%1$s()}} As an alternative, %2$s.)", names(default_undesirable_functions), alternatives ), "}" @@ -257,7 +256,6 @@ rd_undesirable_operators <- function() { #' - `exclusions`: a list of exclusions, see [exclude()] for a complete description of valid values. #' - `cache_directory`: location of cache directory #' - `comment_token`: a GitHub token character -#' - `comment_bot`: decides if lintr comment bot on GitHub can comment on commits #' - `error_on_lint`: decides if error should be produced when any lints are found #' #' There are no settings without defaults, i.e., this list describes every valid setting. @@ -297,9 +295,8 @@ settings <- new.env(parent = emptyenv()) toset <- !(names(op_lintr) %in% names(op)) if (any(toset)) options(op_lintr[toset]) - # R>=4.0.0: deparse1 # R>=4.1.0: ...names - backports::import(pkgname, c("deparse1", "...names")) + backports::import(pkgname, "...names") utils::assignInMyNamespace("default_settings", list( linters = default_linters, @@ -328,7 +325,6 @@ settings <- new.env(parent = emptyenv()) ), 54L - 13L ), - comment_bot = logical_env("LINTR_COMMENT_BOT") %||% TRUE, error_on_lint = logical_env("LINTR_ERROR_ON_LINT") %||% FALSE )) diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 8fd54393f..da3dbc60e 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -2,6 +2,7 @@ url: https://lintr.r-lib.org template: bootstrap: 5 + light-switch: true includes: in_header: | @@ -26,6 +27,10 @@ reference: contents: - ends_with("linter") + - title: Groups of linters + contents: + - ends_with("linters") + - title: Common default configurations contents: - all_undesirable_functions @@ -46,7 +51,6 @@ reference: - title: Meta-tooling contents: - - ends_with("linters") - Lint - checkstyle_output - sarif_output diff --git a/inst/WORDLIST b/inst/WORDLIST index 93300eb26..1afba075e 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,4 +1,5 @@ ALLUPPERCASE +AST Addins Backport CMD @@ -16,6 +17,8 @@ MegaLinter ORCID RMarkdown RStudio +RUnit +Relatedly Rhtml Rmarkdown Rmd @@ -27,9 +30,10 @@ Rtex Rtxt SARIF SublimeLinter +Testthat Tidyverse UpperCamelCase -Wickham +Wercker XPath XPaths YAML @@ -38,6 +42,7 @@ addin addins alllowercase backports +backtick backticked bookdown bugfix @@ -46,19 +51,25 @@ codecov codinghorror coercions config +configs covr customizable customizations +cyclocomp cyclomatic -dcf de debian +deterministically dplyr dragosmg envvar eval flycheck +generalizable +ggplot github +grDevices +grepl https igraph importFrom @@ -69,17 +80,28 @@ knitr labelled lang languageserver +lapply +len +lifecycle linter linters lintr's lowerCamelCalse +lubridate magrittr +magrittr's michaelchirico mis nd +nlevels nodeset nolint +nzchar +parseable +parser's patilindrajeets +performant +positionally pre programmatically qmd @@ -89,16 +111,18 @@ repo rlang roxygen sandboxing +se +sortedness src stopifnot +stringr styler subdir syntastic -syntatic +templated testthat th tibble -tibbles tidyverse tokenized travis @@ -106,11 +130,13 @@ tufte un unevaluated unicode +unnest unparseable untrusted vectorized vscode wercker +withr www xpath yoda diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index f6d614775..95af98b61 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -17,7 +17,7 @@ conjunct_test_linter,package_development best_practices readability configurable consecutive_assertion_linter,style readability consistency consecutive_mutate_linter,consistency readability configurable efficiency consecutive_stopifnot_linter,style readability consistency deprecated -cyclocomp_linter,style readability best_practices default configurable +cyclocomp_linter,style readability best_practices configurable duplicate_argument_linter,correctness common_mistakes configurable empty_assignment_linter,readability best_practices equals_na_linter,robustness correctness common_mistakes default @@ -90,7 +90,7 @@ repeat_linter,style readability return_linter,style configurable default routine_registration_linter,best_practices efficiency robustness sample_int_linter,efficiency readability robustness -scalar_in_linter,readability consistency best_practices efficiency +scalar_in_linter,readability consistency best_practices efficiency configurable semicolon_linter,style readability default configurable semicolon_terminator_linter,defunct seq_linter,robustness efficiency consistency best_practices default diff --git a/man/absolute_path_linter.Rd b/man/absolute_path_linter.Rd index f8b40a312..04fa1cf1a 100644 --- a/man/absolute_path_linter.Rd +++ b/man/absolute_path_linter.Rd @@ -18,9 +18,6 @@ If \code{TRUE}, only lint path strings, which Check that no absolute paths are used (e.g. "/var", "C:\\System", "~/docs"). } \examples{ -\dontshow{if (getRversion() >= "4.0") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -# Following examples use raw character constant syntax introduced in R 4.0. - # will produce lints lint( text = 'R"--[/blah/file.txt]--"', @@ -32,7 +29,7 @@ lint( text = 'R"(./blah)"', linters = absolute_path_linter() ) -\dontshow{\}) # examplesIf} + } \seealso{ \itemize{ diff --git a/man/backport_linter.Rd b/man/backport_linter.Rd index 4d72027dd..17bb27317 100644 --- a/man/backport_linter.Rd +++ b/man/backport_linter.Rd @@ -39,6 +39,11 @@ lint( linters = backport_linter("4.0.0") ) +lint( + text = "str2lang(x)", + linters = backport_linter("3.2.0", except = "str2lang") +) + } \seealso{ \link{linters} for a complete list of linters available in lintr. diff --git a/man/condition_call_linter.Rd b/man/condition_call_linter.Rd index a3b3ca7eb..e67651313 100644 --- a/man/condition_call_linter.Rd +++ b/man/condition_call_linter.Rd @@ -7,7 +7,7 @@ condition_call_linter(display_call = FALSE) } \arguments{ -\item{display_call}{Logical specifying expected behaviour regarding \code{call.} +\item{display_call}{Logical specifying expected behavior regarding \code{call.} argument in conditions. \itemize{ \item \code{NA} forces providing \verb{call. =} but ignores its value (this can be used in diff --git a/man/configurable_linters.Rd b/man/configurable_linters.Rd index cb1c17a54..1c72fffab 100644 --- a/man/configurable_linters.Rd +++ b/man/configurable_linters.Rd @@ -44,6 +44,7 @@ The following linters are tagged with 'configurable': \item{\code{\link{quotes_linter}}} \item{\code{\link{redundant_ifelse_linter}}} \item{\code{\link{return_linter}}} +\item{\code{\link{scalar_in_linter}}} \item{\code{\link{semicolon_linter}}} \item{\code{\link{string_boundary_linter}}} \item{\code{\link{todo_comment_linter}}} diff --git a/man/cyclocomp_linter.Rd b/man/cyclocomp_linter.Rd index 59a376cdf..93d42f905 100644 --- a/man/cyclocomp_linter.Rd +++ b/man/cyclocomp_linter.Rd @@ -7,13 +7,14 @@ cyclocomp_linter(complexity_limit = 15L) } \arguments{ -\item{complexity_limit}{Maximum cyclomatic complexity, default 15. Expressions more complex -than this are linted. See \code{\link[cyclocomp:cyclocomp]{cyclocomp::cyclocomp()}}.} +\item{complexity_limit}{Maximum cyclomatic complexity, default \code{15}. Expressions more complex +than this are linted.} } \description{ -Check for overly complicated expressions. See \code{\link[cyclocomp:cyclocomp]{cyclocomp::cyclocomp()}}. +Check for overly complicated expressions. See \code{cyclocomp()} function from \code{{cyclocomp}}. } \examples{ +\dontshow{if (requireNamespace("cyclocomp", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # will produce lints lint( text = "if (TRUE) 1 else 2", @@ -25,11 +26,11 @@ lint( text = "if (TRUE) 1 else 2", linters = cyclocomp_linter(complexity_limit = 2L) ) - +\dontshow{\}) # examplesIf} } \seealso{ \link{linters} for a complete list of linters available in lintr. } \section{Tags}{ -\link[=best_practices_linters]{best_practices}, \link[=configurable_linters]{configurable}, \link[=default_linters]{default}, \link[=readability_linters]{readability}, \link[=style_linters]{style} +\link[=best_practices_linters]{best_practices}, \link[=configurable_linters]{configurable}, \link[=readability_linters]{readability}, \link[=style_linters]{style} } diff --git a/man/default_linters.Rd b/man/default_linters.Rd index f14177a9a..cdaa763c7 100644 --- a/man/default_linters.Rd +++ b/man/default_linters.Rd @@ -5,7 +5,7 @@ \alias{default_linters} \title{Default linters} \format{ -An object of class \code{list} of length 26. +An object of class \code{list} of length 25. } \usage{ default_linters @@ -29,7 +29,6 @@ The following linters are tagged with 'default': \item{\code{\link{brace_linter}}} \item{\code{\link{commas_linter}}} \item{\code{\link{commented_code_linter}}} -\item{\code{\link{cyclocomp_linter}}} \item{\code{\link{equals_na_linter}}} \item{\code{\link{function_left_parentheses_linter}}} \item{\code{\link{indentation_linter}}} diff --git a/man/default_settings.Rd b/man/default_settings.Rd index d00239816..3c4d26f19 100644 --- a/man/default_settings.Rd +++ b/man/default_settings.Rd @@ -10,7 +10,7 @@ \alias{.lintr} \title{Default lintr settings} \format{ -An object of class \code{list} of length 13. +An object of class \code{list} of length 12. } \usage{ default_settings @@ -26,7 +26,6 @@ The default settings consist of \item \code{exclusions}: a list of exclusions, see \code{\link[=exclude]{exclude()}} for a complete description of valid values. \item \code{cache_directory}: location of cache directory \item \code{comment_token}: a GitHub token character -\item \code{comment_bot}: decides if lintr comment bot on GitHub can comment on commits \item \code{error_on_lint}: decides if error should be produced when any lints are found } diff --git a/man/exclude.Rd b/man/exclude.Rd index 3a97087e1..b454dea15 100644 --- a/man/exclude.Rd +++ b/man/exclude.Rd @@ -42,3 +42,4 @@ a character vector of files to exclude or a vector of lines to exclude. } } } +\keyword{internal} diff --git a/man/expect_lint.Rd b/man/expect_lint.Rd index 8b7a22fc1..943cfd1a2 100644 --- a/man/expect_lint.Rd +++ b/man/expect_lint.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/expect_lint.R \name{expect_lint} \alias{expect_lint} +\alias{expect_no_lint} \title{Lint expectation} \usage{ expect_lint(content, checks, ..., file = NULL, language = "en") + +expect_no_lint(content, ..., file = NULL, language = "en") } \arguments{ \item{content}{a character vector for the file content to be linted, each vector element representing a line of @@ -33,11 +36,15 @@ This makes testing them reproducible on all systems irrespective of their native \code{NULL}, invisibly. } \description{ -This is an expectation function to test that the lints produced by \code{lint} satisfy a number of checks. +These are expectation functions to test specified linters on sample code in the \code{testthat} testing framework. +\itemize{ +\item \code{expect_lint} asserts that specified lints are generated. +\item \code{expect_no_lint} asserts that no lints are generated. +} } \examples{ # no expected lint -expect_lint("a", NULL, trailing_blank_lines_linter()) +expect_no_lint("a", trailing_blank_lines_linter()) # one expected lint expect_lint("a\n", "trailing blank", trailing_blank_lines_linter()) diff --git a/man/expect_lint_free.Rd b/man/expect_lint_free.Rd index 87ee5be8f..e4043d7c4 100644 --- a/man/expect_lint_free.Rd +++ b/man/expect_lint_free.Rd @@ -11,6 +11,6 @@ expect_lint_free(...) } \description{ This function is a thin wrapper around lint_package that simply tests there are no -lints in the package. It can be used to ensure that your tests fail if the package +lints in the package. It can be used to ensure that your tests fail if the package contains lints. } diff --git a/man/get_r_string.Rd b/man/get_r_string.Rd index 05b8c6062..418d0f17c 100644 --- a/man/get_r_string.Rd +++ b/man/get_r_string.Rd @@ -15,10 +15,9 @@ and \code{xpath} is specified, it is extracted with \code{\link[xml2:xml_find_al } \description{ Convert \code{STR_CONST} \code{text()} values into R strings. This is useful to account for arbitrary -character literals valid since R 4.0, e.g. \code{R"------[hello]------"}, which is parsed in -R as \code{"hello"}. It is quite cumbersome to write XPaths allowing for strings like this, -so whenever your linter logic requires testing a \code{STR_CONST} node's value, use this -function. +character literals, e.g. \code{R"------[hello]------"}, which is parsed in R as \code{"hello"}. +It is quite cumbersome to write XPaths allowing for strings like this, so whenever your +linter logic requires testing a \code{STR_CONST} node's value, use this function. NB: this is also properly vectorized on \code{s}, and accepts a variety of inputs. Empty inputs will become \code{NA} outputs, which helps ensure that \code{length(get_r_string(s)) == length(s)}. } @@ -27,18 +26,17 @@ tmp <- tempfile() writeLines("c('a', 'b')", tmp) expr_as_xml <- get_source_expressions(tmp)$expressions[[1L]]$xml_parsed_content writeLines(as.character(expr_as_xml)) -get_r_string(expr_as_xml, "expr[2]") # "a" -get_r_string(expr_as_xml, "expr[3]") # "b" +get_r_string(expr_as_xml, "expr[2]") +get_r_string(expr_as_xml, "expr[3]") unlink(tmp) -# more importantly, extract strings under R>=4 raw strings -\dontshow{if (getRversion() >= "4.0.0") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -tmp4.0 <- tempfile() -writeLines("c(R'(a\\\\b)', R'--[a\\\\\"\'\"\\\\b]--')", tmp4.0) -expr_as_xml4.0 <- get_source_expressions(tmp4.0)$expressions[[1L]]$xml_parsed_content -writeLines(as.character(expr_as_xml4.0)) -get_r_string(expr_as_xml4.0, "expr[2]") # "a\\b" -get_r_string(expr_as_xml4.0, "expr[3]") # "a\\\"'\"\\b" -unlink(tmp4.0) -\dontshow{\}) # examplesIf} +# more importantly, extract raw strings correctly +tmp_raw <- tempfile() +writeLines("c(R'(a\\\\b)', R'--[a\\\\\"\'\"\\\\b]--')", tmp_raw) +expr_as_xml_raw <- get_source_expressions(tmp_raw)$expressions[[1L]]$xml_parsed_content +writeLines(as.character(expr_as_xml_raw)) +get_r_string(expr_as_xml_raw, "expr[2]") +get_r_string(expr_as_xml_raw, "expr[3]") +unlink(tmp_raw) + } diff --git a/man/inner_combine_linter.Rd b/man/inner_combine_linter.Rd index 73ac594e2..6455f5d68 100644 --- a/man/inner_combine_linter.Rd +++ b/man/inner_combine_linter.Rd @@ -13,6 +13,14 @@ The same equivalence holds for several other vectorized functions like preferred so that the most expensive part of the operation (\code{\link[=as.Date]{as.Date()}}) is applied only once. } +\details{ +Note that \code{\link[=strptime]{strptime()}} has one idiosyncrasy to be aware of, namely that +auto-detected \verb{format=} is set by the first matching input, which means +that a case like \code{c(as.POSIXct("2024-01-01"), as.POSIXct("2024-01-01 01:02:03"))} +gives different results to \code{as.POSIXct(c("2024-01-01", "2024-01-01 01:02:03"))}. +This false positive is rare; a workaround where possible is to use +consistent formatting, i.e., \code{"2024-01-01 00:00:00"} in the example. +} \examples{ # will produce lints lint( diff --git a/man/linters.Rd b/man/linters.Rd index 10c45d374..394bd6126 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -19,10 +19,10 @@ The following tags exist: \itemize{ \item{\link[=best_practices_linters]{best_practices} (63 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (11 linters)} -\item{\link[=configurable_linters]{configurable} (43 linters)} +\item{\link[=configurable_linters]{configurable} (44 linters)} \item{\link[=consistency_linters]{consistency} (32 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} -\item{\link[=default_linters]{default} (26 linters)} +\item{\link[=default_linters]{default} (25 linters)} \item{\link[=deprecated_linters]{deprecated} (6 linters)} \item{\link[=efficiency_linters]{efficiency} (32 linters)} \item{\link[=executing_linters]{executing} (6 linters)} @@ -54,7 +54,7 @@ The following linters exist: \item{\code{\link{conjunct_test_linter}} (tags: best_practices, configurable, package_development, pkg_testthat, readability)} \item{\code{\link{consecutive_assertion_linter}} (tags: consistency, readability, style)} \item{\code{\link{consecutive_mutate_linter}} (tags: configurable, consistency, efficiency, readability)} -\item{\code{\link{cyclocomp_linter}} (tags: best_practices, configurable, default, readability, style)} +\item{\code{\link{cyclocomp_linter}} (tags: best_practices, configurable, readability, style)} \item{\code{\link{duplicate_argument_linter}} (tags: common_mistakes, configurable, correctness)} \item{\code{\link{empty_assignment_linter}} (tags: best_practices, readability)} \item{\code{\link{equals_na_linter}} (tags: common_mistakes, correctness, default, robustness)} @@ -123,7 +123,7 @@ The following linters exist: \item{\code{\link{return_linter}} (tags: configurable, default, style)} \item{\code{\link{routine_registration_linter}} (tags: best_practices, efficiency, robustness)} \item{\code{\link{sample_int_linter}} (tags: efficiency, readability, robustness)} -\item{\code{\link{scalar_in_linter}} (tags: best_practices, consistency, efficiency, readability)} +\item{\code{\link{scalar_in_linter}} (tags: best_practices, configurable, consistency, efficiency, readability)} \item{\code{\link{semicolon_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{seq_linter}} (tags: best_practices, consistency, default, efficiency, robustness)} \item{\code{\link{sort_linter}} (tags: best_practices, efficiency, readability)} diff --git a/man/outer_negation_linter.Rd b/man/outer_negation_linter.Rd index 14260645f..d29f38ed3 100644 --- a/man/outer_negation_linter.Rd +++ b/man/outer_negation_linter.Rd @@ -7,7 +7,7 @@ outer_negation_linter() } \description{ -\code{any(!x)} is logically equivalent to \code{!any(x)}; ditto for the equivalence of +\code{any(!x)} is logically equivalent to \code{!all(x)}; ditto for the equivalence of \code{all(!x)} and \code{!any(x)}. Negating after aggregation only requires inverting one logical value, and is typically more readable. } diff --git a/man/parse_exclusions.Rd b/man/parse_exclusions.Rd index d496c6b17..881642e44 100644 --- a/man/parse_exclusions.Rd +++ b/man/parse_exclusions.Rd @@ -42,3 +42,4 @@ A possibly named list of excluded lines, possibly for specific linters. \description{ read a source file and parse all the excluded lines from it } +\keyword{internal} diff --git a/man/paste_linter.Rd b/man/paste_linter.Rd index 561ce8709..2317800cf 100644 --- a/man/paste_linter.Rd +++ b/man/paste_linter.Rd @@ -70,6 +70,11 @@ lint( linters = paste_linter(allow_file_path = "never") ) +lint( + text = 'paste0(x, collapse = "")', + linters = paste_linter() +) + # okay lint( text = 'paste0("a", "b")', @@ -111,6 +116,11 @@ lint( linters = paste_linter() ) +lint( + text = 'paste(x, collapse = "")', + linters = paste_linter() +) + } \seealso{ \link{linters} for a complete list of linters available in lintr. diff --git a/man/read_settings.Rd b/man/read_settings.Rd index bc02121c1..cbb1dc9ec 100644 --- a/man/read_settings.Rd +++ b/man/read_settings.Rd @@ -4,10 +4,12 @@ \alias{read_settings} \title{Read lintr settings} \usage{ -read_settings(filename) +read_settings(filename, call = parent.frame()) } \arguments{ \item{filename}{Source file to be linted.} + +\item{call}{Passed to malformed to ensure linear trace.} } \description{ Lintr searches for settings for a given source file in the following order: diff --git a/man/scalar_in_linter.Rd b/man/scalar_in_linter.Rd index be94fd1a1..1773c699f 100644 --- a/man/scalar_in_linter.Rd +++ b/man/scalar_in_linter.Rd @@ -4,12 +4,15 @@ \alias{scalar_in_linter} \title{Block usage like x \%in\% "a"} \usage{ -scalar_in_linter() +scalar_in_linter(in_operators = NULL) +} +\arguments{ +\item{in_operators}{Character vector of additional infix operators that behave like the \code{\%in\%} operator, +e.g. \code{{data.table}}'s \verb{\%chin\%} operator.} } \description{ \code{vector \%in\% set} is appropriate for matching a vector to a set, but if -that set has size 1, \code{==} is more appropriate. \verb{\%chin\%} from \code{{data.table}} -is matched as well. +that set has size 1, \code{==} is more appropriate. } \details{ \code{scalar \%in\% vector} is OK, because the alternative (\code{any(vector == scalar)}) @@ -24,7 +27,7 @@ lint( lint( text = "x \%chin\% 'a'", - linters = scalar_in_linter() + linters = scalar_in_linter(in_operators = "\%chin\%") ) # okay @@ -38,5 +41,5 @@ lint( \link{linters} for a complete list of linters available in lintr. } \section{Tags}{ -\link[=best_practices_linters]{best_practices}, \link[=consistency_linters]{consistency}, \link[=efficiency_linters]{efficiency}, \link[=readability_linters]{readability} +\link[=best_practices_linters]{best_practices}, \link[=configurable_linters]{configurable}, \link[=consistency_linters]{consistency}, \link[=efficiency_linters]{efficiency}, \link[=readability_linters]{readability} } diff --git a/man/undesirable_function_linter.Rd b/man/undesirable_function_linter.Rd index 210042457..1a73f29ce 100644 --- a/man/undesirable_function_linter.Rd +++ b/man/undesirable_function_linter.Rd @@ -20,8 +20,7 @@ use \code{\link[=modify_defaults]{modify_defaults()}}.} name as a symbol undesirable or not.} } \description{ -Report the use of undesirable functions (e.g. \code{\link[base:function]{base::return()}}, \code{\link[base:options]{base::options()}}, or -\code{\link[base:lapply]{base::sapply()}}) and suggest an alternative. +Report the use of undesirable functions and suggest an alternative. } \examples{ # defaults for which functions are considered undesirable diff --git a/man/unnecessary_nesting_linter.Rd b/man/unnecessary_nesting_linter.Rd index 0e185446d..7506aef37 100644 --- a/man/unnecessary_nesting_linter.Rd +++ b/man/unnecessary_nesting_linter.Rd @@ -107,7 +107,7 @@ lint( } \seealso{ \itemize{ -\item \code{\link[=cyclocomp_linter]{cyclocomp_linter()}} for another linter that penalizes overly complexcode. +\item \code{\link[=cyclocomp_linter]{cyclocomp_linter()}} for another linter that penalizes overly complex code. \item \link{linters} for a complete list of linters available in lintr. } } diff --git a/tests/testthat/default_linter_testcode.R b/tests/testthat/default_linter_testcode.R index 1f9f060d6..1cadc18cc 100644 --- a/tests/testthat/default_linter_testcode.R +++ b/tests/testthat/default_linter_testcode.R @@ -15,7 +15,6 @@ g <- function(x) { # commented_code # some <- commented("out code") -# cyclocomp # equals_na # brace_linter # indentation diff --git a/tests/testthat/dummy_projects/project/default_linter_testcode.R b/tests/testthat/dummy_projects/project/default_linter_testcode.R index ba87313b3..3098b0b02 100644 --- a/tests/testthat/dummy_projects/project/default_linter_testcode.R +++ b/tests/testthat/dummy_projects/project/default_linter_testcode.R @@ -10,7 +10,6 @@ f = function (x,y = 1){} # commented_code # some <- commented("out code") -# cyclocomp # equals_na # infix_spaces # line_length diff --git a/tests/testthat/test-Lint-builder.R b/tests/testthat/test-Lint-builder.R index 3d081a1af..be5481f7b 100644 --- a/tests/testthat/test-Lint-builder.R +++ b/tests/testthat/test-Lint-builder.R @@ -2,26 +2,32 @@ test_that("Lint() errors on invalid input", { dummy_line <- "abc" expect_error( Lint("dummy.R", line = dummy_line, column_number = NA_integer_), - rex::rex("`column_number` must be an integer between 0 and nchar(line) + 1 (4). It was NA.") + "`column_number` must be an integer between 0 and 4 (`nchar(line) + 1`)", + fixed = TRUE ) expect_error( Lint("dummy.R", line = dummy_line, line_number = 0L), - rex::rex("`line_number` must be a positive integer. It was 0.") + "`line_number` must be a positive integer", + fixed = TRUE ) expect_error( Lint("dummy.R", ranges = c(1L, 3L)), - rex::rex("`ranges` must be NULL or a list.") + "`ranges` must be `NULL` or a list", + fixed = TRUE ) expect_error( Lint("dummy.R", ranges = list(1L)), - rex::rex("`ranges` must only contain length 2 integer vectors without NAs.") + "`ranges` must only contain integer vectors of length 2 without `NA`s.", + fixed = TRUE ) expect_error( Lint("dummy.R", ranges = list(c(1L, NA_integer_))), - rex::rex("`ranges` must only contain length 2 integer vectors without NAs.") + "`ranges` must only contain integer vectors of length 2 without `NA`s.", + fixed = TRUE ) expect_error( Lint("dummy.R", line = dummy_line, ranges = list(c(1L, 2L), c(1L, 5L))), - rex::rex("All entries in `ranges` must satisfy 0 <= range[1L] <= range[2L] <= nchar(line) + 1 (4).") + "`ranges` must satisfy 0 <= range[1L] <= range[2L] <= 4 (nchar(line) + 1).", + fixed = TRUE ) }) diff --git a/tests/testthat/test-backport_linter.R b/tests/testthat/test-backport_linter.R index 0ecb9902a..ac193c2db 100644 --- a/tests/testthat/test-backport_linter.R +++ b/tests/testthat/test-backport_linter.R @@ -1,8 +1,7 @@ test_that("backport_linter produces error when R version misspecified", { expect_error( lint(text = "numToBits(2)", linters = backport_linter(420L)), - "`r_version` must be a R version number, returned by R_system_version(), or a string.", - fixed = TRUE + "`r_version` must be an R version number" ) }) @@ -44,7 +43,10 @@ test_that("backport_linter detects backwards-incompatibility", { backport_linter("oldrel") ) - expect_error(backport_linter("oldrel-99"), "`r_version` must be a version number or one of") + expect_error( + backport_linter("oldrel-99"), + "`r_version` is not valid" + ) expect_lint( "numToBits(2)", @@ -70,7 +72,7 @@ test_that("backport_linter generates expected warnings", { { l <- lint(tmp, backport_linter("2.0.0")) }, - "version older than 3.0.0", + 'version older than "3.0.0"', fixed = TRUE ) expect_identical(l, lint(tmp, backport_linter("3.0.0"))) diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 6b0c47aa1..a0024708b 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -435,15 +435,16 @@ test_that("it works outside of a package", { test_that("cache = TRUE workflow works", { # Need a test structure with a safe to load .lintr - pkg <- "dummy_packages/package" - files <- normalizePath(list.files(pkg, recursive = TRUE, full.names = TRUE)) + withr::local_dir(file.path("dummy_packages", "package")) + withr::local_options(lintr.linter_file = "lintr_test_config") + files <- normalize_path(list.files(recursive = TRUE, full.names = TRUE)) # Manually clear cache (that function is exported) for (f in files) { clear_cache(file = f) } - l1 <- lint_package(pkg, cache = TRUE) - l2 <- lint_package(pkg, cache = TRUE) + l1 <- lint_package(cache = TRUE) + l2 <- lint_package(cache = TRUE) expect_identical(l1, l2) }) diff --git a/tests/testthat/test-ci.R b/tests/testthat/test-ci.R index df42f8cd6..3f4f98762 100644 --- a/tests/testthat/test-ci.R +++ b/tests/testthat/test-ci.R @@ -1,5 +1,4 @@ test_that("GitHub Actions functionality works", { - # imitate being on GHA whether or not we are withr::local_envvar(list(GITHUB_ACTIONS = "true")) withr::local_options(lintr.rstudio_source_markers = FALSE) tmp <- withr::local_tempfile(lines = "x <- 1:nrow(y)") @@ -9,12 +8,10 @@ test_that("GitHub Actions functionality works", { }) test_that("GitHub Actions functionality works in a subdirectory", { - # imitate being on GHA whether or not we are pkg_path <- test_path("dummy_packages", "assignmentLinter") withr::local_envvar(list(GITHUB_ACTIONS = "true")) withr::local_options(lintr.rstudio_source_markers = FALSE, lintr.github_annotation_project_dir = pkg_path) - lintr:::read_settings(NULL) l <- lint_package( pkg_path, linters = list(assignment_linter()), @@ -26,14 +23,31 @@ test_that("GitHub Actions functionality works in a subdirectory", { ) }) -test_that("GitHub Actions - linting on error works", { - # imitate being on GHA whether or not we are - withr::local_envvar(list(GITHUB_ACTIONS = "true", LINTR_ERROR_ON_LINT = "true")) - withr::local_options(lintr.rstudio_source_markers = FALSE) - tmp <- withr::local_tempfile(lines = "x <- 1:nrow(y)") +patrick::with_parameters_test_that( + "GitHub Actions - error on lint works", + { + withr::local_envvar(list(GITHUB_ACTIONS = "true", LINTR_ERROR_ON_LINT = env_var_value)) + withr::local_options(lintr.rstudio_source_markers = FALSE) + tmp <- withr::local_tempfile(lines = "x <- 1:nrow(y)") - l <- lint(tmp) + l <- lint(tmp) - local_mocked_bindings(quit = function(...) cat("Tried to quit.\n")) - expect_output(print(l), "::warning file", fixed = TRUE) -}) + local_mocked_bindings(quit = function(...) cat("Tried to quit.\n")) + expect_output(print(l), "::warning file", fixed = TRUE) + }, + env_var_value = list("T", "true") +) + +patrick::with_parameters_test_that( + "GitHub Actions - env var for error on lint is converted to logical", + { + withr::local_envvar(list(GITHUB_ACTIONS = "true", LINTR_ERROR_ON_LINT = env_var_value)) + withr::local_options(lintr.rstudio_source_markers = FALSE) + tmp <- withr::local_tempfile(lines = "x <- 1:nrow(y)") + + l <- lint(tmp) + + expect_output(print(l), "::warning file", fixed = TRUE) + }, + env_var_value = list("", "F", NA, NULL) +) diff --git a/tests/testthat/test-cyclocomp_linter.R b/tests/testthat/test-cyclocomp_linter.R index 4f2b463f7..5e14b5680 100644 --- a/tests/testthat/test-cyclocomp_linter.R +++ b/tests/testthat/test-cyclocomp_linter.R @@ -1,4 +1,6 @@ test_that("returns the correct linting", { + skip_if_not_installed("cyclocomp") + cc_linter_1 <- cyclocomp_linter(1L) cc_linter_2 <- cyclocomp_linter(2L) lint_msg <- rex::rex("Reduce the cyclomatic complexity of this function") diff --git a/tests/testthat/test-exclusions.R b/tests/testthat/test-exclusions.R index ae405b2d5..d4e8dd5c6 100644 --- a/tests/testthat/test-exclusions.R +++ b/tests/testthat/test-exclusions.R @@ -41,7 +41,7 @@ test_that("it gives the expected error message when there is only one start but expect_error( lintr:::parse_exclusions("dummy_projects/project/one_start_no_end.R"), - "has 1 range start (line 3) but only 0 range ends for exclusion from linting", + "has 1 range start (line 3) and 0 range ends", fixed = TRUE ) }) @@ -51,7 +51,7 @@ test_that("it gives the expected error message when there is mismatch between mu expect_error( lintr:::parse_exclusions("dummy_projects/project/mismatched_starts_ends.R"), - "has 3 range starts (lines 3, 7, 11) but only 2 range ends (lines 1, 9) for exclusion from linting", + "has 3 range starts (lines 3, 7, 11) and 2 range ends (lines 1, 9)", fixed = TRUE ) }) diff --git a/tests/testthat/test-expect_identical_linter.R b/tests/testthat/test-expect_identical_linter.R index d5e26548a..a672acbfe 100644 --- a/tests/testthat/test-expect_identical_linter.R +++ b/tests/testthat/test-expect_identical_linter.R @@ -30,6 +30,10 @@ test_that("expect_identical_linter skips cases likely testing numeric equality", lint_msg <- rex::rex("Use expect_identical(x, y) by default; resort to expect_equal() only when needed") expect_lint("expect_equal(x, 1.034)", NULL, linter) + expect_lint("expect_equal(x, -1.034)", NULL, linter) + expect_lint("expect_equal(x, c(-1.034))", NULL, linter) + expect_lint("expect_equal(x, -c(1.034))", NULL, linter) + expect_lint("expect_equal(x, c(1.01, 1.02))", NULL, linter) # whole numbers with explicit decimals are OK, even in mixed scenarios expect_lint("expect_equal(x, c(1.0, 2))", NULL, linter) @@ -39,6 +43,9 @@ test_that("expect_identical_linter skips cases likely testing numeric equality", # NB: TRUE is a NUM_CONST so we want test matching it, even though this test is # also a violation of expect_true_false_linter() expect_lint("expect_equal(x, TRUE)", lint_msg, linter) + + expect_lint("expect_equal(x, 1.01 - y)", lint_msg, linter) + expect_lint("expect_equal(x, foo() - 0.01)", lint_msg, linter) }) test_that("expect_identical_linter skips 3e cases needing expect_equal", { diff --git a/tests/testthat/test-expect_lint.R b/tests/testthat/test-expect_lint.R index 622882884..ea23dce34 100644 --- a/tests/testthat/test-expect_lint.R +++ b/tests/testthat/test-expect_lint.R @@ -6,9 +6,9 @@ linter <- assignment_linter() lint_msg <- "Use <-, not =" test_that("no checks", { - expect_success(expect_lint("a", NULL, linter)) - expect_success(expect_lint("a=1", NULL, list())) - expect_failure(expect_lint("a=1", NULL, linter)) + expect_success(expect_no_lint("a", linter)) + expect_success(expect_no_lint("a=1", list())) + expect_failure(expect_no_lint("a=1", linter)) }) test_that("single check", { @@ -23,7 +23,7 @@ test_that("single check", { expect_success(expect_lint("a=1", c(message = lint_msg, line_number = 1L), linter)) expect_failure(expect_lint("a=1", c(line_number = 2L, message = lint_msg), linter)) - expect_error(expect_lint("a=1", c(message = lint_msg, lineXXX = 1L), linter), "invalid field") + expect_error(expect_lint("a=1", c(message = lint_msg, lineXXX = 1L), linter), "Check 1 has an invalid field: lineXXX") expect_failure(expect_lint("foo ()", list(ranges = list(c(2L, 2L))), function_left_parentheses_linter())) expect_success(expect_lint("\t1", list(ranges = list(c(1L, 1L))), whitespace_linter())) diff --git a/tests/testthat/test-fixed_regex_linter.R b/tests/testthat/test-fixed_regex_linter.R index 371848200..98a279a02 100644 --- a/tests/testthat/test-fixed_regex_linter.R +++ b/tests/testthat/test-fixed_regex_linter.R @@ -1,9 +1,3 @@ -# NB: escaping is confusing. We have to double-escape everything -- the first -# escape creates a string that will be parse()d, the second escape is normal -# escaping that would be done in R code. E.g. in "\\\\.", the R code would -# read like "\\.", but in order to create those two slashes, we need to write -# "\\\\." in the string here. - test_that("fixed_regex_linter skips allowed usages", { linter <- fixed_regex_linter() @@ -11,15 +5,15 @@ test_that("fixed_regex_linter skips allowed usages", { expect_lint("grep('x$', '', y)", NULL, linter) expect_lint("sub('[a-zA-Z]', '', y)", NULL, linter) expect_lint("grepl(fmt, y)", NULL, linter) - expect_lint("regexec('\\\\s', '', y)", NULL, linter) + expect_lint(R"{regexec('\\s', '', y)}", NULL, linter) expect_lint("grep('a(?=b)', x, perl = TRUE)", NULL, linter) expect_lint("grep('0+1', x, perl = TRUE)", NULL, linter) expect_lint("grep('1*2', x)", NULL, linter) expect_lint("grep('a|b', x)", NULL, linter) - expect_lint("grep('\\\\[|\\\\]', x)", NULL, linter) + expect_lint(R"{grep('\\[|\\]', x)}", NULL, linter) # if fixed=TRUE is already set, regex patterns don't matter - expect_lint("gsub('\\\\.', '', y, fixed = TRUE)", NULL, linter) + expect_lint(R"{gsub('\\.', '', y, fixed = TRUE)}", NULL, linter) # ignore.case=TRUE implies regex interpretation expect_lint("gsub('abcdefg', '', y, ignore.case = TRUE)", NULL, linter) @@ -37,10 +31,10 @@ test_that("fixed_regex_linter blocks simple disallowed usages", { linter <- fixed_regex_linter() lint_msg <- rex::rex("This regular expression is static") - expect_lint("gsub('\\\\.', '', x)", lint_msg, linter) + expect_lint(R"{gsub('\\.', '', x)}", lint_msg, linter) expect_lint("grepl('abcdefg', x)", lint_msg, linter) expect_lint("gregexpr('a-z', y)", lint_msg, linter) - expect_lint("regexec('\\\\$', x)", lint_msg, linter) + expect_lint(R"{regexec('\\$', x)}", lint_msg, linter) expect_lint("grep('\n', x)", lint_msg, linter) # naming the argument doesn't matter (if it's still used positionally) @@ -51,13 +45,13 @@ patrick::with_parameters_test_that( "fixed_regex_linter is robust to unrecognized escapes error", { expect_lint( - sprintf("grep('\\\\%s', x)", char), + sprintf(R"{grep('\\%s', x)}", char), rex::rex("This regular expression is static"), fixed_regex_linter() ) expect_lint( - sprintf("strsplit('a%sb', '\\\\%s')", char, char), + sprintf(R"{strsplit('a%sb', '\\%s')}", char, char), rex::rex("This regular expression is static"), fixed_regex_linter() ) @@ -65,10 +59,10 @@ patrick::with_parameters_test_that( .cases = local({ char <- c( "^", "$", "{", "}", "(", ")", ".", "*", "+", "?", - "|", "[", "]", "\\\\", "<", ">", "=", ":", ";", "/", + "|", "[", "]", R"(\\)", "<", ">", "=", ":", ";", "/", "_", "-", "!", "@", "#", "%", "&", "~" ) - data.frame(char = char, .test_name = char, stringsAsFactors = FALSE) + data.frame(char = char, .test_name = char) }) ) @@ -87,7 +81,7 @@ test_that("fixed_regex_linter catches null calls to strsplit as well", { linter <- fixed_regex_linter() expect_lint("strsplit(x, '^x')", NULL, linter) - expect_lint("strsplit(x, '\\\\s')", NULL, linter) + expect_lint(R"{strsplit(x, '\\s')}", NULL, linter) expect_lint("strsplit(x, 'a(?=b)', perl = TRUE)", NULL, linter) expect_lint("strsplit(x, '0+1', perl = TRUE)", NULL, linter) expect_lint("strsplit(x, 'a|b')", NULL, linter) @@ -97,15 +91,15 @@ test_that("fixed_regex_linter catches null calls to strsplit as well", { expect_lint("tstrsplit(x, fmt)", NULL, linter) # if fixed=TRUE is already set, regex patterns don't matter - expect_lint("strsplit(x, '\\\\.', fixed = TRUE)", NULL, linter) - expect_lint("strsplit(x, '\\\\.', fixed = T)", NULL, linter) + expect_lint(R"{strsplit(x, '\\.', fixed = TRUE)}", NULL, linter) + expect_lint(R"{strsplit(x, '\\.', fixed = T)}", NULL, linter) }) test_that("fixed_regex_linter catches calls to strsplit as well", { linter <- fixed_regex_linter() lint_msg <- rex::rex("This regular expression is static") - expect_lint("strsplit(x, '\\\\.')", lint_msg, linter) + expect_lint(R"{strsplit(x, '\\.')}", lint_msg, linter) expect_lint("strsplit(x, '[.]')", lint_msg, linter) expect_lint("tstrsplit(x, 'abcdefg')", lint_msg, linter) @@ -115,8 +109,8 @@ test_that("fixed_regex_linter is more exact about distinguishing \\s from \\:", linter <- fixed_regex_linter() lint_msg <- rex::rex("This regular expression is static") - expect_lint("grep('\\\\s', '', x)", NULL, linter) - expect_lint("grep('\\\\:', '', x)", lint_msg, linter) + expect_lint(R"{grep('\\s', '', x)}", NULL, linter) + expect_lint(R"{grep('\\:', '', x)}", lint_msg, linter) }) ## tests for stringr functions @@ -126,12 +120,12 @@ test_that("fixed_regex_linter skips allowed stringr usages", { expect_lint("str_replace(y, '[a-zA-Z]', '')", NULL, linter) expect_lint("str_replace_all(y, '^x', '')", NULL, linter) expect_lint("str_detect(y, fmt)", NULL, linter) - expect_lint("str_extract(y, '\\\\s')", NULL, linter) - expect_lint("str_extract_all(y, '\\\\s')", NULL, linter) + expect_lint(R"{str_extract(y, '\\s')}", NULL, linter) + expect_lint(R"{str_extract_all(y, '\\s')}", NULL, linter) expect_lint("str_which(x, '1*2')", NULL, linter) # if fixed() is already set, regex patterns don't matter - expect_lint("str_replace(y, fixed('\\\\.'), '')", NULL, linter) + expect_lint(R"{str_replace(y, fixed('\\.'), '')}", NULL, linter) # namespace qualification doesn't matter expect_lint("stringr::str_replace(y, stringr::fixed('abcdefg'), '')", NULL, linter) @@ -141,16 +135,16 @@ test_that("fixed_regex_linter blocks simple disallowed usages of stringr functio linter <- fixed_regex_linter() lint_msg <- rex::rex("This regular expression is static") - expect_lint("str_replace_all(x, '\\\\.', '')", lint_msg, linter) + expect_lint(R"{str_replace_all(x, '\\.', '')}", lint_msg, linter) expect_lint("str_detect(x, 'abcdefg')", lint_msg, linter) expect_lint("str_locate(y, 'a-z')", lint_msg, linter) - expect_lint("str_subset(x, '\\\\$')", lint_msg, linter) + expect_lint(R"{str_subset(x, '\\$')}", lint_msg, linter) expect_lint("str_which(x, '\n')", lint_msg, linter) # named, positional arguments are still caught expect_lint("str_locate(y, pattern = 'a-z')", lint_msg, linter) # nor do other named arguments throw things off - expect_lint("str_starts(x, '\\\\.', negate = TRUE)", lint_msg, linter) + expect_lint(R"{str_starts(x, '\\.', negate = TRUE)}", lint_msg, linter) }) test_that("fixed_regex_linter catches calls to str_split as well", { @@ -161,8 +155,8 @@ test_that("fixed_regex_linter catches calls to str_split as well", { expect_lint("str_split(x, fmt)", NULL, linter) # if fixed() is already set, regex patterns don't matter - expect_lint("str_split(x, fixed('\\\\.'))", NULL, linter) - expect_lint("str_split(x, '\\\\.')", lint_msg, linter) + expect_lint(R"{str_split(x, fixed('\\.'))}", NULL, linter) + expect_lint(R"{str_split(x, '\\.')}", lint_msg, linter) expect_lint("str_split(x, '[.]')", lint_msg, linter) }) @@ -187,24 +181,24 @@ test_that("one-character character classes with escaped characters are caught", linter <- fixed_regex_linter() lint_msg <- rex::rex("This regular expression is static") - expect_lint("gsub('[\\n]', '', x)", lint_msg, linter) - expect_lint("gsub('[\\\"]', '', x)", lint_msg, linter) - expect_lint('gsub("\\\\<", "x", x, perl = TRUE)', lint_msg, linter) - - expect_lint("str_split(x, '[\\1]')", lint_msg, linter) - expect_lint("str_split(x, '[\\12]')", lint_msg, linter) - expect_lint("str_split(x, '[\\123]')", lint_msg, linter) - expect_lint("str_split(x, '[\\xa]')", lint_msg, linter) - expect_lint("str_split(x, '[\\x32]')", lint_msg, linter) - expect_lint("str_split(x, '[\\uF]')", lint_msg, linter) - expect_lint("str_split(x, '[\\u01]')", lint_msg, linter) - expect_lint("str_split(x, '[\\u012]')", lint_msg, linter) - expect_lint("str_split(x, '[\\u0123]')", lint_msg, linter) - expect_lint("str_split(x, '[\\U8]')", lint_msg, linter) - expect_lint("str_split(x, '[\\U1d4d7]')", lint_msg, linter) - expect_lint("str_split(x, '[\\u{1}]')", lint_msg, linter) - expect_lint("str_split(x, '[\\U{F7D5}]')", lint_msg, linter) - expect_lint("str_split(x, '[\\U{1D4D7}]')", lint_msg, linter) + expect_lint(R"{gsub('[\n]', '', x)}", lint_msg, linter) + expect_lint(R"{gsub('[\"]', '', x)}", lint_msg, linter) + expect_lint(R'{gsub("\\<", "x", x, perl = TRUE)}', lint_msg, linter) + + expect_lint(R"{str_split(x, '[\1]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\12]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\123]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\xa]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\x32]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\uF]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\u01]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\u012]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\u0123]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\U8]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\U1d4d7]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\u{1}]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\U{F7D5}]')}", lint_msg, linter) + expect_lint(R"{str_split(x, '[\U{1D4D7}]')}", lint_msg, linter) }) test_that("bracketed unicode escapes are caught", { @@ -218,15 +212,15 @@ test_that("bracketed unicode escapes are caught", { test_that("escaped characters are handled correctly", { linter <- fixed_regex_linter() - expect_lint("gsub('\\n+', '', sql)", NULL, linter) + expect_lint(R"{gsub('\n+', '', sql)}", NULL, linter) expect_lint('gsub("\\n{2,}", "\n", D)', NULL, linter) - expect_lint('gsub("[\\r\\n]", "", x)', NULL, linter) - expect_lint('gsub("\\n $", "", y)', NULL, linter) - expect_lint('gsub("```\\n*```r*\\n*", "", x)', NULL, linter) + expect_lint(R'{gsub("[\r\n]", "", x)}', NULL, linter) + expect_lint(R'{gsub("\n $", "", y)}', NULL, linter) + expect_lint(R'{gsub("```\n*```r*\n*", "", x)}', NULL, linter) expect_lint('strsplit(x, "(;|\n)")', NULL, linter) - expect_lint('strsplit(x, "(;|\\n)")', NULL, linter) - expect_lint('grepl("[\\\\W]", x, perl = TRUE)', NULL, linter) - expect_lint('grepl("[\\\\W]", x)', NULL, linter) + expect_lint(R'{strsplit(x, "(;|\n)")}', NULL, linter) + expect_lint(R'{grepl("[\\W]", x, perl = TRUE)}', NULL, linter) + expect_lint(R'{grepl("[\\W]", x)}', NULL, linter) }) # make sure the logic is properly vectorized @@ -238,10 +232,10 @@ test_that("fixed replacements vectorize and recognize str_detect", { linter <- fixed_regex_linter() # properly vectorized expect_lint( - trim_some("{ + trim_some(R"({ grepl('abcdefg', x) - grepl('a[.]\\\\.b\\n', x) - }"), + grepl('a[.]\\.b\n', x) + })"), list( list(rex::rex('Use "abcdefg" with fixed = TRUE'), line_number = 2L), list(rex::rex('Use "a..b\\n" with fixed = TRUE'), line_number = 3L) @@ -289,37 +283,37 @@ robust_non_printable_unicode <- function() { # styler: off local({ .cases <- tibble::tribble( - ~.test_name, ~regex_expr, ~fixed_expr, - "[.]", "[.]", ".", - '[\\\"]', '[\\\"]', '\\"', - "[]]", "[]]", "]", - "\\\\.", "\\\\.", ".", - "\\\\:", "\\\\:", ":", - "\\\\<", "\\\\<", "<", - "\\\\$", "\\\\$", "$", - "[\\1]", "[\\1]", "\\001", - "\\1", "\\1", "\\001", - "[\\12]", "[\\12]", "\\n", - "[\\123]", "[\\123]", "S", - "a[*]b", "a[*]b", "a*b", - "abcdefg", "abcdefg", "abcdefg", - "abc\\U{A0DEF}ghi", "abc\\U{A0DEF}ghi", robust_non_printable_unicode(), - "a-z", "a-z", "a-z", - "[\\n]", "[\\n]", "\\n", - "\\n", "\n", "\\n", - "[\\u01]", "[\\u01]", "\\001", - "[\\u012]", "[\\u012]", "\\022", - "[\\u0123]", "[\\u0123]", "\u0123", - "[\\u{1}]", "[\\u{1}]", "\\001", - "[\\U1d4d7]", "[\\U1d4d7]", "\U1D4D7", - "[\\U{1D4D7}]", "[\\U{1D4D7}]", "\U1D4D7", - "[\\U8]", "[\\U8]", "\\b", - "\\u{A0}", "\\u{A0}", "\uA0", - "\\u{A0}\\U{0001d4d7}", "\\u{A0}\\U{0001d4d7}", "\uA0\U1D4D7", - "[\\uF]", "[\\uF]", "\\017", - "[\\U{F7D5}]", "[\\U{F7D5}]", "\UF7D5", - "[\\x32]", "[\\x32]", "2", - "[\\xa]", "[\\xa]", "\\n" + ~.test_name, ~regex_expr, ~fixed_expr, + "[.]", "[.]", ".", + '[\\\"]', R'([\"])', '\\"', + "[]]", "[]]", "]", + R"(\\.)", R"(\\.)", ".", + R"(\\:)", R"(\\:)", ":", + R"(\\<)", R"(\\<)", "<", + R"(\\$)", R"(\\$)", "$", + R"([\1])", R"([\1])", R"(\001)", + R"(\1)", R"(\1)", R"(\001)", + R"([\12])", R"([\12])", R"(\n)", + R"([\123])", R"([\123])", "S", + "a[*]b", "a[*]b", "a*b", + "abcdefg", "abcdefg", "abcdefg", + "abc\\U{A0DEF}ghi", "abc\\U{A0DEF}ghi", robust_non_printable_unicode(), + "a-z", "a-z", "a-z", + R"([\n])", R"([\n])", R"(\n)", + R"(\n)", "\n", R"(\n)", + R"([\u01])", R"([\u01])", R"(\001)", + R"([\u012])", R"([\u012])", R"(\022)", + R"([\u0123])", R"([\u0123])", "\u0123", + R"([\u{1}])", R"([\u{1}])", R"(\001)", + R"([\U1d4d7])", R"([\U1d4d7])", "\U1D4D7", + R"([\U{1D4D7}])", R"([\U{1D4D7}])", "\U1D4D7", + R"([\U8])", R"([\U8])", R"(\b)", + R"(\u{A0})", R"(\u{A0})", "\uA0", + R"(\u{A0}\U{0001d4d7})", R"(\u{A0}\U{0001d4d7})", "\uA0\U1D4D7", + R"([\uF])", R"([\uF])", R"(\017)", + R"([\U{F7D5}])", R"([\U{F7D5}])", "\UF7D5", + R"([\x32])", R"([\x32])", "2", + R"([\xa])", R"([\xa])", R"(\n)" ) if (.Platform$OS.type == "windows" && !hasName(R.Version(), "crt")) { skip_cases <- c( diff --git a/tests/testthat/test-get_source_expressions.R b/tests/testthat/test-get_source_expressions.R index dbacecacc..b12fb1b66 100644 --- a/tests/testthat/test-get_source_expressions.R +++ b/tests/testthat/test-get_source_expressions.R @@ -418,6 +418,9 @@ patrick::with_parameters_test_that( # otherwise we test the trivial linter (#2339) linter <- backport_linter(r_version = "3.6.0") } else { + if (linter == "cyclocomp_linter") { + skip_if_not_installed("cyclocomp") + } linter <- eval(call(linter)) } expression <- expressions[[expression_idx]] diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R index ed555223d..4ca557c72 100644 --- a/tests/testthat/test-indentation_linter.R +++ b/tests/testthat/test-indentation_linter.R @@ -867,3 +867,15 @@ test_that("function shorthand is handled", { linter ) }) + +test_that("lint metadata works for 0-space case", { + expect_lint( + trim_some(" + if (TRUE) { + FALSE + } + "), + list(ranges = list(1L:2L)), + indentation_linter() + ) +}) diff --git a/tests/testthat/test-library_call_linter.R b/tests/testthat/test-library_call_linter.R index e7d118906..998304666 100644 --- a/tests/testthat/test-library_call_linter.R +++ b/tests/testthat/test-library_call_linter.R @@ -360,10 +360,10 @@ patrick::with_parameters_test_that( "library_call_linter blocks simple disallowed usages", { linter <- library_call_linter() - message <- sprintf("Unify consecutive calls to %s\\(\\)\\.", call) + lint_msg <- sprintf("Unify consecutive calls to %s\\(\\)\\.", call) # one test of inline usage - expect_lint(sprintf("%1$s(library(x)); %1$s(library(y))", call), message, linter) + expect_lint(sprintf("%1$s(library(x)); %1$s(library(y))", call), lint_msg, linter) expect_lint( trim_some(glue::glue(" @@ -371,7 +371,7 @@ patrick::with_parameters_test_that( {call}(library(y)) ")), - message, + lint_msg, linter ) @@ -380,7 +380,7 @@ patrick::with_parameters_test_that( {call}(require(x)) {call}(require(y)) ")), - message, + lint_msg, linter ) @@ -390,7 +390,7 @@ patrick::with_parameters_test_that( # a comment on y {call}(library(y)) ")), - message, + lint_msg, linter ) }, diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 1369360bf..84ad15bc1 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -117,8 +117,8 @@ test_that("lint() results from file or text should be consistent", { linters <- list(assignment_linter(), infix_spaces_linter()) lines <- c("x<-1", "x+1") file <- withr::local_tempfile(lines = lines) - text <- paste0(lines, collapse = "\n") - file <- normalizePath(file) + text <- paste(lines, collapse = "\n") + file <- normalize_path(file) lint_from_file <- lint(file, linters = linters) lint_from_lines <- lint(linters = linters, text = lines) @@ -216,25 +216,21 @@ test_that("old compatibility usage errors", { expect_error( lint("a <- 1\n", linters = "equals_na_linter"), - regexp = rex::rex("Expected '", anything, "' to be a function of class 'linter'") + regexp = "Expected `linters()` to be a function of class ", + fixed = TRUE ) }) test_that("Linters throwing an error give a helpful error", { tmp_file <- withr::local_tempfile(lines = "a <- 1") - linter <- function() Linter(function(source_expression) stop("a broken linter", call. = FALSE)) + lintr_error_msg <- "a broken linter" + linter <- function() Linter(function(source_expression) cli_abort(lintr_error_msg)) # NB: Some systems/setups may use e.g. symlinked files when creating under tempfile(); # we don't care much about that, so just check basename() - expect_error( - lint(tmp_file, linter()), - rex::rex("Linter 'linter' failed in ", anything, basename(tmp_file), ": a broken linter") - ) - expect_error( - lint(tmp_file, list(broken_linter = linter())), - rex::rex("Linter 'broken_linter' failed in ", anything, basename(tmp_file), ": a broken linter") - ) + expect_error(lint(tmp_file, linter()), lintr_error_msg, fixed = TRUE) + expect_error(lint(tmp_file, list(broken_linter = linter())), lintr_error_msg, fixed = TRUE) }) test_that("typo in argument name gives helpful error", { - expect_error(lint("xxx", litners = identity), "Found unknown arguments in [.][.][.].*[?]lint ") + expect_error(lint("xxx", litners = identity), "Found unknown arguments in `...`: `litners`") }) diff --git a/tests/testthat/test-lint_dir.R b/tests/testthat/test-lint_dir.R index b755dea36..6da4b81bb 100644 --- a/tests/testthat/test-lint_dir.R +++ b/tests/testthat/test-lint_dir.R @@ -71,7 +71,7 @@ test_that("respects directory exclusions", { lints_norm <- lint_dir(the_dir, exclusions = "exclude-me", relative_path = FALSE) linted_files <- unique(names(lints_norm)) expect_length(linted_files, 1L) - expect_identical(linted_files, normalizePath(file.path(the_dir, "default_linter_testcode.R"))) + expect_identical(linted_files, normalize_path(file.path(the_dir, "default_linter_testcode.R"))) }) test_that("respect directory exclusions from settings", { @@ -100,7 +100,7 @@ test_that("lint_dir works with specific linters without specifying other argumen }) test_that("typo in argument name gives helpful error", { - expect_error(lint_dir(litners = identity), "Found unknown arguments in [.][.][.].*[?]lint_dir ") + expect_error(lint_dir(litners = identity), "Found unknown arguments in `...`: `litners`") }) test_that("linting empty directory passes", { diff --git a/tests/testthat/test-lint_package.R b/tests/testthat/test-lint_package.R index f0d2c0c48..b6c9b8b53 100644 --- a/tests/testthat/test-lint_package.R +++ b/tests/testthat/test-lint_package.R @@ -211,7 +211,7 @@ test_that("package using .lintr.R config lints correctly", { # config has bad R syntax expect_error( lint_package(test_path("dummy_packages", "RConfigInvalid")), - "Malformed config file, ensure it is valid R syntax", + "Malformed config file (lintr_test_config.R), ensure it is valid R syntax", fixed = TRUE ) @@ -219,7 +219,7 @@ test_that("package using .lintr.R config lints correctly", { withr::local_options(lintr.linter_file = "lintr_test_config_extraneous") expect_warning( expect_length(lint_package(r_config_pkg), 2L), - "Found unused settings in config", + "Found unused settings in config file", fixed = TRUE ) @@ -231,9 +231,6 @@ test_that("package using .lintr.R config lints correctly", { }) test_that("lintr need not be attached for .lintr.R configs to use lintr functions", { - # For some obscure reason, running in the subprocess on this specific version of R - # on Windows stopped working after PR #2446 with 'Package lintr not found'. - if (getRversion() == "3.6.3") skip_on_os("windows") exprs <- paste( 'options(lintr.linter_file = "lintr_test_config")', sprintf('lints <- lintr::lint_package("%s")', test_path("dummy_packages", "RConfig")), diff --git a/tests/testthat/test-linter_tags.R b/tests/testthat/test-linter_tags.R index 218c813ee..2d7f53810 100644 --- a/tests/testthat/test-linter_tags.R +++ b/tests/testthat/test-linter_tags.R @@ -1,23 +1,19 @@ test_that("input validation for available_linters works as expected", { - expect_error(available_linters(1L), "`packages` must be a character vector.") - expect_error(available_linters(tags = 1L), "`tags` must be a character vector.") - expect_error(available_linters(exclude_tags = 1L), "`exclude_tags` must be a character vector.") + expect_error(available_linters(1L), "`packages` must be a vector.") + expect_error(available_linters(tags = 1L), "`tags` must be a vector.") + expect_error(available_linters(exclude_tags = 1L), "`exclude_tags` must be a vector.") }) test_that("validate_linter_db works as expected", { df_empty <- data.frame() expect_warning( lintr:::validate_linter_db(df_empty, "mypkg"), - "`linters.csv` must contain the columns 'linter' and 'tags'.", + 'must contain the columns "linter" and "tags"', fixed = TRUE ) expect_false(suppressWarnings(lintr:::validate_linter_db(df_empty, "mypkg"))) - df <- data.frame( - linter = "absolute_path_linter", - tags = "robustness", - stringsAsFactors = FALSE - ) + df <- data.frame(linter = "absolute_path_linter", tags = "robustness") expect_true(lintr:::validate_linter_db(df, "mypkg")) }) @@ -160,6 +156,7 @@ test_that("lintr help files are up to date", { ) # Counts of tags from available_linters() + # NB: as.data.frame.table returns stringsAsFactors=TRUE default in R>4 db_tag_table <- as.data.frame( table(tag = unlist(lintr_db$tags)), responseName = "n_linters", diff --git a/tests/testthat/test-literal_coercion_linter.R b/tests/testthat/test-literal_coercion_linter.R index 247416a2c..aa5f752fb 100644 --- a/tests/testthat/test-literal_coercion_linter.R +++ b/tests/testthat/test-literal_coercion_linter.R @@ -1,5 +1,5 @@ test_that("literal_coercion_linter skips allowed usages", { - linter <- line_length_linter() + linter <- literal_coercion_linter() # naive xpath includes the "_f0" here as a literal expect_lint('as.numeric(x$"_f0")', NULL, linter) @@ -23,7 +23,7 @@ test_that("literal_coercion_linter skips allowed usages", { }) test_that("literal_coercion_linter skips allowed rlang usages", { - linter <- line_length_linter() + linter <- literal_coercion_linter() expect_lint("int(1, 2.0, 3)", NULL, linter) expect_lint("chr('e', 'ab', 'xyz')", NULL, linter) @@ -40,6 +40,18 @@ test_that("literal_coercion_linter skips quoted keyword arguments", { expect_lint("as.numeric(foo('a' = 1))", NULL, literal_coercion_linter()) }) +test_that("no warnings surfaced by running coercion", { + linter <- literal_coercion_linter() + + expect_no_warning( + expect_lint("as.integer('a')", "Use NA_integer_", linter) + ) + + expect_no_warning( + expect_lint("as.integer(2147483648)", "Use NA_integer_", linter) + ) +}) + skip_if_not_installed("tibble") patrick::with_parameters_test_that( "literal_coercion_linter blocks simple disallowed usages", diff --git a/tests/testthat/test-make_linter_from_xpath.R b/tests/testthat/test-make_linter_from_xpath.R index 808d9be03..fe1ccdf30 100644 --- a/tests/testthat/test-make_linter_from_xpath.R +++ b/tests/testthat/test-make_linter_from_xpath.R @@ -26,4 +26,7 @@ test_that("input validation works", { expect_error(make_linter_from_xpath(letters), err_msg, fixed = TRUE) expect_error(make_linter_from_xpath(NA_character_), err_msg, fixed = TRUE) expect_error(make_linter_from_xpath(character()), err_msg, fixed = TRUE) + + err_msg <- if (getRversion() < "4.0.0") "!missing(lint_message)" else "lint_message is required" + expect_error(make_linter_from_xpath(""), err_msg, fixed = TRUE) }) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index 9f454c1f4..172b9692d 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -56,14 +56,13 @@ test_that("as.data.frame.lints", { expect_s3_class(df, "data.frame") exp <- data.frame( - filename = rep("dummy.R", 2L), + filename = "dummy.R", line_number = c(1L, 2L), column_number = c(1L, 6L), type = c("style", "error"), message = c("", "Under no circumstances is the use of foobar allowed."), line = c("", "a <- 1"), - linter = c(NA_character_, NA_character_), # These are assigned in lint() now. - stringsAsFactors = FALSE + linter = NA_character_ # These are assigned in lint() now. ) expect_identical(df, exp) diff --git a/tests/testthat/test-normalize_exclusions.R b/tests/testthat/test-normalize_exclusions.R index 832fa8130..a3c779988 100644 --- a/tests/testthat/test-normalize_exclusions.R +++ b/tests/testthat/test-normalize_exclusions.R @@ -8,9 +8,9 @@ a <- withr::local_tempfile() b <- withr::local_tempfile() c <- withr::local_tempfile(tmpdir = ".") file.create(a, b, c) -a <- normalizePath(a) -b <- normalizePath(b) -c <- normalizePath(c) +a <- normalize_path(a) +b <- normalize_path(b) +c <- normalize_path(c) test_that("it merges two NULL or empty objects as an empty list", { expect_identical(lintr:::normalize_exclusions(c(NULL, NULL)), list()) @@ -132,7 +132,7 @@ test_that("it normalizes file paths, removing non-existing files", { t3[[c]] <- 5L:15L res <- list() res[[a]] <- list(1L:10L) - res[[normalizePath(c)]] <- list(5L:15L) + res[[c]] <- list(5L:15L) expect_identical(lintr:::normalize_exclusions(c(t1, t2, t3)), res) res <- list() @@ -143,11 +143,11 @@ test_that("it normalizes file paths, removing non-existing files", { }) test_that("it errors for invalid specifications", { - msg_full_files <- "Full file exclusions must be character vectors of length 1." + msg_full_files <- "Full file exclusions must be vectors of length 1." expect_error(lintr:::normalize_exclusions(2L), msg_full_files) expect_error(lintr:::normalize_exclusions(list("a.R", 2L)), msg_full_files) expect_error(lintr:::normalize_exclusions(list(a.R = Inf, 2L)), msg_full_files) - msg_full_lines <- "Full line exclusions must be numeric or integer vectors." + msg_full_lines <- "Full line exclusions must be or vectors." expect_error(lintr:::normalize_exclusions(list(a.R = "Inf")), msg_full_lines) }) diff --git a/tests/testthat/test-object_length_linter.R b/tests/testthat/test-object_length_linter.R index 54e701b5c..22d18d10e 100644 --- a/tests/testthat/test-object_length_linter.R +++ b/tests/testthat/test-object_length_linter.R @@ -74,3 +74,10 @@ test_that("function shorthand is caught", { object_length_linter(length = 10L) ) }) + +test_that("rlang name injection is handled", { + linter <- object_length_linter(length = 10L) + + expect_lint("tibble('{foo() |> bar() |> baz()}' := TRUE)", NULL, linter) + expect_lint("DT[, 'a_very_long_name' := FALSE]", "names should not be longer than 10 characters", linter) +}) diff --git a/tests/testthat/test-object_name_linter.R b/tests/testthat/test-object_name_linter.R index 97f0022ca..e5c5a54ec 100644 --- a/tests/testthat/test-object_name_linter.R +++ b/tests/testthat/test-object_name_linter.R @@ -278,3 +278,11 @@ test_that("capture groups in style are fine", { expect_lint("a <- 1\nab <- 2", NULL, object_name_linter(regexes = c(capture = "^(a)"))) expect_lint("ab <- 1\nabc <- 2", NULL, object_name_linter(regexes = c(capture = "^(a)(b)"))) }) + +test_that("rlang name injection is handled", { + linter <- object_name_linter() + + expect_lint('tibble("{name}" := 2)', NULL, linter) + expect_lint('x %>% mutate("{name}" := 2)', NULL, linter) + expect_lint('DT[, "{name}" := 2]', "style should match snake_case", linter) +}) diff --git a/tests/testthat/test-parse_exclusions.R b/tests/testthat/test-parse_exclusions.R index a6d0e34a6..f77ee7f7f 100644 --- a/tests/testthat/test-parse_exclusions.R +++ b/tests/testthat/test-parse_exclusions.R @@ -143,6 +143,7 @@ test_that("it ignores exclude coverage lines within start and end", { test_that("it throws an error if start and end are unpaired", { lintr:::read_settings(NULL) + error_msg_stem <- "Equal number of line starts and ends expected for exclusion from linting" t1 <- withr::local_tempfile(lines = trim_some(" this #TeSt_NoLiNt_StArT @@ -150,7 +151,7 @@ test_that("it throws an error if start and end are unpaired", { a test ")) - expect_error(lintr:::parse_exclusions(t1), "but only") + expect_error(lintr:::parse_exclusions(t1), error_msg_stem) t2 <- withr::local_tempfile(lines = trim_some(" @@ -159,5 +160,5 @@ test_that("it throws an error if start and end are unpaired", { a #TeSt_NoLiNt_EnD test ")) - expect_error(lintr:::parse_exclusions(t2), "but only") + expect_error(lintr:::parse_exclusions(t2), error_msg_stem) }) diff --git a/tests/testthat/test-paste_linter.R b/tests/testthat/test-paste_linter.R index 0126cad4d..d5db75aef 100644 --- a/tests/testthat/test-paste_linter.R +++ b/tests/testthat/test-paste_linter.R @@ -52,12 +52,6 @@ test_that("paste_linter blocks simple disallowed usages for collapse=', '", { rex::rex('toString(.) is more expressive than paste(., collapse = ", ")'), paste_linter() ) - - expect_lint( - "paste0(foo(x), collapse = ', ')", - rex::rex('toString(.) is more expressive than paste(., collapse = ", ")'), - paste_linter() - ) }) test_that("paste_linter respects non-default arguments", { @@ -65,7 +59,6 @@ test_that("paste_linter respects non-default arguments", { expect_lint("paste('a', 'b', sep = '')", NULL, paste_linter(allow_empty_sep = TRUE)) expect_lint("paste(collapse = ', ', x)", NULL, paste_linter(allow_to_string = TRUE)) - expect_lint("paste0(foo(x), collapse = ', ')", NULL, paste_linter(allow_to_string = TRUE)) }) test_that("paste_linter works for raw strings", { @@ -107,11 +100,11 @@ test_that("paste_linter skips allowed usages for strrep()", { }) test_that("paste_linter blocks simple disallowed usages", { - linter <- paste_linter() - lint_msg <- rex::rex("strrep(x, times) is better than paste") - - expect_lint("paste0(rep('*', 20L), collapse='')", lint_msg, linter) - expect_lint("paste(rep('#', width), collapse='')", lint_msg, linter) + expect_lint( + "paste(rep('#', width), collapse='')", + rex::rex("strrep(x, times) is better than paste"), + paste_linter() + ) }) test_that("paste_linter skips allowed usages for file paths", { @@ -156,9 +149,6 @@ test_that("paste_linter ignores non-path cases with paste0", { expect_lint("paste0(x)", NULL, linter) expect_lint("paste0('a')", NULL, linter) expect_lint("paste0('a', 1)", NULL, linter) - - # paste0(..., collapse=collapse) not directly mapped to file.path - expect_lint("paste0(x, collapse = '/')", NULL, linter) }) test_that("paste_linter detects paths built with '/' and paste0", { @@ -245,3 +235,55 @@ test_that("raw strings are detected in file path logic", { expect_lint("paste(x, y, sep = R'{//}')", NULL, linter) expect_lint("paste(x, y, sep = R'{/}')", lint_msg, linter) }) + +test_that("paste0(collapse=...) is caught", { + linter <- paste_linter() + lint_msg <- rex::rex("Use paste(), not paste0(), to collapse a character vector when sep= is not used.") + + expect_lint("paste(x, collapse = '')", NULL, linter) + expect_lint("paste0(a, b, collapse = '')", NULL, linter) + # pass-through can pass any number of arguments + expect_lint("paste0(..., collapse = '')", NULL, linter) + expect_lint("paste0(x, collapse = '')", lint_msg, linter) + expect_lint("paste0(x, collapse = 'xxx')", lint_msg, linter) + expect_lint("paste0(foo(x, y, z), collapse = '')", lint_msg, linter) +}) + +local({ + linter <- paste_linter() + lint_msg <- rex::rex("Use paste(), not paste0(), to collapse a character vector when sep= is not used.") + pipes <- pipes() + + patrick::with_parameters_test_that( + "paste0(collapse=...) is caught in pipes", + { + expect_lint(sprintf('x %s paste0(y, collapse = "")', pipe), NULL, linter) + expect_lint(sprintf('x %s paste0(collapse = "")', pipe), lint_msg, linter) + }, + pipe = pipes, + .test_name = pipes + ) +}) + +test_that("paste0(collapse=...) cases interacting with other rules are handled", { + linter <- paste_linter() + lint_msg <- rex::rex("Use paste(), not paste0(), to collapse a character vector when sep= is not used.") + + # multiple lints when collapse= happens to be ", " + expect_lint( + "paste0(foo(x), collapse = ', ')", + list(rex::rex('toString(.) is more expressive than paste(., collapse = ", ")'), lint_msg), + linter + ) + expect_lint("paste0(foo(x), collapse = ', ')", lint_msg, paste_linter(allow_to_string = TRUE)) + + expect_lint( + "paste0(rep('*', 20L), collapse='')", + list(rex::rex("strrep(x, times) is better than paste"), lint_msg), + linter + ) + + # paste0(..., collapse=collapse) not directly mapped to file.path + expect_lint("paste0(x, collapse = '/')", lint_msg, linter) + expect_lint("paste0(x, y, collapse = '/')", NULL, linter) +}) diff --git a/tests/testthat/test-scalar_in_linter.R b/tests/testthat/test-scalar_in_linter.R index 2bfd66f83..fb3663087 100644 --- a/tests/testthat/test-scalar_in_linter.R +++ b/tests/testthat/test-scalar_in_linter.R @@ -3,11 +3,10 @@ test_that("scalar_in_linter skips allowed usages", { expect_lint("x %in% y", NULL, linter) expect_lint("y %in% c('a', 'b')", NULL, linter) - expect_lint("c('a', 'b') %chin% x", NULL, linter) + expect_lint("c('a', 'b') %in% x", NULL, linter) expect_lint("z %in% 1:3", NULL, linter) # scalars on LHS are fine (often used as `"col" %in% names(DF)`) expect_lint("3L %in% x", NULL, linter) - # this should be is.na(x), but it more directly uses the "always TRUE/FALSE, _not_ NA" # aspect of %in%, so we delegate linting here to equals_na_linter() expect_lint("x %in% NA", NULL, linter) @@ -15,16 +14,33 @@ test_that("scalar_in_linter skips allowed usages", { }) test_that("scalar_in_linter blocks simple disallowed usages", { - linter <- scalar_in_linter() - lint_in_msg <- rex::rex("Use == to match length-1 scalars, not %in%.") - lint_chin_msg <- rex::rex("Use == to match length-1 scalars, not %chin%.") + linter <- scalar_in_linter(in_operators = c("%chin%", "%notin%")) + lint_msg <- rex::rex("Use comparison operators (e.g. ==, !=, etc.) to match length-1 scalars instead of") + + expect_lint("x %in% 1", lint_msg, linter) + expect_lint("x %chin% 'a'", lint_msg, linter) + expect_lint("x %notin% 1", lint_msg, linter) +}) - expect_lint("x %in% 1", lint_in_msg, linter) - expect_lint("x %chin% 'a'", lint_chin_msg, linter) +test_that("scalar_in_linter blocks or skips based on configuration", { + linter_default <- scalar_in_linter() + linter_config <- scalar_in_linter(in_operators = "%notin%") + + lint_msg <- rex::rex("Use comparison operators (e.g. ==, !=, etc.) to match length-1 scalars instead of") + + # default + expect_lint("x %in% 1", lint_msg, linter_default) + expect_lint("x %notin% 1", NULL, linter_default) + expect_lint("x %notin% y", NULL, linter_default) + + # configured + expect_lint("x %in% 1", lint_msg, linter_config) + expect_lint("x %notin% 1", lint_msg, linter_config) + expect_lint("x %notin% y", NULL, linter_config) }) test_that("multiple lints are generated correctly", { - linter <- scalar_in_linter() + linter <- scalar_in_linter(in_operators = "%chin%") expect_lint( trim_some('{ diff --git a/tests/testthat/test-semicolon_linter.R b/tests/testthat/test-semicolon_linter.R index 6cb5dd538..8a72da509 100644 --- a/tests/testthat/test-semicolon_linter.R +++ b/tests/testthat/test-semicolon_linter.R @@ -99,7 +99,7 @@ test_that("Trailing semicolons only", { test_that("Compound semicolons only", { expect_error( lint(text = "a <- 1;", linters = semicolon_linter(allow_trailing = TRUE, allow_compound = TRUE)), - "At least one of `allow_compound` or `allow_trailing` must be FALSE, otherwise no lints can be generated.", + "At least one of `allow_compound` or `allow_trailing` must be `FALSE`", fixed = TRUE ) }) diff --git a/tests/testthat/test-settings.R b/tests/testthat/test-settings.R index ffd166b25..1653735e2 100644 --- a/tests/testthat/test-settings.R +++ b/tests/testthat/test-settings.R @@ -81,36 +81,13 @@ test_that("it gives informative errors if the config file contains errors", { withr::local_dir(withr::local_tempdir()) writeLines("a <- 1", "aaa.R") - expect_error(lint_dir(), "Error from config setting 'linters'", fixed = TRUE) + expect_error(lint_dir(), "Error from config setting `linters`", fixed = TRUE) }) test_that("rot utility works as intended", { expect_identical(lintr:::rot(letters), c(letters[14L:26L], LETTERS[1L:13L])) }) -test_that("logical_env utility works as intended", { - test_env <- "LINTR_TEST_LOGICAL_ENV_" - withr::with_envvar( - setNames("true", test_env), - expect_true(lintr:::logical_env(test_env)) - ) - - withr::with_envvar( - setNames("F", test_env), - expect_false(lintr:::logical_env(test_env)) - ) - - withr::with_envvar( - setNames("", test_env), - expect_null(lintr:::logical_env(test_env)) - ) - - withr::with_envvar( - setNames(list(NULL), test_env), - expect_null(lintr:::logical_env(test_env)) - ) -}) - # fixing #774 test_that("linters_with_defaults doesn't break on very long input", { expect_named( @@ -140,12 +117,12 @@ test_that("it has a smart default for encodings", { pkg_file <- test_path("dummy_packages", "cp1252", "R", "cp1252.R") expect_identical( - normalizePath(find_rproj_at(find_package(proj_file, allow_rproj = TRUE)), winslash = "/"), - normalizePath(test_path("dummy_projects", "project", "project.Rproj"), winslash = "/") + normalize_path(find_rproj_at(find_package(proj_file, allow_rproj = TRUE))), + normalize_path(test_path("dummy_projects", "project", "project.Rproj")) ) expect_identical( - normalizePath(find_package(pkg_file), winslash = "/"), - normalizePath(test_path("dummy_packages", "cp1252"), winslash = "/") + normalize_path(find_package(pkg_file)), + normalize_path(test_path("dummy_packages", "cp1252")) ) expect_identical(lintr:::find_default_encoding(proj_file), "ISO8859-1") @@ -170,68 +147,67 @@ test_that("validate_config_file() detects improperly-formed settings", { writeLines(c('exclusions: list("aaa.R")', "asdf: 1"), .lintr) expect_warning(lint_dir(), "Found unused settings in config", fixed = TRUE) + encoding_error_msg <- "Setting `encoding` should be a character string" + writeLines("encoding: FALSE", .lintr) - expect_error(lint_dir(), "Setting 'encoding' should be a character string, not 'FALSE'", fixed = TRUE) + expect_error(lint_dir(), encoding_error_msg, fixed = TRUE) writeLines("encoding: NA_character_", .lintr) - expect_error(lint_dir(), "Setting 'encoding' should be a character string, not 'NA'", fixed = TRUE) + expect_error(lint_dir(), encoding_error_msg, fixed = TRUE) writeLines('encoding: c("a", "b")', .lintr) - expect_error(lint_dir(), "Setting 'encoding' should be a character string, not 'a, b'") + expect_error(lint_dir(), encoding_error_msg, fixed = TRUE) + + exclude_error_msg <- "Setting `exclude` should be a single regular expression" writeLines("exclude: FALSE", .lintr) - expect_error(lint_dir(), "Setting 'exclude' should be a single regular expression, not 'FALSE'", fixed = TRUE) + expect_error(lint_dir(), exclude_error_msg, fixed = TRUE) writeLines(c('exclusions: list("aaa.R")', "exclude: FALSE"), .lintr) - expect_error(lint_dir(), "Setting 'exclude' should be a single regular expression, not 'FALSE'", fixed = TRUE) + expect_error(lint_dir(), exclude_error_msg, fixed = TRUE) writeLines('exclude: "("', .lintr) - expect_error(lint_dir(), "Setting 'exclude' should be a single regular expression, not '('", fixed = TRUE) - - writeLines('comment_bot: "a"', .lintr) - expect_error(lint_dir(), "Setting 'comment_bot' should be TRUE or FALSE, not 'a'", fixed = TRUE) - - writeLines("comment_bot: NA", .lintr) - expect_error(lint_dir(), "Setting 'comment_bot' should be TRUE or FALSE, not 'NA'", fixed = TRUE) - - writeLines("comment_bot: c(TRUE, FALSE)", .lintr) - expect_error(lint_dir(), "Setting 'comment_bot' should be TRUE or FALSE, not 'TRUE, FALSE'", fixed = TRUE) + expect_error(lint_dir(), exclude_error_msg, fixed = TRUE) writeLines("linters: list(1)", .lintr) - expect_error(lint_dir(), "Setting 'linters' should be a list of linters", fixed = TRUE) + expect_error(lint_dir(), "Setting `linters` should be a list of linters", fixed = TRUE) writeLines("linters: list(assignment_linter(), 1)", .lintr) - expect_error(lint_dir(), "Setting 'linters' should be a list of linters", fixed = TRUE) + expect_error(lint_dir(), "Setting `linters` should be a list of linters", fixed = TRUE) + + name_exclusion_error_msg <- "Unnamed entries of setting `exclusions` should be strings" writeLines("exclusions: list(1L)", .lintr) - expect_error(lint_dir(), "Unnamed entries of setting 'exclusions' should be strings", fixed = TRUE) + expect_error(lint_dir(), name_exclusion_error_msg, fixed = TRUE) writeLines('exclusions: list("aaa.R", 1L)', .lintr) - expect_error(lint_dir(), "Unnamed entries of setting 'exclusions' should be strings", fixed = TRUE) + expect_error(lint_dir(), name_exclusion_error_msg, fixed = TRUE) writeLines("exclusions: list(letters)", .lintr) - expect_error(lint_dir(), "Unnamed entries of setting 'exclusions' should be strings", fixed = TRUE) + expect_error(lint_dir(), name_exclusion_error_msg, fixed = TRUE) writeLines("exclusions: list(NA_character_)", .lintr) - expect_error(lint_dir(), "Unnamed entries of setting 'exclusions' should be strings", fixed = TRUE) + expect_error(lint_dir(), name_exclusion_error_msg, fixed = TRUE) + + exclusion_error_msg <- "Named entries of setting `exclusions` should designate line numbers" writeLines('exclusions: list(aaa.R = "abc")', .lintr) - expect_error(lint_dir(), "Named entries of setting 'exclusions' should designate line numbers", fixed = TRUE) + expect_error(lint_dir(), exclusion_error_msg, fixed = TRUE) writeLines("exclusions: list(aaa.R = NA_integer_)", .lintr) - expect_error(lint_dir(), "Named entries of setting 'exclusions' should designate line numbers", fixed = TRUE) + expect_error(lint_dir(), exclusion_error_msg, fixed = TRUE) writeLines('exclusions: list(aaa.R = list("abc"))', .lintr) - expect_error(lint_dir(), "Named entries of setting 'exclusions' should designate line numbers", fixed = TRUE) + expect_error(lint_dir(), exclusion_error_msg, fixed = TRUE) writeLines("exclusions: list(aaa.R = list(NA_integer_))", .lintr) - expect_error(lint_dir(), "Named entries of setting 'exclusions' should designate line numbers", fixed = TRUE) + expect_error(lint_dir(), exclusion_error_msg, fixed = TRUE) writeLines('exclusions: list(aaa.R = list(assignment_linter = "abc"))', .lintr) - expect_error(lint_dir(), "Named entries of setting 'exclusions' should designate line numbers", fixed = TRUE) + expect_error(lint_dir(), exclusion_error_msg, fixed = TRUE) writeLines("exclusions: list(aaa.R = list(assignment_linter = NA_integer_))", .lintr) - expect_error(lint_dir(), "Named entries of setting 'exclusions' should designate line numbers", fixed = TRUE) + expect_error(lint_dir(), exclusion_error_msg, fixed = TRUE) }) test_that("exclusions can be a character vector", { @@ -271,7 +247,10 @@ test_that("read_config_file() bubbles up warnings helpfully, without erroring (# withr::local_dir(withr::local_tempdir()) writeLines("a <- 1", "aaa.R") - expect_warning(lint_dir(), "Warning from config setting 'linters'.*Resetting 'r_version' to 3.0.0") + expect_warning( + lint_dir(), + 'Depending on an R version older than "3.0.0" is not recommended' + ) }) test_that("perl-only regular expressions are accepted in config", { @@ -288,7 +267,7 @@ test_that("settings can be put in a sub-directory", { dir.create(".settings") .lintr <- ".settings/.lintr.R" - writeLines("linters <- list(line_length_linter(10))", .lintr) + writeLines("linters <- list(line_length_linter(10L))", .lintr) dir.create("R") writeLines("abcdefghijklmnopqrstuvwxyz=1", "R/a.R") diff --git a/tests/testthat/test-undesirable_function_linter.R b/tests/testthat/test-undesirable_function_linter.R index c12cbf21b..ae8f1af1b 100644 --- a/tests/testthat/test-undesirable_function_linter.R +++ b/tests/testthat/test-undesirable_function_linter.R @@ -55,7 +55,7 @@ test_that("Line numbers are extracted correctly", { }) test_that("invalid inputs fail correctly", { - error_msg <- "'fun' should be a non-empty named character vector" + error_msg <- "`fun` should be a non-empty named character vector" expect_error( undesirable_function_linter("***"), diff --git a/tests/testthat/test-undesirable_operator_linter.R b/tests/testthat/test-undesirable_operator_linter.R index 35aa6c20b..e5c65da16 100644 --- a/tests/testthat/test-undesirable_operator_linter.R +++ b/tests/testthat/test-undesirable_operator_linter.R @@ -51,7 +51,7 @@ test_that("undesirable_operator_linter vectorizes messages", { }) test_that("invalid inputs fail correctly", { - error_msg <- "'op' should be a non-empty named character vector" + error_msg <- "`op` should be a non-empty named character vector" expect_error( undesirable_operator_linter("***"), @@ -76,12 +76,12 @@ test_that("invalid inputs fail correctly", { expect_error( undesirable_operator_linter(c("***" = NA)), - "Did not recognize any valid operators in request for: ***", + 'Did not recognize any valid operators in request for: "***"', fixed = TRUE ) expect_error( undesirable_operator_linter(c("***" = NA, "///" = NA)), - "Did not recognize any valid operators in request for: ***, ///", + 'Did not recognize any valid operators in request for: "***" and "///"', fixed = TRUE ) }) diff --git a/tests/testthat/test-unnecessary_concatenation_linter.R b/tests/testthat/test-unnecessary_concatenation_linter.R index e7af5f46b..55abd21b0 100644 --- a/tests/testthat/test-unnecessary_concatenation_linter.R +++ b/tests/testthat/test-unnecessary_concatenation_linter.R @@ -66,16 +66,16 @@ local({ test_that("symbolic expressions are allowed, except by request", { linter <- unnecessary_concatenation_linter() linter_strict <- unnecessary_concatenation_linter(allow_single_expression = FALSE) - message <- rex::rex("Remove unnecessary c() of a constant expression.") + lint_msg <- rex::rex("Remove unnecessary c() of a constant expression.") expect_lint("c(alpha / 2)", NULL, linter) expect_lint("c(paste0('.', 1:2))", NULL, linter) expect_lint("c(DF[cond > 1, col])", NULL, linter) # allow_single_expression = FALSE turns both into lints - expect_lint("c(alpha / 2)", message, linter_strict) - expect_lint("c(paste0('.', 1:2))", message, linter_strict) - expect_lint("c(DF[cond > 1, col])", message, linter_strict) + expect_lint("c(alpha / 2)", lint_msg, linter_strict) + expect_lint("c(paste0('.', 1:2))", lint_msg, linter_strict) + expect_lint("c(DF[cond > 1, col])", lint_msg, linter_strict) }) test_that("sequences with : are linted whenever a constant is involved", { diff --git a/tests/testthat/test-use_lintr.R b/tests/testthat/test-use_lintr.R index 68e089322..f56d3b304 100644 --- a/tests/testthat/test-use_lintr.R +++ b/tests/testthat/test-use_lintr.R @@ -6,8 +6,8 @@ test_that("use_lintr works as expected", { # check that newly created file is in the root directory expect_identical( - normalizePath(lintr_file, winslash = "/"), - file.path(normalizePath(tmp, winslash = "/"), ".lintr") + normalize_path(lintr_file), + file.path(normalize_path(tmp), ".lintr") ) # can't generate if a .lintr already exists @@ -28,8 +28,8 @@ test_that("use_lintr with type = full also works", { # check that newly created file is in the root directory expect_identical( - normalizePath(lintr_file, winslash = "/"), - file.path(normalizePath(tmp, winslash = "/"), ".lintr") + normalize_path(lintr_file), + file.path(normalize_path(tmp), ".lintr") ) lints <- lint_dir(tmp) diff --git a/tests/testthat/test-with.R b/tests/testthat/test-with.R index 0e9a7f7e6..9aa49d204 100644 --- a/tests/testthat/test-with.R +++ b/tests/testthat/test-with.R @@ -1,11 +1,18 @@ test_that("modify_defaults produces error with missing or incorrect defaults", { - lint_msg <- "`defaults` must be a named list." - expect_error(modify_defaults(), lint_msg, fixed = TRUE) - expect_error(modify_defaults("assignment_linter"), lint_msg, fixed = TRUE) + expect_error( + modify_defaults(), + "`defaults` is a required argument, but is missing", + fixed = TRUE + ) + expect_error( + modify_defaults("assignment_linter"), + "`defaults` must be a named list", + fixed = TRUE + ) }) test_that("linters_with_tags produces error with incorrect tags", { - expect_error(linters_with_tags(1L:4L), "`tags` must be a character vector, or NULL.", fixed = TRUE) + expect_error(linters_with_tags(1L:4L), "`tags` must be a character vector, or `NULL`", fixed = TRUE) }) test_that("linters_with_defaults works as expected with unnamed args", { @@ -24,24 +31,19 @@ test_that("linters_with_defaults warns on unused NULLs", { test_that("linters_with_tags() verifies the output of available_linters()", { local_mocked_bindings( available_linters = function(...) { - data.frame( - linter = c("fake_linter", "very_fake_linter"), - package = "lintr", - tags = "", - stringsAsFactors = FALSE - ) + data.frame(linter = c("fake_linter", "very_fake_linter"), package = "lintr", tags = "") } ) expect_error( linters_with_tags(NULL), - "'fake_linter' and 'very_fake_linter'" + "Can't find linters `fake_linter()` and `very_fake_linter()`", + fixed = TRUE ) }) test_that("all default linters are tagged default", { expect_named(linters_with_defaults(), available_linters(tags = "default")$linter) - skip_if_not_installed("waldo", "0.4.0") # needs waldo#133 # covr modifies package functions causing differing deparse() results even for identical anonymous functions. # This happens because default_linters is generated at build time and thus not modifiable by covr, whereas # linters_with_tags() constructs the linters at runtime. @@ -94,7 +96,7 @@ test_that("linters_with_defaults(default = .) is supported with a deprecation wa { linters <- linters_with_defaults(default = list(), whitespace_linter()) }, - "'default'" + "`default` is not an argument" ) expect_named(linters, "whitespace_linter") diff --git a/tests/testthat/test-xml_nodes_to_lints.R b/tests/testthat/test-xml_nodes_to_lints.R index c5e4d9fdd..b5ef060ac 100644 --- a/tests/testthat/test-xml_nodes_to_lints.R +++ b/tests/testthat/test-xml_nodes_to_lints.R @@ -111,7 +111,8 @@ test_that("it doesn't produce invalid lints", { range_end_xpath = xp_range_end ) }, - rex::rex("Could not find range start for lint. Defaulting to start of line.") + "Defaulting to start of line", + fixed = TRUE ) expect_identical(lints1[["column_number"]], nchar("before") + 1L) @@ -128,7 +129,8 @@ test_that("it doesn't produce invalid lints", { range_end_xpath = xp_invalid ) }, - rex::rex("Could not find range end for lint. Defaulting to width 1.") + "Defaulting to width 1", + fixed = TRUE ) expect_identical(lints2[["column_number"]], nchar("before") + 1L) @@ -145,7 +147,8 @@ test_that("it doesn't produce invalid lints", { range_end_xpath = xp_range_end ) }, - rex::rex("Could not find location for lint. Defaulting to start of range.") + "Defaulting to start of range", + fixed = TRUE ) expect_identical(lints3[["column_number"]], 1L) @@ -153,5 +156,5 @@ test_that("it doesn't produce invalid lints", { }) test_that("erroneous input errors", { - expect_error(xml_nodes_to_lints(1L), "Expected an xml_nodeset", fixed = TRUE) + expect_error(xml_nodes_to_lints(1L), "Expected an ", fixed = TRUE) }) diff --git a/tests/testthat/test-xp_utils.R b/tests/testthat/test-xp_utils.R index d00a417d1..2e7fcbeaa 100644 --- a/tests/testthat/test-xp_utils.R +++ b/tests/testthat/test-xp_utils.R @@ -12,7 +12,7 @@ test_that("xp_call_name works", { }) test_that("xp_call_name input validation works", { - expect_error(xp_call_name(2L), "Expected an xml_nodeset", fixed = TRUE) + expect_error(xp_call_name(2L), "`expr` must be an ", fixed = TRUE) xml <- xml2::read_xml("") expect_error(xp_call_name(xml, depth = -1L), "depth >= 0", fixed = TRUE) diff --git a/vignettes/creating_linters.Rmd b/vignettes/creating_linters.Rmd index d4025848e..b38dd7a5d 100644 --- a/vignettes/creating_linters.Rmd +++ b/vignettes/creating_linters.Rmd @@ -1,7 +1,5 @@ --- title: "Creating new linters" -author: "lintr maintainers" -date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Creating new linters} @@ -217,7 +215,7 @@ The main three aspects to test are: 1. Linter returns no lints when there is nothing to lint, e.g. ```r -expect_lint("blah", NULL, assignment_linter()) +expect_no_lint("blah", assignment_linter()) ``` 2. Linter returns a lint when there is something to lint, e.g. diff --git a/vignettes/lintr.Rmd b/vignettes/lintr.Rmd index e6c4a1da0..275b864e1 100644 --- a/vignettes/lintr.Rmd +++ b/vignettes/lintr.Rmd @@ -1,6 +1,5 @@ --- title: "Using lintr" -author: "Alexander Rosenstock" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Using lintr} @@ -140,10 +139,7 @@ make_string <- function(x) { } } -defaults_table <- data.frame( - default = vapply(default_settings, make_string, character(1L)), - stringsAsFactors = FALSE -) +defaults_table <- data.frame(default = vapply(default_settings, make_string, character(1L))) # avoid conflict when loading lintr in echo=TRUE cell below rm(default_settings) @@ -196,8 +192,7 @@ make_setting_string <- function(linter_name) { defaults_table <- data.frame( row.names = names(default_linters), - settings = vapply(names(default_linters), make_setting_string, character(1L)), - stringsAsFactors = FALSE + settings = vapply(names(default_linters), make_setting_string, character(1L)) ) knitr::kable(defaults_table)