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,50 @@
+#' 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
+
+    # for expect_{equal,identical}(x, NULL)
+    equal_expr_cond <- sprintf(
+      "SYMBOL_FUNCTION_CALL[%s] and following-sibling::expr[2][NULL_CONST]",
+      xp_text_in_table(c("expect_equal", "expect_identical"))
+    )
+
+    # for expect_true(is.null(x))
+    is_null_call <- "SYMBOL_FUNCTION_CALL[text() = 'is.null']"
+    true_expr_cond <- xp_and(
+      "SYMBOL_FUNCTION_CALL[text() = 'expect_true']",
+      sprintf("following-sibling::expr[1][expr[%s]]", is_null_call)
+    )
+
+    xpath <- sprintf("//expr[(%s) or (%s)]", equal_expr_cond, true_expr_cond)
+
+    bad_expr <- xml2::xml_find_all(xml, xpath)
+
+    return(lapply(
+      bad_expr,
+      xml_nodes_to_lint,
+      source_file = source_file,
+      message = paste(
+        "expect_null(x) is better than expect_equal(x, NULL),",
+        "expect_identical(x, NULL), or expect_true(is.null(x))."
+      ),
+      type = "warning"
+    ))
+  })
+}

R/linter_tag_docs.R

@@ -72,3 +72,12 @@ 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

@@ -6,6 +6,7 @@ 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

tests/testthat/test-expect_null_linter.R

@@ -0,0 +1,36 @@
+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 ExpectNotLinter)
+  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())
+})
+
+test_that("expect_null_linter blocks simple disallowed usages", {
+  expect_lint(
+    "expect_equal(x, NULL)",
+    "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)",
+    "expect_null\\(x\\) is better than expect_equal\\(x, NULL\\)",
+    expect_null_linter()
+  )
+
+  # different equivalent usage
+  expect_lint(
+    "expect_true(is.null(foo(x)))",
+    "expect_null\\(x\\) is better than expect_equal\\(x, NULL\\)",
+    expect_null_linter()
+  )
+})