catch NA %in% x (#2436)

Co-authored-by: AshesITR <[email protected]>

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()
  )