expect_null_linter

.Rbuildignore

@@ -10,7 +10,7 @@
 ^\.Rproj\.user$
 ^\.idea$
 ^\.dev$
-^\.lintr$
+\.lintr$
 ^\.lintr_new$
 ^wercker\.yml$
 ^[^/]+.Rmd$

DESCRIPTION

@@ -60,10 +60,12 @@ Collate:
     'equals_na_linter.R'
     'exclude.R'
     'expect_lint.R'
+    'expect_null_linter.R'
     'extract.R'
     'extraction_operator_linter.R'
     'function_left_parentheses.R'
     'get_source_expressions.R'
+    'google_linters.R'
     'ids_with_token.R'
     'implicit_integer_linter.R'
     'infix_spaces_linter.R'
@@ -98,4 +100,5 @@ Collate:
     'undesirable_operator_linter.R'
     'unneeded_concatenation_linter.R'
     'with_id.R'
+    'xp_utils.R'
     'zzz.R'

NAMESPACE

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

@@ -77,6 +77,8 @@ function calls. (#850, #851, @renkun-ken)
 * Several optional `Imported` packages have become `Suggested` dependencies: `httr`, `testthat`, and `rstudioapi`. This should allow snappier CI builds for usages not relying on some more "peripheral" features of the package.
 * Error message for mismatched starts and ends of exclusion ranges is now more helpful. (#571, #860, @AshesITR and @danielinteractive)
 * Debugging functions (`browser()`, `debug()`, `debugcall()`, `debugonce()`, `trace()`, `undebug()`, `untrace()`) are now part of the default set of undesirable functions to help prevent them from being committed by mistake. (#876, @michaelchirico)
+* A new set of linters provided as part of Google's extension to the tidyverse style guide, available as `google_linters` (#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,43 @@
+#' @describeIn google-linters Require usage of expect_null(x) over expect_equal(x, NULL) and similar
+#' [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.
+#' @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/google_linters.R

@@ -0,0 +1,9 @@
+#' @title Linters for the Google extension to the tidyverse style guide
+#'
+#' Google uses a fork of the tidyverse style guide, pursuant to which
+#'   its R users have written a bundle of linters, many of which
+#'   are generally useful for writing good R code. These linters
+#'   help encourage code consistency, readability, and best practices.
+#'
+#' @name google-linters
+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 ("))

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