catch NA %in% x (#2436)

Co-authored-by: AshesITR <alexander.rosenstock@web.de>

Author: MichaelChirico

NEWS.md

@@ -41,6 +41,7 @@
 * `unreachable_code_linter()` has an argument `allow_comment_regex` for customizing which "terminal" comments to exclude (#2327, @MichaelChirico). `# nolint end` comments are always excluded, as are {covr} exclusions (e.g. `# nocov end`) by default.
 * `format()` and `print()` methods for `lint` and `lints` classes get a new option `width` to control the printing width of lint messages (#1884, @MichaelChirico). The default is controlled by a new option `lintr.format_width`; if unset, no wrapping occurs (matching earlier behavior).
 * New function node caching for big efficiency gains to most linters (e.g. overall `lint_package()` improvement of 14-27% and core linting improvement up to 30%; #2357, @AshesITR). Most linters are written around function usage, and XPath performance searching for many functions is poor. The new `xml_find_function_calls()` entry in the `get_source_expressions()` output caches all function call nodes instead. See the vignette on creating linters for more details on how to use it.
+* `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico).
 
 ### New linters
 

R/any_is_na_linter.R

@@ -36,7 +36,7 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 any_is_na_linter <- function() {
-  xpath <- "
+  any_xpath <- "
   parent::expr
     /following-sibling::expr[1][expr[1][SYMBOL_FUNCTION_CALL[text() = 'is.na']]]
     /parent::expr[
@@ -45,15 +45,28 @@ any_is_na_linter <- function() {
     ]
   "
 
+  in_xpath <- "//SPECIAL[text() = '%in%']/preceding-sibling::expr[NUM_CONST[starts-with(text(), 'NA')]]"
+
   Linter(linter_level = "expression", function(source_expression) {
+    xml <- source_expression$xml_parsed_content
     xml_calls <- source_expression$xml_find_function_calls("any")
-    bad_expr <- xml_find_all(xml_calls, xpath)
 
-    xml_nodes_to_lints(
-      bad_expr,
+    any_expr <- xml_find_all(xml_calls, any_xpath)
+    any_lints <- xml_nodes_to_lints(
+      any_expr,
       source_expression = source_expression,
       lint_message = "anyNA(x) is better than any(is.na(x)).",
       type = "warning"
     )
+
+    in_expr <- xml_find_all(xml, in_xpath)
+    in_lints <- xml_nodes_to_lints(
+      in_expr,
+      source_expression = source_expression,
+      lint_message = "anyNA(x) is better than NA %in% x.",
+      type = "warning"
+    )
+
+    c(any_lints, in_lints)
   })
 }

tests/testthat/test-any_is_na_linter.R

@@ -26,17 +26,31 @@ test_that("any_is_na_linter blocks simple disallowed usages", {
   expect_lint("foo(any(is.na(x)))", lint_message, linter)
 })
 
+test_that("NA %in% x is also found", {
+  linter <- any_is_na_linter()
+  lint_message <- rex::rex("anyNA(x) is better than NA %in% x.")
+
+  expect_lint("NA %in% x", lint_message, linter)
+  expect_lint("NA_real_ %in% x", lint_message, linter)
+  expect_lint("NA_not_a_sentinel_ %in% x", NULL, linter)
+})
+
 test_that("lints vectorize", {
-  lint_message <- rex::rex("anyNA(x) is better than any(is.na(x)).")
+  any_message <- rex::rex("any(is.na(x))")
+  in_message <- rex::rex("NA %in% x")
 
   expect_lint(
     trim_some("{
       any(is.na(foo(x)))
       any(is.na(y), na.rm = TRUE)
+      NA %in% a
+      NA_complex_ %in% b
     }"),
     list(
-      list(lint_message, line_number = 2L),
-      list(lint_message, line_number = 3L)
+      list(any_message, line_number = 2L),
+      list(any_message, line_number = 3L),
+      list(in_message, line_number = 4L),
+      list(in_message, line_number = 5L)
     ),
     any_is_na_linter()
   )