expect_null_linter

DESCRIPTION

@@ -62,6 +62,7 @@ Collate:
     'equals_na_linter.R'
     'exclude.R'
     'expect_lint.R'
+    'expect_null_linter.R'
     'extract.R'
     'extraction_operator_linter.R'
     'function_left_parentheses.R'
@@ -103,5 +104,6 @@ Collate:
     'undesirable_operator_linter.R'
     'unneeded_concatenation_linter.R'
     'with_id.R'
+    'xp_utils.R'
     'zzz.R'
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -31,6 +31,7 @@ export(duplicate_argument_linter)
 export(equals_na_linter)
 export(expect_lint)
 export(expect_lint_free)
+export(expect_null_linter)
 export(extraction_operator_linter)
 export(function_left_parentheses_linter)
 export(get_source_expressions)

NEWS.md

@@ -86,6 +86,8 @@ function calls. (#850, #851, @renkun-ken)
   * New function `available_linters()` to list available linters and their tags 
     This feature is extensible by package authors providing add-on linters for {lintr}.
 * `lintr` now uses the 3rd edition of `testthat` (@MichaelChirico, #910)
+* `lintr` is adopting a new set of linters provided as part of Google's extension to the tidyverse style guide (#884, @michaelchirico)
+   + `expect_null_linter()` Require usage of `expect_null(x)` over `expect_equal(x, NULL)` and similar
 
 # lintr 2.0.1
 

R/expect_null_linter.R

@@ -0,0 +1,49 @@
+#' expect_null Linter
+#'
+#' Require usage of `expect_null(x)` over `expect_equal(x, NULL)` and similar
+#' usages.
+#'
+#' [testthat::expect_null()] exists specifically for testing for `NULL` objects.
+#' [testthat::expect_equal()], [testthat::expect_identical()], and
+#' [testthat::expect_true()] can also be used for such tests,
+#' but it is better to use the tailored function instead.
+#'
+#' @evalRd rd_tags("expect_null_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+expect_null_linter <- function() {
+  Linter(function(source_file) {
+    if (length(source_file$parsed_content) == 0L) {
+      return(list())
+    }
+
+    xml <- source_file$xml_parsed_content
+
+    # two cases two match:
+    #  (1) expect_{equal,identical}(x, NULL) (or NULL, x)
+    #  (2) expect_true(is.null(x))
+    xpath <- "//expr[
+      (
+        SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
+        and following-sibling::expr[position() <= 2 and NULL_CONST]
+      ) or (
+        SYMBOL_FUNCTION_CALL[text() = 'expect_true']
+        and following-sibling::expr[1][expr[SYMBOL_FUNCTION_CALL[text() = 'is.null']]]
+      )
+    ]"
+
+    bad_expr <- xml2::xml_find_all(xml, xpath)
+
+    lapply(bad_expr, gen_expect_null_lint, source_file)
+  })
+}
+
+gen_expect_null_lint <- function(expr, source_file) {
+  matched_function <- xml2::xml_text(xml2::xml_find_first(expr, "SYMBOL_FUNCTION_CALL"))
+  if (matched_function %in% c("expect_equal", "expect_identical")) {
+    lint_msg <- sprintf("expect_null(x) is better than %s(x, NULL)", matched_function)
+  } else {
+    lint_msg <- "expect_null(x) is better than expect_true(is.null(x))"
+  }
+  xml_nodes_to_lint(expr, source_file, lint_msg, type = "warning")
+}

R/linter_tag_docs.R

@@ -72,3 +72,11 @@ NULL
 #' @evalRd rd_linters("configurable")
 #' @seealso [linters] for a complete list of linters available in lintr.
 NULL
+
+#' Package development linters
+#' @name package_development_linters
+#' @description
+#' Linters useful to package developers, for example for writing consistent tests.
+#' @evalRd rd_linters("package_development")
+#' @seealso [linters] for a complete list of linters available in lintr.
+NULL

R/utils.R

@@ -199,35 +199,6 @@ unescape <- function(str, q="`") {
   str
 }
 
