Merge branch 'main' into unsorted

Author: MichaelChirico

NAMESPACE

@@ -155,6 +155,7 @@ importFrom(rex,rex)
 importFrom(stats,na.omit)
 importFrom(utils,capture.output)
 importFrom(utils,getParseData)
+importFrom(utils,globalVariables)
 importFrom(utils,head)
 importFrom(utils,relist)
 importFrom(utils,tail)

NEWS.md

@@ -24,6 +24,7 @@
 * `sprintf_linter()` is pipe-aware, so that `x %>% sprintf(fmt = "%s")` no longer lints (#1943, @MichaelChirico).
 * `line_length_linter()` helpfully includes the line length in the lint message (#2057, @MichaelChirico).
 * `sort_linter()` checks for code like `x == sort(x)` which is better served by using the function `is.unsorted()` (part of #884, @MichaelChirico).
+* `paste_linter()` gains detection for file paths that are better constructed with `file.path()`, e.g. `paste0(dir, "/", file)` would be better as `file.path(dir, file)` (part of #884, @MichaelChirico).
 
 ### New linters
 

R/aaa.R

@@ -21,7 +21,7 @@ NULL
 # need to register rex shortcuts as globals to avoid CRAN check errors
 rex::register_shortcuts("lintr")
 
-utils::globalVariables(
+globalVariables(
   c(
     "line1", "col1", "line2", "col2", # columns of parsed_content
     "id", "parent", "token", "terminal", "text" # ditto

R/comment_linters.R

@@ -84,8 +84,8 @@ commented_code_linter <- function() {
     code_candidates <- re_matches(all_comments, code_candidate_regex, global = FALSE, locations = TRUE)
     extracted_code <- code_candidates[, "code"]
     # ignore trailing ',' when testing for parsability
-    extracted_code <- rex::re_substitutes(extracted_code, rex::rex(",", any_spaces, end), "")
-    extracted_code <- rex::re_substitutes(extracted_code, rex::rex(start, any_spaces, ","), "")
+    extracted_code <- re_substitutes(extracted_code, rex(",", any_spaces, end), "")
+    extracted_code <- re_substitutes(extracted_code, rex(start, any_spaces, ","), "")
     is_parsable <- which(vapply(extracted_code, parsable, logical(1L)))
 
     lint_list <- xml_nodes_to_lints(

R/exclude.R

@@ -110,8 +110,8 @@ parse_exclusions <- function(file, exclude = settings$exclude,
     return(list())
   }
 
-  start_locations <- rex::re_matches(lines, exclude_start, locations = TRUE)[, "end"] + 1L
-  end_locations <- rex::re_matches(lines, exclude_end, locations = TRUE)[, "start"]
+  start_locations <- re_matches(lines, exclude_start, locations = TRUE)[, "end"] + 1L
+  end_locations <- re_matches(lines, exclude_end, locations = TRUE)[, "start"]
   starts <- which(!is.na(start_locations))
   ends <- which(!is.na(end_locations))
 
@@ -125,20 +125,20 @@ parse_exclusions <- function(file, exclude = settings$exclude,
     for (i in seq_along(starts)) {
       excluded_lines <- seq(starts[i], ends[i])
       linters_string <- substring(lines[starts[i]], start_locations[starts[i]])
-      linters_string <- rex::re_matches(linters_string, exclude_linter)[, 1L]
+      linters_string <- re_matches(linters_string, exclude_linter)[, 1L]
 
       exclusions <- add_exclusions(exclusions, excluded_lines, linters_string, exclude_linter_sep, linter_names)
     }
   }
 
-  nolint_locations <- rex::re_matches(lines, exclude, locations = TRUE)[, "end"] + 1L
+  nolint_locations <- re_matches(lines, exclude, locations = TRUE)[, "end"] + 1L
   nolints <- which(!is.na(nolint_locations))
   # Disregard nolint tags if they also match nolint start / end
   nolints <- setdiff(nolints, c(starts, ends))
 
   for (i in seq_along(nolints)) {
     linters_string <- substring(lines[nolints[i]], nolint_locations[nolints[i]])
-    linters_string <- rex::re_matches(linters_string, exclude_linter)[, 1L]
+    linters_string <- re_matches(linters_string, exclude_linter)[, 1L]
     exclusions <- add_exclusions(exclusions, nolints[i], linters_string, exclude_linter_sep, linter_names)
   }
 

R/extract.R

@@ -137,16 +137,16 @@ defines_knitr_engine <- function(start_lines) {
   engines <- names(knitr::knit_engines$get())
 
   # {some_engine}, {some_engine label, ...} or {some_engine, ...}
-  bare_engine_pattern <- rex::rex(
+  bare_engine_pattern <- rex(
     "{", or(engines), one_of("}", " ", ",")
   )
   # {... engine = "some_engine" ...}
-  explicit_engine_pattern <- rex::rex(
+  explicit_engine_pattern <- rex(
     boundary, "engine", any_spaces, "="
   )
 
-  rex::re_matches(start_lines, explicit_engine_pattern) |
-    rex::re_matches(start_lines, bare_engine_pattern)
+  re_matches(start_lines, explicit_engine_pattern) |
+    re_matches(start_lines, bare_engine_pattern)
 }
 
 replace_prefix <- function(lines, prefix_pattern) {

R/get_source_expressions.R

@@ -185,7 +185,7 @@ fixup_line <- function(line) {
 #'
 #' @noRd
 lint_parse_error_r43 <- function(e, source_expression) {
-  msg <- rex::re_substitutes(e$message, rex::rex(" (", except_some_of(")"), ")", end), "")
+  msg <- re_substitutes(e$message, rex(" (", except_some_of(")"), ")", end), "")
   line_number <- e$lineno
   column <- e$colno
   substr(msg, 1L, 1L) <- toupper(substr(msg, 1L, 1L))
@@ -621,7 +621,7 @@ fix_eq_assigns <- function(pc) {
 
   eq_assign_locs <- which(pc$token == "EQ_ASSIGN")
   # check whether the equal-assignment is the final entry
-  if (length(eq_assign_locs) == 0L || utils::tail(eq_assign_locs, 1L) == nrow(pc)) {
+  if (length(eq_assign_locs) == 0L || tail(eq_assign_locs, 1L) == nrow(pc)) {
     return(pc)
   }
 

R/indentation_linter.R

@@ -189,9 +189,9 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
           ({xp_or(paste0('descendant::', paren_tokens_left, '[', xp_last_on_line, ']'))})
         ]/@line1
       )]"),
-      glue::glue("({ global_nodes(infix_tokens) })[{xp_last_on_line}{infix_condition}]"),
-      glue::glue("({ global_nodes(no_paren_keywords) })[{xp_last_on_line}]"),
-      glue::glue("
+      glue("({ global_nodes(infix_tokens) })[{xp_last_on_line}{infix_condition}]"),
+      glue("({ global_nodes(no_paren_keywords) })[{xp_last_on_line}]"),
+      glue("
         ({ global_nodes(keyword_tokens) })
           /following-sibling::OP-RIGHT-PAREN[
             {xp_last_on_line} and
@@ -223,9 +223,9 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
     #     + if there is no token following ( on the same line, a block indent is required until )
     #  - binary operators where the second arguments starts on a new line
 
-    indent_levels <- rex::re_matches(
+    indent_levels <- re_matches(
       source_expression$file_lines,
-      rex::rex(start, any_spaces), locations = TRUE
+      rex(start, any_spaces), locations = TRUE
     )[, "end"]
     expected_indent_levels <- integer(length(indent_levels))
     is_hanging <- logical(length(indent_levels))

R/lint.R

@@ -39,7 +39,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings =
     stop("'cache' is no longer available as a positional argument; please supply 'cache' as a named argument instead.")
   }
 
-  needs_tempfile <- missing(filename) || rex::re_matches(filename, rex::rex(newline))
+  needs_tempfile <- missing(filename) || re_matches(filename, rex(newline))
   inline_data <- !is.null(text) || needs_tempfile
   lines <- get_lines(filename, text)
 
@@ -125,7 +125,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings =
 lint_dir <- function(path = ".", ...,
                      relative_path = TRUE,
                      exclusions = list("renv", "packrat"),
-                     pattern = rex::rex(".", one_of("Rr"), or("", "html", "md", "nw", "rst", "tex", "txt"), end),
+                     pattern = rex(".", one_of("Rr"), or("", "html", "md", "nw", "rst", "tex", "txt"), end),
                      parse_settings = TRUE) {
   if (has_positional_logical(list(...))) {
     stop(
@@ -738,7 +738,7 @@ maybe_append_error_lint <- function(lints, error, lint_cache, filename) {
 get_lines <- function(filename, text) {
   if (!is.null(text)) {
     strsplit(paste(text, collapse = "\n"), "\n", fixed = TRUE)[[1L]]
-  } else if (rex::re_matches(filename, rex::rex(newline))) {
+  } else if (re_matches(filename, rex(newline))) {
     strsplit(gsub("\n$", "", filename), "\n", fixed = TRUE)[[1L]]
   } else {
     read_lines(filename)

R/lintr-package.R

@@ -8,13 +8,12 @@
 "_PACKAGE"
 
 ## lintr namespace: start
+#' @importFrom cyclocomp cyclocomp
 #' @importFrom glue glue glue_collapse
 #' @importFrom rex rex regex re_matches re_substitutes character_class
 #' @importFrom stats na.omit
-#' @importFrom utils capture.output head getParseData relist
+#' @importFrom utils capture.output getParseData globalVariables head relist tail
 #' @importFrom xml2 xml_attr xml_find_all xml_find_chr xml_find_num xml_find_first xml_name xml_text as_list
-#' @importFrom cyclocomp cyclocomp
-#' @importFrom utils tail
 #' @rawNamespace
 #' if (getRversion() >= "4.0.0") {
 #'   importFrom(tools, R_user_dir)

R/methods.R

@@ -45,8 +45,7 @@ markdown <- function(x, info, ...) {
     as.character(x$line_number), ":",
     as.character(x$column_number), ":", "]",
     "(",
-    paste(
-      sep = "/",
+    file.path(
       "https://github.com",
       info$user,
       info$repo,
@@ -122,7 +121,7 @@ trim_output <- function(x, max = 65535L) {
   # otherwise trim x to the max, then search for the lint starts
   x <- substr(x, 1L, max)
 
-  re <- rex::rex(
+  re <- rex(
     "[", except_some_of(":"), ":", numbers, ":", numbers, ":", "]",
     "(", except_some_of(")"), ")",
     space,
@@ -134,7 +133,7 @@ trim_output <- function(x, max = 65535L) {
     except_some_of("\r\n"), newline
   )
 
-  lint_starts <- rex::re_matches(x, re, global = TRUE, locations = TRUE)[[1L]]
+  lint_starts <- re_matches(x, re, global = TRUE, locations = TRUE)[[1L]]
 
   # if at least one lint ends before the cutoff, cutoff there, else just use
   # the cutoff

R/object_usage_linter.R

@@ -59,7 +59,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) {
 
     pkg_name <- pkg_name(find_package(dirname(source_expression$filename)))
 
-    declared_globals <- try_silently(utils::globalVariables(package = pkg_name %||% globalenv()))
+    declared_globals <- try_silently(globalVariables(package = pkg_name %||% globalenv()))
 
     xml <- source_expression$full_xml_parsed_content
 
@@ -93,7 +93,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) {
 
       # TODO handle assignment functions properly
       # e.g. `not_existing<-`(a, b)
-      res$name <- rex::re_substitutes(res$name, rex::rex("<-"), "")
+      res$name <- re_substitutes(res$name, rex("<-"), "")
 
       lintable_symbols <- xml_find_all(fun_assignment, xpath_culprit_symbol)
 

R/paste_linter.R

@@ -21,6 +21,8 @@
 #'   `paste()` with `sep = ""` is not linted.
 #' @param allow_to_string Logical, default `FALSE`. If `TRUE`, usage of
 #'   `paste()` and `paste0()` with `collapse = ", "` is not linted.
+#' @param allow_file_path Logical, default `FALSE`. If `TRUE`, usage of
+#'   `paste()` and `paste0()` to construct file paths is not linted.
 #'
 #' @examples
 #' # will produce lints
@@ -44,6 +46,11 @@
 #'   linters = paste_linter()
 #' )
 #'
+#' lint(
+#'   text = 'paste0(dir, "/", file)',
+#'   linters = paste_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = 'paste0("a", "b")',
@@ -75,9 +82,14 @@
 #'   linters = paste_linter()
 #' )
 #'
+#' lint(
+#'   text = 'paste0(year, "/", month, "/", day)',
+#'   linters = paste_linter(allow_file_path = TRUE)
+#' )
+#'
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) {
+paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE, allow_file_path = FALSE) {
   sep_xpath <- "
   //SYMBOL_FUNCTION_CALL[text() = 'paste']
     /parent::expr
@@ -111,6 +123,70 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) {
     /parent::expr
   "
 
+  slash_str <- sprintf("STR_CONST[%s]", xp_text_in_table(c("'/'", '"/"')))
+  str_not_start_with_slash <-
+    "STR_CONST[not(substring(text(), 2, 1) = '/')]"
+  str_not_end_with_slash <-
+    "STR_CONST[not(substring(text(), string-length(text()) - 1, 1) = '/')]"
+  non_str <- "SYMBOL or expr"
+
+  # Type I: paste(..., sep = "/")
+  paste_file_path_xpath <- glue("
+  //SYMBOL_FUNCTION_CALL[text() = 'paste']
+    /parent::expr
+    /parent::expr[
+      SYMBOL_SUB[text() = 'sep']/following-sibling::expr[1][{slash_str}]
+      and not(SYMBOL_SUB[text() = 'collapse'])
+    ]
+  ")
+
+  # Type II: paste0(x, "/", y, "/", z)
+  paste0_file_path_xpath <- xp_strip_comments(glue("
+  //SYMBOL_FUNCTION_CALL[text() = 'paste0']
+    /parent::expr
+    /parent::expr[
+      (: exclude paste0(x) :)
+      count(expr) > 2
+      (: An expression matching _any_ of these conditions is _not_ a file path :)
+      and not(
+        (: Any numeric input :)
+        expr/NUM_CONST
+        (: A call using collapse= :)
+        or SYMBOL_SUB[text() = 'collapse']
+        (: First input is '/', meaning file.path() would need to start with '' :)
+        or expr[2][{slash_str}]
+        (: Last input is '/', meaning file.path() would need to end with '' :)
+        or expr[last()][{slash_str}]
+        (: String starting or ending with multiple / :)
+        (: TODO(#2075): run this logic on the actual R string :)
+        or expr/STR_CONST[
+          (: NB: this is (text, initial_index, n_characters) :)
+          substring(text(), 2, 2) = '//'
+          or substring(text(), string-length(text()) - 2, 2) = '//'
+        ]
+        (: Consecutive non-strings like paste0(x, y) :)
+        or expr[({non_str}) and following-sibling::expr[1][{non_str}]]
+        (: A string not ending with /, followed by non-string or string not starting with / :)
+        or expr[
+          {str_not_end_with_slash}
+          and following-sibling::expr[1][
+            {non_str}
+            or {str_not_start_with_slash}
+          ]
+        ]
+        (: A string not starting with /, preceded by a non-string       :)
+        (: NB: consecutive strings is covered by the previous condition :)
+        or expr[
+          {str_not_start_with_slash}
+          and preceding-sibling::expr[1][{non_str}]
+        ]
+      )
+    ]
+  "))
+
+  empty_paste_note <-
+    'Note that paste() converts empty inputs to "", whereas file.path() leaves it empty.'
+
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {
       return(list())
@@ -170,6 +246,32 @@ paste_linter <- function(allow_empty_sep = FALSE, allow_to_string = FALSE) {
       type = "warning"
     )
 
+    if (!allow_file_path) {
+      paste_file_path_expr <- xml_find_all(xml, paste_file_path_xpath)
+      optional_lints <- c(optional_lints, xml_nodes_to_lints(
+        paste_file_path_expr,
+        source_expression = source_expression,
+        lint_message = paste(
+          'Construct file paths with file.path(...) instead of paste(..., sep = "/").',
+          'If you are using paste(sep = "/") to construct a date,',
+          "consider using format() or lubridate helpers instead.",
+          empty_paste_note
+        ),
+        type = "warning"
+      ))
+
+      paste0_file_path_expr <- xml_find_all(xml, paste0_file_path_xpath)
+      optional_lints <- c(optional_lints, xml_nodes_to_lints(
+        paste0_file_path_expr,
+        source_expression = source_expression,
+        lint_message = paste(
+          'Construct file paths with file.path(...) instead of paste0(x, "/", y, "/", z).',
+          empty_paste_note
+        ),
+        type = "warning"
+      ))
+    }
+
     c(optional_lints, paste0_sep_lints, paste_strrep_lints)
   })
 }