Update sprintf_linter() to lint constant strings

NEWS.md

@@ -47,6 +47,7 @@
 * `fixed_regex_linter()` recognizes usage of the new (R 4.5.0) `grepv()` wrapper of `grep()`; `regex_subset_linter()` also recommends `grepv()` alternatives (#2855, @MichaelChirico).
 * `object_usage_linter()` lints missing packages that may cause false positives (#2872, @AshesITR)
 * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico).
+* `sprintf_linter()` lints `sprintf()` and `gettextf()` calls when a constant string is passed to `fmt` (#2894, @Bisaloo).
 
 ### New linters
 

R/expect_length_linter.R

@@ -22,13 +22,13 @@
 #' @export
 expect_length_linter <- function() {
   # TODO(#2465): also catch expect_true(length(x) == 1)
-  xpath <- sprintf("
+  xpath <- "
   following-sibling::expr[
     expr[1][SYMBOL_FUNCTION_CALL[text() = 'length']]
     and (position() = 1 or preceding-sibling::expr[NUM_CONST])
   ]
     /parent::expr[not(SYMBOL_SUB[text() = 'info' or contains(text(), 'label')])]
-  ")
+  "
 
   Linter(linter_level = "expression", function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls(c("expect_equal", "expect_identical"))

R/sprintf_linter.R

@@ -12,6 +12,11 @@
 #'   linters = sprintf_linter()
 #' )
 #'
+#' lint(
+#'   text = 'sprintf("hello")',
+#'   linters = sprintf_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = 'sprintf("hello %s %s %d", x, y, z)',
@@ -29,21 +34,15 @@
 sprintf_linter <- function() {
   call_xpath <- "
   parent::expr[
-    (
-      OP-LEFT-PAREN/following-sibling::expr[1]/STR_CONST or
-      SYMBOL_SUB[text() = 'fmt']/following-sibling::expr[1]/STR_CONST
-    ) and
     not(expr/SYMBOL[text() = '...'])
   ]"
 
   pipes <- setdiff(magrittr_pipes, "%$%")
-  in_pipe_xpath <- glue("self::expr[
-    preceding-sibling::*[1][self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }]]
-    and (
-      preceding-sibling::*[2]/STR_CONST
-      or SYMBOL_SUB[text() = 'fmt']/following-sibling::expr[1]/STR_CONST
-    )
-  ]")
+  in_pipe_xpath <- glue(
+    "self::expr[
+      preceding-sibling::*[not(self::COMMENT)][1][self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }]]
+    ]"
+  )
 
   is_missing <- function(x) is.symbol(x) && !nzchar(x)
 
@@ -89,7 +88,7 @@ sprintf_linter <- function() {
       arg_idx <- 2L:length(parsed_expr)
       parsed_expr[arg_idx + 1L] <- parsed_expr[arg_idx]
       names(parsed_expr)[arg_idx + 1L] <- arg_names[arg_idx]
-      parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[2]"))
+      parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[not(self::COMMENT)][2]"))
       names(parsed_expr)[2L] <- ""
     }
     parsed_expr <- zap_extra_args(parsed_expr)
@@ -104,15 +103,41 @@ sprintf_linter <- function() {
   Linter(linter_level = "file", function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls(c("sprintf", "gettextf"))
     sprintf_calls <- xml_find_all(xml_calls, call_xpath)
+    in_pipeline <- !is.na(xml_find_first(sprintf_calls, in_pipe_xpath))
+
+    fmt_by_name <- get_r_string(
+      sprintf_calls,
+      "SYMBOL_SUB[text() = 'fmt']/following-sibling::expr[1]/STR_CONST"
+    )
+    fmt_by_pos <- ifelse(
+      in_pipeline,
+      get_r_string(sprintf_calls, "preceding-sibling::*[not(self::COMMENT)][2]/STR_CONST"),
+      get_r_string(sprintf_calls, "OP-LEFT-PAREN/following-sibling::expr[1]/STR_CONST")
+    )
 
-    sprintf_warning <- vapply(sprintf_calls, capture_sprintf_warning, character(1L))
+    fmt <- ifelse(!is.na(fmt_by_name), fmt_by_name, fmt_by_pos)
+    constant_fmt <- !is.na(fmt) & !grepl("%", gsub("%%", "", fmt, fixed = TRUE), fixed = TRUE)
+
+    fct_name <- xp_call_name(sprintf_calls)
+
+    constant_fmt_lint <- xml_nodes_to_lints(
+      sprintf_calls[constant_fmt],
+      source_expression = source_expression,
+      lint_message = sprintf("%s call can be removed when a constant string is provided.", fct_name[constant_fmt]),
+      type = "warning"
+    )
+
+    templated_sprintf_calls <- sprintf_calls[!constant_fmt & !is.na(fmt)]
+    sprintf_warning <- vapply(templated_sprintf_calls, capture_sprintf_warning, character(1L))
 
     has_warning <- !is.na(sprintf_warning)
-    xml_nodes_to_lints(
-      sprintf_calls[has_warning],
+    invalid_sprintf_lint <- xml_nodes_to_lints(
+      templated_sprintf_calls[has_warning],
       source_expression = source_expression,
       lint_message = sprintf_warning[has_warning],
       type = "warning"
     )
+
+    c(constant_fmt_lint, invalid_sprintf_lint)
   })
 }

tests/testthat/test-sprintf_linter.R

@@ -4,14 +4,13 @@ patrick::with_parameters_test_that(
     linter <- sprintf_linter()
 
     # NB: using paste0, not sprintf, to avoid escaping '%d' in sprint fmt=
-    expect_lint(paste0(call_name, "('hello')"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %d', 1)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %d', x)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %d', x + 1)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %d', f(x))"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %1$s %1$s', x)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), NULL, linter)
-    expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), NULL, linter)
+    expect_no_lint(paste0(call_name, "('hello %d', 1)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %d', x)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %d', x + 1)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %d', f(x))"), linter)
+    expect_no_lint(paste0(call_name, "('hello %1$s %1$s', x)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), linter)
+    expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), linter)
   },
   .test_name = c("sprintf", "gettextf"),
   call_name = c("sprintf", "gettextf")
