Equals na comment

NEWS.md

@@ -15,6 +15,7 @@
 * New `sprintf_linter()` (#544, #578, @renkun-ken)
 * Exclusions specified in the `.lintr` file are now relative to the location of that file 
   and support excluding entire directories (#158, #438, @AshesITR)
+* `equals_na_linter()` now lints `x != NA` and `NA == x`, and skips usages in comments (#545, @michaelchirico)
 
 # lintr 2.0.1
 

R/equals_na_lintr.R

@@ -1,38 +1,22 @@
-#' @describeIn linters that checks for x == NA
+#' @describeIn linters that checks for x == NA and x != NA
 #' @export
 equals_na_linter <- function(source_file) {
-  all_matches <- re_matches(
-    source_file$lines,
-    rex("==", zero_or_more(" "), "NA"),
-    locations = TRUE,
-    global = TRUE
-  )
-  line_numbers <- as.integer(names(source_file$lines))
 
-  Map(
-    function(line_matches, line_number) {
-      lapply(
-        split(line_matches, seq_len(nrow(line_matches))),
-        function(match) {
-          start <- match[["start"]]
-          if (is.na(start)) {
-            return()
-          }
-          end <- match[["end"]]
-          Lint(
-            filename = source_file$filename,
-            line_number = line_number,
-            column_number = start,
-            type = "warning",
-            message = "Use is.na rather than == NA.",
-            line = source_file$lines[[as.character(line_number)]],
-            ranges = list(c(start, end)),
-            linter = "equals_na_linter"
-          )
-        }
-      )
-    },
-    all_matches,
-    line_numbers
-  )
+  if (is.null(source_file$xml_parsed_content)) return(list())
+
+  xml <- source_file$xml_parsed_content
+
+  comparators <- c("EQ", "NE")
+  comparator_table <- paste0("self::", comparators, collapse = " or ")
+  NA_values <- c("NA", "NA_integer_", "NA_real_", "NA_complex_", "NA_character_")
+  NA_table <- paste("text() =", quote_wrap(NA_values, "'"), collapse = " or ")
+
+  xpath_fmt <- "//expr[expr[NUM_CONST[%s]]]/*[%s]"
+  xpath <- sprintf(xpath_fmt, NA_table, comparator_table)
+
+  bad_expr <- xml2::xml_find_all(xml, xpath)
+
+  lapply(bad_expr, xml_nodes_to_lint, source_file,
+         message = "Use is.na for comparisons to NA (not == or !=)",
+         linter = "equals_na_linter", type = "warning")
 }

R/utils.R

@@ -169,6 +169,9 @@ try_silently <- function(expr) {
 viapply <- function(x, ...) vapply(x, ..., FUN.VALUE = integer(1))
 vcapply <- function(x, ...) vapply(x, ..., FUN.VALUE = character(1))
 
+# imitate sQuote(x, q) [requires R>=3.6]
+quote_wrap <- function(x, q) sprintf("%1$s%2$s%1$s", q, x, q)
+
 unquote <- function(str, q="`") {
   # Remove surrounding quotes (select either single, double or backtick) from given character vector
   # and unescape special characters.
@@ -204,3 +207,27 @@ unescape <- function(str, q="`") {
   )
   str
 }
+
+# convert an XML match into a Lint
+xml_nodes_to_lint <- function(xml, source_file, message, linter,
+                              type = c("style", "warning", "error")) {
+  type <- match.arg(type, c("style", "warning", "error"))
+  line1 <- xml2::xml_attr(xml, "line1")[1]
+  col1 <- as.integer(xml2::xml_attr(xml, "col1"))
+
+  if (xml2::xml_attr(xml, "line2") == line1) {
+    col2 <- as.integer(xml2::xml_attr(xml, "col2"))
+  } else {
+    col2 <- nchar(source_file$lines[line1])
+  }
+  return(Lint(
+    filename = source_file$filename,
+    line_number = as.integer(line1),
+    column_number = as.integer(col1),
+    type = type,
+    message = message,
+    line = source_file$lines[line1],
+    ranges = list(c(col1, col2)),
+    linter = linter
+  ))
+}

tests/testthat/test-equals_na_linter.R

@@ -1,7 +1,7 @@
 context("equals_na_linter")
 
 test_that("returns the correct linting", {
-  msg <- rex("Use is.na rather than == NA.")
+  msg <- rex("Use is.na for comparisons to NA (not == or !=)")
   expect_lint("blah", NULL, equals_na_linter)
   expect_lint("  blah", NULL, equals_na_linter)
   expect_lint("  blah", NULL, equals_na_linter)
@@ -18,4 +18,21 @@ test_that("returns the correct linting", {
     equals_na_linter
   )
 
+  expect_lint(
+    "x==f(1, ignore = NA)",
+    NULL,
+    equals_na_linter
+  )
+
+ # equals_na_linter should ignore strings and comments
+  expect_lint(
+    "is.na(x) # dont flag x == NA if inside a comment",
+    NULL,
+    equals_na_linter
+  )
+  expect_lint(
+    "msg <- 'dont flag x == NA if inside a string'",
+    NULL,
+    equals_na_linter
+  )
 })