Fix package_hooks_linter to validate .onUnload() arguments

Signed-off-by: Emmanuel Ferdman <[email protected]>

Author: emmanuel-ferdman

R/package_hooks_linter.R

@@ -1,6 +1,6 @@
 #' Package hooks linter
 #'
-#' Check various common "gotchas" in [.onLoad()], [.onAttach()], [.Last.lib()], and [.onDetach()]
+#' Check various common "gotchas" in [.onLoad()], [.onAttach()], [.Last.lib()], [.onDetach()], and [.onUnload()]
 #'   namespace hooks that will cause `R CMD check` issues. See Writing R Extensions for details.
 #'
 #' 1. `.onLoad()` shouldn't call [cat()], [message()], [print()], [writeLines()], [packageStartupMessage()],
@@ -9,7 +9,7 @@
 #'    `require()`, `library()`, or `installed.packages()`.
 #' 3. `.Last.lib()` and `.onDetach()` shouldn't call [library.dynam.unload()].
 #' 4. `.onLoad()` and `.onAttach()` should take two arguments, with names matching `^lib` and `^pkg`;
-#'    `.Last.lib()` and `.onDetach()` should take one argument with name matching `^lib`.
+#'    `.Last.lib()`, `.onDetach()`, and `.onUnload()` should take one argument with name matching `^lib`.
 #'
 #' @examples
 #' # will produce lints
@@ -28,6 +28,11 @@
 #'   linters = package_hooks_linter()
 #' )
 #'
+#' lint(
+#'   text = ".onUnload <- function() { }",
+#'   linters = package_hooks_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = ".onLoad <- function(lib, pkg) { }",
@@ -44,6 +49,11 @@
 #'   linters = package_hooks_linter()
 #' )
 #'
+#' lint(
+#'   text = ".onUnload <- function(libpath) { }",
+#'   linters = package_hooks_linter()
+#' )
+#'
 #' @evalRd rd_tags("package_hooks_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
@@ -77,7 +87,7 @@ package_hooks_linter <- function() {
 
   # lints here will hit the function <expr>,
   #   this path returns to the corresponding namespace hook's name
-  ns_calls <- xp_text_in_table(c(".onLoad", ".onAttach", ".onDetach", ".Last.lib"))
+  ns_calls <- xp_text_in_table(c(".onLoad", ".onAttach", ".onDetach", ".onUnload", ".Last.lib"))
 
   # usually any given package will have one or maybe two files defining namespace hooks.
   #   given the number of checks, then, it's prudent to check first if any such hook is defined,
@@ -118,7 +128,7 @@ package_hooks_linter <- function() {
   unload_arg_name_xpath <- "
   (//FUNCTION | //OP-LAMBDA)
     /parent::expr[
-      preceding-sibling::expr/SYMBOL[text() = '.onDetach' or text() = '.Last.lib']
+      preceding-sibling::expr/SYMBOL[text() = '.onDetach' or text() = '.onUnload' or text() = '.Last.lib']
       and (
         count(SYMBOL_FORMALS) != 1
         or SYMBOL_FORMALS[not(starts-with(text(), 'lib'))]
@@ -180,7 +190,7 @@ package_hooks_linter <- function() {
     bad_unload_call_lints <-
       xml_nodes_to_lints(bad_unload_call_expr, source_expression, bad_unload_call_message, type = "warning")
 
-    # (5) .Last.lib() and .onDetach() should take one arguments with name matching ^lib
+    # (5) .Last.lib(), .onDetach(), and .onUnload() should take one argument with name matching ^lib
     unload_arg_name_expr <- xml_find_all(xml, unload_arg_name_xpath)
 
     unload_arg_name_message <- sprintf(

tests/testthat/test-package_hooks_linter.R

@@ -171,14 +171,17 @@ test_that("package_hooks_linter blocks attaching namespaces", {
   )
 })
 
-test_that("package_hooks_linter skips valid .onDetach() and .Last.lib()", {
+test_that("package_hooks_linter skips valid .onDetach(), .Last.lib(), and .onUnload()", {
   linter <- package_hooks_linter()
 
   expect_lint(".onDetach <- function(lib) { }", NULL, linter)
   expect_lint(".onDetach <- function(libname) { }", NULL, linter)
 
   expect_lint(".Last.lib <- function(lib) { }", NULL, linter)
   expect_lint(".Last.lib <- function(libname) { }", NULL, linter)
+
+  expect_lint(".onUnload <- function(lib) { }", NULL, linter)
+  expect_lint(".onUnload <- function(libpath) { }", NULL, linter)
 })
 
 test_that("package_hooks_linter catches usage of library.dynam.unload()", {
@@ -202,7 +205,7 @@ test_that("package_hooks_linter catches usage of library.dynam.unload()", {
   )
 })
 
-test_that("package_hooks_linter detects bad argument names in .onDetach()/.Last.lib()", {
+test_that("package_hooks_linter detects bad argument names in .onDetach()/.Last.lib()/.onUnload()", {
   linter <- package_hooks_linter()
   lint_msg_part <- " should take one argument starting with 'lib'"
 
@@ -216,6 +219,11 @@ test_that("package_hooks_linter detects bad argument names in .onDetach()/.Last.
     rex::rex(".Last.lib()", lint_msg_part),
     linter
   )
+  expect_lint(
+    ".onUnload <- function(pkg) { }",
+    rex::rex(".onUnload()", lint_msg_part),
+    linter
+  )
 
   # exactly one argument required.
   # NB: QC.R allows ... arguments to be passed, but disallow this flexibility in the linter.
@@ -234,6 +242,21 @@ test_that("package_hooks_linter detects bad argument names in .onDetach()/.Last.
     rex::rex(".onDetach()", lint_msg_part),
     linter
   )
+  expect_lint(
+    ".onUnload <- function() { }",
+    rex::rex(".onUnload()", lint_msg_part),
+    linter
+  )
+  expect_lint(
+    ".onUnload <- function(lib, pkg) { }",
+    rex::rex(".onUnload()", lint_msg_part),
+    linter
+  )
+  expect_lint(
+    ".onUnload <- function(...) { }",
+    rex::rex(".onUnload()", lint_msg_part),
+    linter
+  )
 })
 
 test_that("function shorthand is handled", {
@@ -265,6 +288,16 @@ test_that("function shorthand is handled", {
     rex::rex(".onDetach() should take one argument starting with 'lib'."),
     linter
   )
+  expect_lint(
+    ".onUnload <- \\() { }",
+    rex::rex(".onUnload() should take one argument starting with 'lib'."),
+    linter
+  )
+  expect_lint(
+    ".onUnload <- \\(libpath) { }",
+    NULL,
+    linter
+  )
 })
 
 test_that("lints vectorize", {
@@ -279,4 +312,16 @@ test_that("lints vectorize", {
     ),
     package_hooks_linter()
   )
+
+  expect_lint(
+    trim_some("{
+      .onDetach <- function(xxx) { }
+      .onUnload <- function(yyy) { }
+    }"),
+    list(
+      list(".onDetach", line_number = 2L),
+      list(".onUnload", line_number = 3L)
+    ),
+    package_hooks_linter()
+  )
 })