@@ -23,7 +22,13 @@ patrick::with_parameters_test_that(
     linter <- sprintf_linter()
     unused_arg_msg <- if (getRversion() >= "4.1.0") "one argument not used by format" else NULL
 
-    expect_lint(paste0(call_name, "('hello', 1)"), unused_arg_msg, linter)
+    expect_lint(paste0(call_name, "('hello', 1)"), "constant", linter)
+
+    expect_lint(paste0(call_name, "('hello')"), "constant", linter)
+    expect_lint(paste0(call_name, "('100%% automated')"), "constant", linter)
+    expect_lint(paste0(call_name, "('100%%%% automated')"), "constant", linter)
+    expect_lint(paste0(call_name, "('100%%%s')"), "too few", linter)
+    expect_lint(paste0(call_name, "('100%%%%s', x)"), "constant", linter)
 
     expect_lint(
       paste0(call_name, "('hello %d', 'a')"),
@@ -66,24 +71,42 @@ test_that("edge cases are detected correctly", {
   linter <- sprintf_linter()
 
   # works with multi-line sprintf and comments
-  expect_lint(
+  expect_no_lint(
     trim_some("
       sprintf(
         'test fmt %s', # this is a comment
         2
       )
     "),
-    NULL,
+    linter
+  )
+
+  expect_no_lint(
+    trim_some("
+      'test fmt %s' |>   # this is a pipe comment
+        sprintf(         # this is an opening comment
+          2              # this is a mid-call comment
+        )
+    "),
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      'test fmt' |>   # this is a pipe comment
+        sprintf()
+    "),
+    "constant",
     linter
   )
 
   # dots
-  expect_lint("sprintf('%d %d, %d', id, ...)", NULL, linter)
+  expect_no_lint("sprintf('%d %d, %d', id, ...)", linter)
 
   # TODO(#1265) extend ... detection to at least test for too many arguments.
 
   # named argument fmt
-  expect_lint("sprintf(x, fmt = 'hello %1$s %1$s')", NULL, linter)
+  expect_no_lint("sprintf(x, fmt = 'hello %1$s %1$s')", linter)
 
   expect_lint(
     "sprintf(x, fmt = 'hello %1$s %1$s %3$d', y)",
@@ -92,7 +115,9 @@ test_that("edge cases are detected correctly", {
   )
 
   # #2131: xml2lang stripped necessary whitespace
-  expect_lint("sprintf('%s', if (A) '' else y)", NULL, linter)
+  expect_no_lint("sprintf('%s', if (A) '' else y)", linter)
+
+  expect_no_lint("sprintf('100%%%s', x)", linter)
 })
 
 local({
@@ -103,17 +128,17 @@ local({
   patrick::with_parameters_test_that(
     "piping into sprintf works",
     {
-      expect_lint(paste("x", pipe, "sprintf(fmt = '%s')"), NULL, linter)
+      expect_no_lint(paste("x", pipe, "sprintf(fmt = '%s')"), linter)
       # no fmt= specified -> this is just 'sprintf("%s", "%s%s")', which won't lint
-      expect_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), NULL, linter)
+      expect_no_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), linter)
       expect_lint(paste("x", pipe, "sprintf(fmt = '%s%s')"), unused_fmt_msg, linter)
 
       # Cannot evaluate statically --> skip
-      expect_lint(paste("x", pipe, 'sprintf("a")'), NULL, linter)
+      expect_no_lint(paste("x", pipe, 'sprintf("a")'), linter)
       # Nested pipes
       expect_lint(
         paste("'%%sb'", pipe, "sprintf('%s')", pipe, "sprintf('a')"),
-        if (getRversion() >= "4.1.0") list(column_number = nchar(paste("'%%sb'", pipe, "x")), message = unused_arg_msg),
+        if (getRversion() >= "4.1.0") list(column_number = nchar(paste("'%%sb'", pipe, "x")), message = "constant"),
         linter
       )
       expect_lint(