New routine_registration_linter (#1669)

DESCRIPTION

@@ -136,6 +136,7 @@ Collate:
     'redundant_equals_linter.R'
     'redundant_ifelse_linter.R'
     'regex_subset_linter.R'
+    'routine_registration_linter.R'
     'semicolon_linter.R'
     'seq_linter.R'
     'settings.R'

NAMESPACE

@@ -101,6 +101,7 @@ export(pipe_continuation_linter)
 export(redundant_equals_linter)
 export(redundant_ifelse_linter)
 export(regex_subset_linter)
+export(routine_registration_linter)
 export(sarif_output)
 export(semicolon_linter)
 export(semicolon_terminator_linter)

NEWS.md

@@ -63,6 +63,8 @@
 
 * `unnecessary_placeholder_linter()` for identifying where usage of the {magrittr} placeholder `.` could be omitted (@MichaelChirico)
 
+* `routine_registration_linter()` for identifying native routines that don't use registration (`useDynLib` in the `NAMESPACE`; @MichaelChirico)
+
 ## Notes
 
 * `lint()` continues to support Rmarkdown documents. For users of custom .Rmd engines, e.g.

R/routine_registration_linter.R

@@ -0,0 +1,58 @@
+#' Identify unregistered native routines
+#'
+#' It is preferable to register routines for efficiency and safety.
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = '.Call("cpp_routine", PACKAGE = "mypkg")',
+#'   linters = routine_registration_linter()
+#' )
+#'
+#' lint(
+#'   text = '.Fortran("f_routine", PACKAGE = "mypkg")',
+#'   linters = routine_registration_linter()
+#' )
+#'
+#' # okay
+#' lint(
+#'   text = ".Call(cpp_routine)",
+#'   linters = routine_registration_linter()
+#' )
+#'
+#' lint(
+#'   text = ".Fortran(f_routine)",
+#'   linters = routine_registration_linter()
+#' )
+#'
+#' @evalRd rd_tags("routine_registration_linter")
+#' @seealso [linters] for a complete list of linters available in lintr. \cr
+#'   https://cran.r-project.org/doc/manuals/r-release/R-exts.html#Registering-native-routines
+#'
+#' @export
+routine_registration_linter <- function() {
+  native_routine_callers <- c(".C", ".Call", ".Fortran", ".External")
+  xpath <- glue::glue("
+  //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(native_routine_callers)} ]
+    /parent::expr
+    /following-sibling::expr[1]/STR_CONST
+    /parent::expr
+  ")
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    bad_expr <- xml2::xml_find_all(xml, xpath)
+
+    xml_nodes_to_lints(
+      bad_expr,
+      source_expression = source_expression,
+      lint_message = "Register your native code routines with useDynLib and R_registerRoutines().",
+      type = "warning"
+    )
+  })
+}

inst/lintr/linters.csv

@@ -62,6 +62,7 @@ pipe_continuation_linter,style readability default
 redundant_equals_linter,best_practices readability efficiency common_mistakes
 redundant_ifelse_linter,best_practices efficiency consistency
 regex_subset_linter,best_practices efficiency
+routine_registration_linter,best_practices efficiency robustness
 semicolon_linter,style readability default configurable
 semicolon_terminator_linter,style readability deprecated configurable
 seq_linter,robustness efficiency consistency best_practices default

tests/testthat/test-routine_registration_linter.R

@@ -0,0 +1,15 @@
+skip_if_not_installed("patrick")
+patrick::with_parameters_test_that(
+  "lints correctly",
+  {
+    linter <- routine_registration_linter()
+    expect_lint(sprintf("%s(ROUTINE, 1)", caller), NULL, linter)
+    expect_lint(
+      sprintf("%s('ROUTINE', PACKAGE = 'foo')", caller),
+      "Register your native code routines with useDynLib",
+      linter
+    )
+  },
+  .test_name = c(".C", ".Call", ".External", ".Fortran"),
+  caller = c(".C", ".Call", ".External", ".Fortran")
+)