safer Lint(), xml_nodes_to_lints() and lint()

R/get_source_expressions.R

@@ -83,7 +83,7 @@ get_source_expressions <- function(filename, lines = NULL) {
   source_expression$content <- get_content(source_expression$lines)
   parsed_content <- get_source_expression(source_expression, error = function(e) lint_parse_error(e, source_expression))
 
-  if (inherits(e, "lint") && (is.na(e$line) || !nzchar(e$line))) {
+  if (inherits(e, "lint") && (is.na(e$line) || !nzchar(e$line) || e$message == "unexpected end of input")) {
     # Don't create expression list if it's unreliable (invalid encoding or unhandled parse error)
     expressions <- list()
   } else {

R/indentation_linter.R

@@ -181,7 +181,7 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
       }
       change_begin <- as.integer(xml2::xml_attr(change, "line1")) + 1L
       change_end <- xml2::xml_find_num(change, xp_block_ends)
-      if (change_begin <= change_end) {
+      if (isTRUE(change_begin <= change_end)) {
         to_indent <- seq(from = change_begin, to = change_end)
         if (change_starts_hanging) {
           expected_indent_levels[to_indent] <- as.integer(xml2::xml_attr(change, "col2"))

R/lint.R

@@ -402,6 +402,10 @@ Lint <- function(filename, line_number = 1L, column_number = 1L, # nolint: objec
     )
   }
 
+  if (!is.null(ranges) && any(vapply(ranges, anyNA, logical(1L)))) {
+    stop("`ranges` must not contain NAs.")
+  }
+
   type <- match.arg(type)
 
   obj <- list(

R/xml_nodes_to_lints.R

@@ -61,17 +61,29 @@ xml_nodes_to_lints <- function(xml, source_expression, lint_message,
   type <- match.arg(type, c("style", "warning", "error"))
   line1 <- xml2::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.")
+    col1 <- 1L
+  }
 
   lines <- source_expression[["lines"]]
   if (is.null(lines)) lines <- source_expression[["file_lines"]]
 
   if (xml2::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.")
+      col2 <- col1
+    }
   } else {
     col2 <- nchar(lines[[line1]])
   }
 
   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.")
+    column_number <- col1
+  }
 
   Lint(
     filename = source_expression$filename,

tests/testthat/test-indentation_linter.R

@@ -493,3 +493,8 @@ test_that("consecutive same-level lints are suppressed", {
     indentation_linter()
   )
 })
+
+test_that("it doesn't error on invalid code", {
+  # Part of #1427
+  expect_lint("function() {)", list(linter = "error", message = rex::rex("unexpected ')'")), indentation_linter())
+})

tests/testthat/test-lint.R

@@ -0,0 +1,3 @@
+test_that("Lint() errors on invalid input", {
+  expect_error(Lint("dummy.R", ranges = list(c(1L, NA_integer_))), rex::rex("`ranges` must not contain NAs."))
+})

tests/testthat/test-spaces_left_parentheses_linter.R

@@ -73,3 +73,15 @@ test_that("doesn't produce a warning", {
     )
   )
 })
+
+test_that("it doesn't produce invalid lints", {
+  # Part of #1427
+  expect_warning(
+    expect_lint(
+      "function() {)",
+      list(list(linter = "function_left_parentheses_linter", ranges = list(c(9L, 9L))), list(linter = "error")),
+      function_left_parentheses_linter()
+    ),
+    rex::rex("Could not find range end for lint. Defaulting to width 1.")
+  )
+})

tests/testthat/test-xml_nodes_to_lints.R

@@ -86,6 +86,48 @@ test_that("it handles multi-line lints correctly", {
   expect_identical(l$ranges, list(as.integer(c(xml2::xml_attr(node, "col1"), nchar(code[1L])))))
 })
 
+test_that("it doesn't produce invalid lints", {
+  # Part of #1427
+  code <- "before   %+%   after"
+  tmpfile <- withr::local_tempfile(lines = code)
+  expr <- get_source_expressions(tmpfile)$expressions[[2L]]
+  xml <- expr$full_xml_parsed_content
+  node <- xml2::xml_find_first(xml, "//SPECIAL")
+
+  expect_warning(l_invalid_loc1 <- xml_nodes_to_lints(
+    xml = node,
+    source_expression = expr,
+    lint_message = "lint_msg",
+    column_number_xpath = "number(./preceding-sibling::*[1]/@col2 + 1)",
+    range_start_xpath = "number(./preceding-sibling::SPECIAL[1]/@col1)",
+    range_end_xpath = "number(./following-sibling::*[1]/@col2)"
+  ), rex::rex("Could not find range start for lint. Defaulting to start of line."))
+  expect_identical(l_invalid_loc1$column_number, nchar("before") + 1L)
+  expect_identical(l_invalid_loc1$ranges, list(c(1L, nchar(code))))
+
+  expect_warning(l_invalid_loc2 <- xml_nodes_to_lints(
+    xml = node,
+    source_expression = expr,
+    lint_message = "lint_msg",
+    column_number_xpath = "number(./preceding-sibling::*[1]/@col2 + 1)",
+    range_start_xpath = "number(./preceding-sibling::*[1]/@col1)",
+    range_end_xpath = "number(./following-sibling::SPECIAL[1]/@col2)"
+  ), rex::rex("Could not find range end for lint. Defaulting to width 1."))
+  expect_identical(l_invalid_loc2$column_number, nchar("before") + 1L)
+  expect_identical(l_invalid_loc2$ranges, list(c(1L, 1L)))
+
+  expect_warning(l_invalid_col <- xml_nodes_to_lints(
+    xml = node,
+    source_expression = expr,
+    lint_message = "lint_msg",
+    column_number_xpath = "number(./preceding-sibling::SPECIAL[1]/@col2 + 1)",
+    range_start_xpath = "number(./preceding-sibling::*[1]/@col1)",
+    range_end_xpath = "number(./following-sibling::*[1]/@col2)"
+  ), rex::rex("Could not find location for lint. Defaulting to start of range."))
+  expect_identical(l_invalid_col$column_number, 1L)
+  expect_identical(l_invalid_col$ranges, list(c(1L, nchar(code))))
+})
+
 test_that("erroneous input errors", {
   expect_error(xml_nodes_to_lints(1L), "Expected an xml_nodeset", fixed = TRUE)
 })