diff --git a/.lintr b/.lintr index 0d4e1af9f..dd04ff1d4 100644 --- a/.lintr +++ b/.lintr @@ -17,7 +17,8 @@ linters: all_linters( options = NULL, message = "use cli::cli_inform()", warning = "use cli::cli_warn()", - stop = "use cli::cli_abort()" + stop = "use cli::cli_abort()", + normalizePath = "use normalize_path()" )), undesirable_operator_linter(modify_defaults( defaults = default_undesirable_operators, diff --git a/NEWS.md b/NEWS.md index f09fbe60e..140ee54ea 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,7 @@ * 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 diff --git a/R/exclude.R b/R/exclude.R index f3bbc5405..25a924cea 100644 --- a/R/exclude.R +++ b/R/exclude.R @@ -326,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/lint.R b/R/lint.R index 61dc95254..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)) { @@ -163,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, @@ -198,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) { @@ -249,7 +250,7 @@ lint_package <- function(path = ".", ..., if (is.null(pkg_path)) { cli_warn(c( - i = "Didn't find any R package searching upwards from {.file {normalizePath(path)}}" + i = "Didn't find any R package searching upwards from {.file {normalize_path(path)}}" )) return(NULL) } @@ -274,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) { diff --git a/R/path_utils.R b/R/path_utils.R index dd53d4316..f8ac2ac6f 100644 --- a/R/path_utils.R +++ b/R/path_utils.R @@ -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) 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/use_lintr.R b/R/use_lintr.R index 16b33f279..73dc72e38 100644 --- a/R/use_lintr.R +++ b/R/use_lintr.R @@ -25,7 +25,7 @@ #' 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)) { cli_abort("Found an existing configuration file at {.file {config_file}}.") } diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 62a0ed32c..a0024708b 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -437,7 +437,7 @@ test_that("cache = TRUE workflow works", { # Need a test structure with a safe to load .lintr withr::local_dir(file.path("dummy_packages", "package")) withr::local_options(lintr.linter_file = "lintr_test_config") - files <- normalizePath(list.files(recursive = TRUE, full.names = TRUE)) + files <- normalize_path(list.files(recursive = TRUE, full.names = TRUE)) # Manually clear cache (that function is exported) for (f in files) { diff --git a/tests/testthat/test-lint.R b/tests/testthat/test-lint.R index 6655f54dc..84ad15bc1 100644 --- a/tests/testthat/test-lint.R +++ b/tests/testthat/test-lint.R @@ -118,7 +118,7 @@ test_that("lint() results from file or text should be consistent", { lines <- c("x<-1", "x+1") file <- withr::local_tempfile(lines = lines) text <- paste(lines, collapse = "\n") - file <- normalizePath(file) + file <- normalize_path(file) lint_from_file <- lint(file, linters = linters) lint_from_lines <- lint(linters = linters, text = lines) diff --git a/tests/testthat/test-lint_dir.R b/tests/testthat/test-lint_dir.R index 24345ecd2..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", { diff --git a/tests/testthat/test-normalize_exclusions.R b/tests/testthat/test-normalize_exclusions.R index f2b505e8b..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() diff --git a/tests/testthat/test-settings.R b/tests/testthat/test-settings.R index 2c48c1629..1653735e2 100644 --- a/tests/testthat/test-settings.R +++ b/tests/testthat/test-settings.R @@ -117,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") 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)