New stop_paste_linter

DESCRIPTION

@@ -60,6 +60,7 @@ Collate:
     'commas_linter.R'
     'comment_linters.R'
     'comments.R'
+    'condition_message_linter.R'
     'conjunct_test_linter.R'
     'consecutive_stopifnot_linter.R'
     'cyclocomp_linter.R'

NAMESPACE

@@ -24,6 +24,7 @@ export(clear_cache)
 export(closed_curly_linter)
 export(commas_linter)
 export(commented_code_linter)
+export(condition_message_linter)
 export(conjunct_test_linter)
 export(consecutive_stopifnot_linter)
 export(cyclocomp_linter)

NEWS.md

@@ -116,6 +116,7 @@ function calls. (#850, #851, @renkun-ken)
    * `literal_coercion_linter()` Require using correctly-typed literals instead of direct coercion, e.g. `1L` instead of `as.numeric(1)`
    * `paste_sep_linter()` Require usage of `paste0()` over `paste(sep = "")`
    * `nested_ifelse_linter()` Prevent nested calls to `ifelse()` like `ifelse(A, x, ifelse(B, y, z))`, and similar
+   * `condition_message_linter` Prevent condition messages from being constructed like `stop(paste(...))` (where just `stop(...)` is preferable)
    * `redundant_ifelse_linter()` Prevent usage like `ifelse(A & B, TRUE, FALSE)` or `ifelse(C, 0, 1)` (the latter is `as.numeric(!C)`)
    * `else_same_line_linter()` Require `else` to come on the same line as the preceding `}`, if present
    * `unreachable_code_linter()` Prevent code after `return()` and `stop()` statements that will never be reached

R/condition_message_linter.R

@@ -0,0 +1,56 @@
+#' Block usage of paste() and paste0() with messaging functions using ...
+#'
+#' `stop(paste0(...))` is strictly redundant -- `stop(...)` is equivalent.
+#'   `stop(...)` is also preferable to `stop(paste(...))`. The same applies to
+#'   all default condition functions, i.e., [stop()], [warning()], [message()],
+#'   and [packageStartupMessage()].
+#'
+#' @evalRd rd_tags("condition_message_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+condition_message_linter <- function() {
+  Linter(function(source_file) {
+    if (length(source_file$xml_parsed_content) == 0L) {
+      return(list())
+    }
+
+    xml <- source_file$xml_parsed_content
+
+    translators <- c("packageStartupMessage", "message", "warning", "stop")
+    # TODO: refactor to work for raw-string equivalents
+    xpath <- glue::glue("//expr[
+      expr[SYMBOL_FUNCTION_CALL[ {xp_text_in_table(translators)} ]]
+      and expr[
+        expr[SYMBOL_FUNCTION_CALL[text() = 'paste' or text() = 'paste0']]
+        and not(SYMBOL_SUB[text() = 'collapse'])
+        and (
+          not(SYMBOL_SUB[text() = 'sep'])
+          or SYMBOL_SUB[
+            text() = 'sep'
+            and following-sibling::expr[1]/STR_CONST[text() = '\"\"' or text() = '\" \"']
+          ]
+        )
+      ]
+    ]")
+
+    bad_expr <- xml2::xml_find_all(xml, xpath)
+
+    return(lapply(
+      bad_expr,
+      xml_nodes_to_lint,
+      source_file = source_file,
+      lint_message = function(expr) {
+        outer_call <- xml2::xml_text(xml2::xml_find_first(expr, "expr/SYMBOL_FUNCTION_CALL"))
+        inner_call <- xml2::xml_text(xml2::xml_find_first(expr, "expr/expr/SYMBOL_FUNCTION_CALL"))
+
+        message <- sprintf("Don't use %s to build %s strings.", inner_call, outer_call)
+        paste(
+          message,
+          "Instead use the fact that these functions build condition message strings from their input",
+          '(using "" as a separator). For translateable strings, prefer using gettextf().'
+        )
+       },
+      type = "warning"
+    ))
+  })
+}

inst/lintr/linters.csv

@@ -8,6 +8,7 @@ class_equals_linter,best_practices robustness consistency
 closed_curly_linter,style readability default configurable
 commas_linter,style readability default
 commented_code_linter,style readability best_practices default
+condition_message_linter,best_practices consistency
 conjunct_test_linter,package_development best_practices readability
 consecutive_stopifnot_linter,style readability consistency
 cyclocomp_linter,style readability best_practices default configurable

tests/testthat/test-condition_message_linter.R

@@ -0,0 +1,54 @@
+test_that("condition_message_linter skips allowed usages", {
+  expect_lint("stop('a string', 'another')", NULL, condition_message_linter())
+  expect_lint("warning('a string', 'another')", NULL, condition_message_linter())
+  expect_lint("message('a string', 'another')", NULL, condition_message_linter())
+
+  # paste/paste0 allowed when using other seps and/or collapse
+  expect_lint("stop(paste(x, collapse = ''))", NULL, condition_message_linter())
+  expect_lint("message(paste(x, sep = '-'))", NULL, condition_message_linter())
+
+  # sprintf is OK (really should be gettextf but offering translations
+  #   at google internally is not likely to happen any time soon)
+  expect_lint("stop(sprintf('A %s!', 'string'))", NULL, condition_message_linter())
+})
+
+test_that("condition_message_linter blocks simple disallowed usages", {
+  expect_lint(
+    "stop(paste('a string', 'another'))",
+    rex::rex("Don't use paste to build stop strings."),
+    condition_message_linter()
+  )
+
+  expect_lint(
+    "warning(paste0('a string ', 'another'))",
+    rex::rex("Don't use paste0 to build warning strings."),
+    condition_message_linter()
+  )
+
+  # not thrown off by named arguments
+  expect_lint(
+    "stop(paste('a', 'b'), call. = FALSE)",
+    rex::rex("Don't use paste to build stop strings."),
+    condition_message_linter()
+  )
+
+  expect_lint(
+    "warning(paste0('a', 'b'), immediate. = TRUE)",
+    rex::rex("Don't use paste0 to build warning strings."),
+    condition_message_linter()
+  )
+})
+
+test_that("packageStartupMessage usages are also matched", {
+  expect_lint(
+    "packageStartupMessage(paste('a string', 'another'))",
+    rex::rex("Don't use paste to build packageStartupMessage strings."),
+    condition_message_linter()
+  )
+
+  expect_lint(
+    "packageStartupMessage(paste0('a string ', 'another'))",
+    rex::rex("Don't use paste0 to build packageStartupMessage strings."),
+    condition_message_linter()
+  )
+})