Allow invalid xml (#560)

* Get NULL xml_parsed_content for invalid xml

* Check NULL xml_parsed_content

* Add test case

* Update NEWS.md

Author: renkun-ken

NEWS.md

@@ -9,6 +9,7 @@
 * `seq_linter()`'s lint message is clearer about the reason for linting. (#522, @michaelchirico)
 * New `missing_package_linter()` (#536, #547, @renkun-ken)
 * New `namespace_linter()` (#548, #551, @renkun-ken)
+* Fix possible error on invalid XML produced by xmlparsedata (#559, #560, @renkun-ken)
 
 # lintr 2.0.1
 

R/get_source_expressions.R

@@ -94,7 +94,7 @@ get_source_expressions <- function(filename) {
       file_lines = source_file$lines,
       content = source_file$lines,
       full_parsed_content = parsed_content,
-      xml_parsed_content = if (!is.null(parsed_content)) xml2::read_xml(xmlparsedata::xml_parse_data(parsed_content))
+      xml_parsed_content = if (!is.null(parsed_content)) tryCatch(xml2::read_xml(xmlparsedata::xml_parse_data(parsed_content)), error = function(e) NULL)
     )
 
   list(expressions = expressions, error = e, lines = source_file$lines)
@@ -119,7 +119,7 @@ get_single_source_expression <- function(loc,
     column = parsed_content[loc, "col1"],
     lines = expr_lines,
     parsed_content = pc,
-    xml_parsed_content = xml2::read_xml(xmlparsedata::xml_parse_data(pc)),
+    xml_parsed_content = tryCatch(xml2::read_xml(xmlparsedata::xml_parse_data(pc)), error = function(e) NULL),
     content = content,
     find_line = find_line_fun(content),
     find_column = find_column_fun(content)

R/missing_package_linter.R

@@ -3,7 +3,7 @@
 #' @export
 missing_package_linter <- function(source_file) {
 
-  if (!length(source_file$parsed_content)) return(list())
+  if (!length(source_file$parsed_content) || is.null(source_file$xml_parsed_content)) return(list())
 
   xml <- source_file$xml_parsed_content
 

R/namespace_linter.R

@@ -8,7 +8,7 @@
 #' @export
 namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) {
   function(source_file) {
-    if (!length(source_file$parsed_content)) return(list())
+    if (!length(source_file$parsed_content) || is.null(source_file$xml_parsed_content)) return(list())
 
     xml <- source_file$xml_parsed_content
 

R/seq_linter.R

@@ -6,7 +6,7 @@
 #' @export
 seq_linter <- function(source_file) {
 
-  if (!length(source_file$parsed_content)) return(list())
+  if (!length(source_file$parsed_content) || is.null(source_file$xml_parsed_content)) return(list())
 
   xml <- source_file$xml_parsed_content
 

tests/testthat/test-error.R

@@ -38,4 +38,8 @@ test_that("returns the correct linting", {
     NULL,
     equals_na_linter
   )
+
+  expect_lint("\\",
+    rex("unexpected input")
+  )
 })