-# like `text() %in% table`, translated to XPath 1.0
-xp_text_in_table <- function(table) paste("text() = ", quote_wrap(table, "'"), collapse = " or ")
-
-# convert an XML match into a Lint
-xml_nodes_to_lint <- function(xml, source_file, message,
-                              type = c("style", "warning", "error"),
-                              offset = 0L, global = FALSE) {
-  type <- match.arg(type, c("style", "warning", "error"))
-  line1 <- xml2::xml_attr(xml, "line1")[1]
-  col1 <- as.integer(xml2::xml_attr(xml, "col1")) + offset
-
-  line_elt <- if (global) "file_lines" else "lines"
-
-  if (xml2::xml_attr(xml, "line2") == line1) {
-    col2 <- as.integer(xml2::xml_attr(xml, "col2")) + offset
-  } else {
-    col2 <- unname(nchar(source_file[[line_elt]][line1]))
-  }
-  return(Lint(
-    filename = source_file$filename,
-    line_number = as.integer(line1),
-    column_number = as.integer(col1),
-    type = type,
-    message = message,
-    line = source_file[[line_elt]][line1],
-    ranges = list(c(col1 - offset, col2))
-  ))
-}
-
 # interface to work like options() or setwd() -- returns the old value for convenience
 set_lang <- function(new_lang) {
   old_lang <- Sys.getenv("LANGUAGE", unset = NA)

R/xp_utils.R

@@ -0,0 +1,53 @@
+# utils for working with xpaths
+
+# like `text() %in% table`, translated to XPath 1.0
+xp_text_in_table <- function(table) paste("text() = ", quote_wrap(table, "'"), collapse = " or ")
+
+# convert an XML match into a Lint
+xml_nodes_to_lint <- function(xml, source_file, message,
+                              type = c("style", "warning", "error"),
+                              offset = 0L,
+                              global = FALSE) {
+  type <- match.arg(type, c("style", "warning", "error"))
+  line1 <- xml2::xml_attr(xml, "line1")[1]
+  col1 <- as.integer(xml2::xml_attr(xml, "col1")) + offset
+
+  line_elt <- if (global) "file_lines" else "lines"
+
+  if (xml2::xml_attr(xml, "line2") == line1) {
+    col2 <- as.integer(xml2::xml_attr(xml, "col2")) + offset
+  } else {
+    col2 <- unname(nchar(source_file[[line_elt]][line1]))
+  }
+  return(Lint(
+    filename = source_file$filename,
+    line_number = as.integer(line1),
+    column_number = as.integer(col1),
+    type = type,
+    message = message,
+    line = source_file[[line_elt]][line1],
+    ranges = list(c(col1 - offset, col2))
+  ))
+}
+
+#' Safer wrapper for paste(..., sep = " and ")
+#'
+#' The intent is to use this for readability when combining XPath conditions so
+#'   the `...` elements should be in that language, but this is not enforced.
+#'
+#' Inputs are also wrapped in `()` so as not to risk mixing operator precedence.
+#'
+#' @param ... Series of conditions
+#' @noRd
+xp_and <- function(...) sprintf("(%s)", paste(..., sep = ") and ("))
+
+#' Safer wrapper for paste(..., sep = " or ")
+#'
+#' The intent is to use this for readability when combining XPath conditions so
+#'   the `...` elements should be in that language, but this is not enforced.
+#'
+#' Inputs are also wrapped in `()` so as not to risk mixing operator precedence.
+#'
+#' @param ... Series of conditions
+#' @noRd
+xp_or <- function(...) sprintf("(%s)", paste(..., sep = ") or ("))

inst/lintr/linters.csv

@@ -1,11 +1,13 @@
 linter,tags
 absolute_path_linter,robustness best_practices configurable
 assignment_linter,style consistency default
+backport_linter,robustness configurable package_development
 closed_curly_linter,style readability default configurable
 commas_linter,style readability default
 commented_code_linter,style readability best_practices default
 cyclocomp_linter,style readability best_practices default configurable
 equals_na_linter,robustness correctness common_mistakes default
+expect_null_linter,package_development best_practices
 extraction_operator_linter,style best_practices
 function_left_parentheses_linter,style readability default
 implicit_integer_linter,style consistency best_practices
@@ -17,6 +19,7 @@ object_length_linter,style readability default configurable
 object_name_linter,style consistency default configurable
 object_usage_linter,style readability correctness default
 open_curly_linter,style readability default configurable
+package_hooks_linter,style correctness package_development
 paren_brace_linter,style readability default
 pipe_continuation_linter,style readability default
 semicolon_terminator_linter,style readability default configurable
@@ -32,12 +35,10 @@ undesirable_function_linter,style efficiency configurable robustness best_practi
 undesirable_operator_linter,style efficiency configurable robustness best_practices
 unneeded_concatenation_linter,style readability efficiency
 assignment_spaces_linter,style readability
-backport_linter,robustness configurable
 duplicate_argument_linter,correctness common_mistakes configurable
 missing_argument_linter,correctness common_mistakes configurable
 missing_package_linter,robustness common_mistakes
 namespace_linter,correctness robustness configurable
-package_hooks_linter,style correctness
 paren_body_linter,style readability default
 pipe_call_linter,style readability
 sprintf_linter,correctness common_mistakes

tests/testthat/test-expect_null_linter.R

@@ -0,0 +1,42 @@
+test_that("expect_null_linter skips allowed usages", {
+  # NB: this usage should be expect_false(), but this linter should
+  #   nevertheless apply (e.g. for maintainers not using expect_not_linter)
+  expect_lint("expect_true(!is.null(x))", NULL, expect_null_linter())
+  # NB: also applies to tinytest, but it's sufficient to test testthat
+  expect_lint("testthat::expect_true(!is.null(x))", NULL, expect_null_linter())
+
+  # length-0 could be NULL, but could be integer() or list(), so let it pass
+  expect_lint("expect_length(x, 0L)", NULL, expect_null_linter())
+
+  # no false positive for is.null() at the wrong positional argument
+  expect_lint("expect_true(x, is.null(y))", NULL, expect_null_linter())
+})
+
+test_that("expect_null_linter blocks simple disallowed usages", {
+  expect_lint(
+    "expect_equal(x, NULL)",
+    rex::rex("expect_null(x) is better than expect_equal(x, NULL)"),
+    expect_null_linter()
+  )
+
+  # expect_identical is treated the same as expect_equal
+  expect_lint(
+    "testthat::expect_identical(x, NULL)",
+    rex::rex("expect_null(x) is better than expect_identical(x, NULL)"),
+    expect_null_linter()
+  )
+
+  # reverse order lints the same
+  expect_lint(
+    "expect_equal(NULL, x)",
+    rex::rex("expect_null(x) is better than expect_equal(x, NULL)"),
+    expect_null_linter()
+  )
+
+  # different equivalent usage
+  expect_lint(
+    "expect_true(is.null(foo(x)))",
+    rex::rex("expect_null(x) is better than expect_true(is.null(x))"),
+    expect_null_linter()
+  )
+})