New terminal_close_linter (#2276)

* New terminal_close_linter

* typo

* metadata tests

* commit to single lint for multiple close()

DESCRIPTION

@@ -170,6 +170,7 @@ Collate:
     'string_boundary_linter.R'
     'strings_as_factors_linter.R'
     'system_file_linter.R'
+    'terminal_close_linter.R'
     'trailing_blank_lines_linter.R'
     'trailing_whitespace_linter.R'
     'tree_utils.R'

NAMESPACE

@@ -133,6 +133,7 @@ export(stopifnot_all_linter)
 export(string_boundary_linter)
 export(strings_as_factors_linter)
 export(system_file_linter)
+export(terminal_close_linter)
 export(todo_comment_linter)
 export(trailing_blank_lines_linter)
 export(trailing_whitespace_linter)

NEWS.md

@@ -8,6 +8,7 @@
 
 * `stopifnot_all_linter()` discourages tests with `all()` like `stopifnot(all(x > 0))`; `stopifnot()` runs `all()` itself, and uses a better error message (part of #884, @MichaelChirico).
 * `comparison_negation_linter()` for discouraging negated comparisons when a direct negation is preferable, e.g. `!(x == y)` could be `x != y` (part of #884, @MichaelChirico).
+* `terminal_close_linter()` for discouraging using `close()` to end functions (part of #884, @MichaelChirico). Such usages are not robust to errors, where `close()` will not be run as intended. Put `close()` in an `on.exit()` hook, or use {withr} to manage connections with proper cleanup.
 
 ### Lint accuracy fixes: removing false positives
 

R/terminal_close_linter.R

@@ -0,0 +1,25 @@
+#' Prohibit close() from terminating a function definition
+#'
+#' Functions that end in `close(x)` are almost always better written by using
+#'   `on.exit(close(x))` close to where `x` is defined and/or opened.
+#'
+#' @evalRd rd_tags("terminal_close_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+terminal_close_linter <- make_linter_from_xpath(
+  xpath = "
+  //FUNCTION
+    /following-sibling::expr
+    /expr[last()][
+      expr/SYMBOL_FUNCTION_CALL[text() = 'close']
+      or expr[
+        SYMBOL_FUNCTION_CALL[text() = 'return']
+        and following-sibling::expr/expr/SYMBOL_FUNCTION_CALL[text() = 'close']
+      ]
+    ]
+  ",
+  lint_message = paste(
+    "Use on.exit(close(x)) to close connections instead of",
+    "running it as the last call in a function."
+  )
+)

inst/lintr/linters.csv

@@ -90,6 +90,7 @@ string_boundary_linter,readability efficiency configurable
 strings_as_factors_linter,robustness
 system_file_linter,consistency readability best_practices
 T_and_F_symbol_linter,style readability robustness consistency best_practices default
+terminal_close_linter,best_practices robustness
 todo_comment_linter,style configurable
 trailing_blank_lines_linter,style default
 trailing_whitespace_linter,style default configurable

tests/testthat/test-terminal_close_linter.R

@@ -0,0 +1,74 @@
+test_that("terminal_close_linter skips allowed cases", {
+  linter <- terminal_close_linter()
+
+  lines <- trim_some("
+    foo <- function(bar) {
+      tmp <- tempfile()
+      on.exit(close(tmp))
+      writeLines(bar, tmp)
+      return(invisible())
+    }
+  ")
+  expect_lint(lines, NULL, linter)
+
+  lines <- trim_some("
+    foo <- function(bar) {
+      close <- bar + 1
+      return(close)
+    }
+  ")
+  expect_lint(lines, NULL, linter)
+
+  lines <- trim_some("
+    foo <- function(bar) {
+      close <- bar + 1
+      close
+    }
+  ")
+  expect_lint(lines, NULL, linter)
+})
+
+test_that("terminal_close_linter blocks simple cases", {
+  linter <- terminal_close_linter()
+  lint_msg <- rex::rex("Use on.exit(close(x)) to close connections")
+
+  expect_lint(
+    trim_some("
+      foo <- function(bar) {
+        tmp <- tempfile()
+        writeLines(bar, tmp)
+        return(close(tmp))
+      }
+    "),
+    list(lint_msg, line_number = 4L, column_number = 3L),
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      foo <- function(bar) {
+        tmp <- tempfile()
+        writeLines(bar, tmp)
+        close(tmp)
+      }
+    "),
+    list(lint_msg, line_number = 4L, column_number = 3L),
+    linter
+  )
+
+  # When multiple terminations happen, only lint the one
+  expect_lint(
+    trim_some("
+      foo <- function(bar) {
+        tmp1 <- tempfile()
+        tmp2 <- tempfile()
+        writeLines(bar, tmp1)
+        writeLines(bar, tmp2)
+        close(tmp1)
+        close(tmp2)
+      }
+    "),
+    list(lint_msg, line_number = 7L, column_number = 3L),
+    linter
+  )
+})