Merge branch 'main' into alist-missing

NEWS.md

@@ -4,6 +4,9 @@
 
 * `fixed_regex_linter()` no longer fails with regular expression pattern `"\\;"` (#1545, @IndrajeetPatil).
 
+* `get_source_expressions()` can handle Sweave/Rmarkdown documents with reference chunks like `<<ref_file>>` (#779, @MichaelChirico).
+  Note that these are simply skipped, rather than attempting to retrieve the reference and also lint it.
+
 ## Changes to defaults
 
 * Set the default for the `except` argument in `duplicate_argument_linter()` to `c("mutate", "transmute")`.
@@ -67,6 +70,8 @@
 
   Thanks to Yihui and other developers for their helpful discussions around this issue (#797, @IndrajeetPatil).
 
+* The output of `lint()` and `Lint()` gain S3 class `"list"` to assist with S3 dispatch (#1494, @MichaelChirico)
+
 # lintr 3.0.1
 
 * Skip multi-byte tests in non UTF-8 locales (#1504)

R/extract.R

@@ -20,13 +20,17 @@ extract_r_source <- function(filename, lines, error = identity) {
     return(output)
   }
 
+  output_env <- environment() # nolint: object_usage_linter. False positive-ish -- used below.
   Map(
     function(start, end) {
-      output[seq(start + 1L, end - 1L)] <<- lines[seq(start + 1L, end - 1L)]
+      line_seq <- seq(start + 1L, end - 1L)
+      output_env$output[line_seq] <- lines[line_seq]
     },
     chunks[["starts"]],
     chunks[["ends"]]
   )
+  # drop <<chunk>> references, too
+  is.na(output) <- grep(pattern$ref.chunk, output)
   replace_prefix(output, pattern$chunk.code)
 }
 

R/lint.R

@@ -25,7 +25,7 @@
 #'
 #' @aliases lint_file
 # TODO(next release after 3.0.0): remove the alias
-#' @return A list of lint objects.
+#' @return An object of class `c("lints", "list")`, each element of which is a `"list"` object.
 #'
 #' @examples
 #' \dontrun{
@@ -97,7 +97,8 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings =
   }
 
   lints <- maybe_append_error_lint(lints, source_expressions$error, lint_cache, filename)
-  lints <- structure(reorder_lints(flatten_lints(lints)), class = "lints")
+  lints <- reorder_lints(flatten_lints(lints))
+  class(lints) <- c("lints", "list")
 
   cache_file(lint_cache, filename, linters, lints)
   save_cache(lint_cache, filename, cache_path)
@@ -439,7 +440,7 @@ pkg_name <- function(path = find_package()) {
 #' @param line code source where the lint occurred
 #' @param ranges a list of ranges on the line that should be emphasized.
 #' @param linter deprecated. No longer used.
-#' @return an object of class 'lint'.
+#' @return an object of class `c("lint", "list")`.
 #' @name lint-s3
 #' @export
 Lint <- function(filename, line_number = 1L, column_number = 1L, # nolint: object_name.
@@ -455,18 +456,18 @@ Lint <- function(filename, line_number = 1L, column_number = 1L, # nolint: objec
 
   type <- match.arg(type)
 
-  structure(
-    list(
-      filename = filename,
-      line_number = as.integer(line_number),
-      column_number = as.integer(column_number),
-      type = type,
-      message = message,
-      line = line,
-      ranges = ranges,
-      linter = NA_character_
-    ),
-    class = "lint")
+  obj <- list(
+    filename = filename,
+    line_number = as.integer(line_number),
+    column_number = as.integer(column_number),
+    type = type,
+    message = message,
+    line = line,
+    ranges = ranges,
+    linter = NA_character_
+  )
+  class(obj) <- c("lint", "list")
+  obj
 }
 
 rstudio_source_markers <- function(lints) {

R/utils.R

@@ -224,6 +224,22 @@ platform_independent_sort <- function(x) x[platform_independent_order(x)]
 #'   extract its string value with [xml2::xml_text()]. If `s` is an `xml_node` or `xml_nodeset`
 #'   and `xpath` is specified, it is extracted with [xml2::xml_find_chr()].
 #' @param xpath An XPath, passed on to [xml2::xml_find_chr()] after wrapping with `string()`.
+#'
+#' @examples
+#' tmp <- withr::local_tempfile(lines = "c('a', 'b')")
+#' 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"
+#'
+#' # more importantly, extract strings under R>=4 raw strings
+#' @examplesIf getRversion() >= "4.0.0"
+#' tmp4.0 <- withr::local_tempfile(lines = "c(R'(a\\b)', R'--[a\\\"\'\"\\b]--')")
+#' 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"
+#'
 #' @export
 get_r_string <- function(s, xpath = NULL) {
   if (inherits(s, c("xml_node", "xml_nodeset"))) {

tests/testthat/test-get_source_expressions.R

@@ -309,6 +309,13 @@ test_that("Syntax errors in Rmd or qmd don't choke lintr", {
   expect_silent(get_source_expressions(tmp))
 })
 
+test_that("Reference chunks in Sweave/Rmd are ignored", {
+  example_rnw <- system.file("Sweave", "example-1.Rnw", package = "utils")
+  # ensure such a chunk continues to exist upstream
+  expect_true(any(grepl("^\\s*<<[^>]*>>\\s*$", readLines(example_rnw))))
+  expect_silent(lint(example_rnw))
+})
+
 skip_if_not_installed("patrick")
 # NB: this is just a cursory test for linters not to
 #   fail on files where the XML content is xml_missing;

tests/testthat/test-lint_file.R

@@ -1,12 +1,12 @@
 # The lints for a given file should be the same regardless of the working
 # directory
 
-# Helper function: run assignment_linter on a given file
-lint_assignments <- function(filename) {
-  lint(filename, linters = list(assignment_linter()))
-}
-
 test_that("lint() results do not depend on the working directory", {
+  # Helper function: run assignment_linter on a given file
+  lint_assignments <- function(filename) {
+    lint(filename, linters = list(assignment_linter()))
+  }
+
   # a dummy package for use in the test
   pkg_path <- test_path("dummy_packages", "assignmentLinter")
 
@@ -63,7 +63,7 @@ test_that("lint() results do not depend on the position of the .lintr", {
   lint_with_config <- function(config_path, config_string, filename) {
     cat(config_string, file = config_path)
     on.exit(unlink(config_path))
-    lint_assignments(filename)
+    lint(filename, linters = assignment_linter())
   }
 
   # a dummy package for use in the test

tests/testthat/test-methods.R

@@ -31,6 +31,7 @@ test_that("as.data.frame.lints", {
     ),
     "lint"
   )
+  expect_type(l1, "list")
 
   # A larger lint
   expect_s3_class(
@@ -147,3 +148,9 @@ test_that("split.lint works as intended", {
   l <- lint(tmp, seq_linter())
   expect_true(all(vapply(split(l), inherits, logical(1L), "lints")))
 })
+
+test_that("within.list is dispatched", {
+  l <- lint(text = "a=1\nb=2", linters = infix_spaces_linter())
+  expect_silent(l <- lapply(l, within, line_number <- line_number + 1L))
+  expect_identical(vapply(l, `[[`, integer(1L), "line_number"), 2L:3L)
+})