length_test_linter() for length(x == 0) (#2124)

Author: MichaelChirico

DESCRIPTION

@@ -118,6 +118,7 @@ Collate:
     'is_numeric_linter.R'
     'keyword_quote_linter.R'
     'length_levels_linter.R'
+    'length_test_linter.R'
     'lengths_linter.R'
     'library_call_linter.R'
     'line_length_linter.R'

NAMESPACE

@@ -80,6 +80,7 @@ export(is_lint_level)
 export(is_numeric_linter)
 export(keyword_quote_linter)
 export(length_levels_linter)
+export(length_test_linter)
 export(lengths_linter)
 export(library_call_linter)
 export(line_length_linter)

NEWS.md

@@ -53,6 +53,7 @@
 * `scalar_in_linter()` for discouraging `%in%` when the right-hand side is a scalar, e.g. `x %in% 1` (part of #884, @MichaelChirico).
 * `if_not_else_linter()` for encouraging `if` statements to be structured as `if (A) x else y` instead of `if (!A) y else x` (part of #884, @MichaelChirico).
 * `repeat_linter()` for encouraging `repeat` for infinite loops instead of `while (TRUE)` (#2106, @MEO265).
+* `length_test_linter()` detects the common mistake `length(x == 0)` which is meant to be `length(x) == 0` (#1991, @MichaelChirico).
 
 ## Changes to defaults
 

R/length_test_linter.R

@@ -0,0 +1,51 @@
+#' Check for a common mistake where length is applied in the wrong place
+#'
+#' Usage like `length(x == 0)` is a mistake. If you intended to check `x` is empty,
+#'   use `length(x) == 0`. Other mistakes are possible, but running `length()` on the
+#'   outcome of a logical comparison is never the best choice.
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = "length(x == 0)",
+#'   linters = length_test_linter()
+#' )
+#'
+#' # okay
+#' lint(
+#'   text = "length(x) > 0",
+#'   linters = length_test_linter()
+#' )
+#' @evalRd rd_tags("class_equals_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+length_test_linter <- function() {
+  xpath <- glue::glue("
+  //SYMBOL_FUNCTION_CALL[text() = 'length']
+    /parent::expr
+    /following-sibling::expr[{ xp_or(infix_metadata$xml_tag[infix_metadata$comparator]) }]
+    /parent::expr
+  ")
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    bad_expr <- xml_find_all(xml, xpath)
+    expr_parts <- vapply(lapply(bad_expr, xml_find_all, "expr[2]/*"), xml_text, character(3L))
+    lint_message <- sprintf(
+      "Checking the length of a logical vector is likely a mistake. Did you mean `length(%s) %s %s`?",
+      expr_parts[1L, ], expr_parts[2L, ], expr_parts[3L, ]
+    )
+
+    xml_nodes_to_lints(
+      bad_expr,
+      source_expression = source_expression,
+      lint_message = lint_message,
+      type = "warning"
+    )
+  })
+}

inst/lintr/linters.csv

@@ -44,6 +44,7 @@ inner_combine_linter,efficiency consistency readability
 is_numeric_linter,readability best_practices consistency
 keyword_quote_linter,readability consistency style
 length_levels_linter,readability best_practices consistency
+length_test_linter,common_mistakes efficiency
 lengths_linter,efficiency readability best_practices
 library_call_linter,style best_practices readability
 line_length_linter,style readability default configurable

man/common_mistakes_linters.Rd

@@ -0,0 +1,32 @@
+test_that("skips allowed usages", {
+  linter <- length_test_linter()
+
+  expect_lint("length(x) > 0", NULL, linter)
+  expect_lint("length(DF[key == val, cols])", NULL, linter)
+})
+
+test_that("blocks simple disallowed usages", {
+  linter <- length_test_linter()
+  lint_msg_stub <- rex::rex("Checking the length of a logical vector is likely a mistake. Did you mean ")
+
+  expect_lint("length(x == 0)", rex::rex(lint_msg_stub, "`length(x) == 0`?"), linter)
+  expect_lint("length(x == y)", rex::rex(lint_msg_stub, "`length(x) == y`?"), linter)
+  expect_lint("length(x + y == 2)", rex::rex(lint_msg_stub, "`length(x+y) == 2`?"), linter)
+})
+
+local({
+  ops <- c(lt = "<", lte = "<=", gt = ">", gte = ">=", eq = "==", neq = "!=")
+  linter <- length_test_linter()
+  lint_msg_stub <- rex::rex("Checking the length of a logical vector is likely a mistake. Did you mean ")
+
+  patrick::with_parameters_test_that(
+    "all logical operators detected",
+    expect_lint(
+      paste("length(x", op, "y)"),
+      rex::rex("`length(x) ", op, " y`?"),
+      linter
+    ),
+    op = ops,
+    .test_name = names(ops)
+  )
+})