Merge 9adbbe8 into b5e09d0

MichaelChirico · web-flow · commit f0b5762ac346 · 2023-09-19T14:53:50.000-07:00
diff --git a/NEWS.md b/NEWS.md
@@ -35,6 +35,16 @@
   + `undesirable_function_linter()`
   + `unreachable_code_linter()`
   + `yoda_test_linter()`
+* Linters with logic around function declarations consistently include the R 4.0.0 shorthand `\()` (#2190, @MichaelChirico).
+  + `brace_linter()`
+  + `function_left_parentheses_linter()`
+  + `indentation_linter()`
+  + `object_length_linter()`
+  + `object_name_linter()`
+  + `package_hooks_linter()`
+  + `paren_body_linter()`
+  + `unnecessary_lambda_linter()`
+  + `unreachable_code_linter()`
 * `sprintf_linter()` is pipe-aware, so that `x %>% sprintf(fmt = "%s")` no longer lints (#1943, @MichaelChirico).
 * `line_length_linter()` helpfully includes the line length in the lint message (#2057, @MichaelChirico).
 * `conjunct_test_linter()` also lints usage like `dplyr::filter(x, A & B)` in favor of using `dplyr::filter(x, A, B)` (part of #884; #2110 and #2078, @salim-b and @MichaelChirico). Option `allow_filter` toggles when this applies. `allow_filter = "always"` drops such lints entirely, while `"not_dplyr"` only lints calls explicitly qualified as `dplyr::filter()`. The default, `"never"`, assumes all unqualified calls to `filter()` are `dplyr::filter()`.
diff --git a/R/brace_linter.R b/R/brace_linter.R
@@ -124,7 +124,7 @@ brace_linter <- function(allow_single_line = FALSE) {
   # TODO (AshesITR): if c_style_braces is TRUE, this needs to be @line2 + 1
   xp_else_same_line <- glue("//ELSE[{xp_else_closed_curly} and @line1 != {xp_else_closed_curly}/@line2]")
 
-  xp_function_brace <- "//FUNCTION/parent::expr[@line1 != @line2 and not(expr[OP-LEFT-BRACE])]"
+  xp_function_brace <- "(//FUNCTION | //OP-LAMBDA)/parent::expr[@line1 != @line2 and not(expr[OP-LEFT-BRACE])]"
 
   # if (x) { ... } else if (y) { ... } else { ... } is OK; fully exact pairing
   #   of if/else would require this to be
diff --git a/R/declared_functions.R b/R/declared_functions.R
@@ -5,7 +5,7 @@ declared_s3_generics <- function(x) {
 
     # Assigns to a symbol
     "[./LEFT_ASSIGN|EQ_ASSIGN]",
-    "[./expr[FUNCTION]]",
+    "[./expr[FUNCTION or OP-LAMBDA]]",
     "[./expr/SYMBOL]",
 
     # Is a S3 Generic (contains call to UseMethod)
diff --git a/R/function_left_parentheses_linter.R b/R/function_left_parentheses_linter.R
@@ -46,9 +46,9 @@ function_left_parentheses_linter <- function() { # nolint: object_length.
   #   complicated call to an "extracted" function (see #1963). This mistake was made earlier
   #   because it allows the xpath to be the same for both FUNCTION and SYMBOL_FUNCTION_CALL.
   #   Further, write 4 separate XPaths because the 'range_end_xpath' differs for these two nodes.
-  bad_line_fun_xpath <- "//FUNCTION[@line1 != following-sibling::OP-LEFT-PAREN/@line1]"
+  bad_line_fun_xpath <- "(//FUNCTION | //OP-LAMBDA)[@line1 != following-sibling::OP-LEFT-PAREN/@line1]"
   bad_line_call_xpath <- "//SYMBOL_FUNCTION_CALL[@line1 != parent::expr/following-sibling::OP-LEFT-PAREN/@line1]"
-  bad_col_fun_xpath <- "//FUNCTION[
+  bad_col_fun_xpath <- "(//FUNCTION | //OP-LAMBDA)[
     @line1 = following-sibling::OP-LEFT-PAREN/@line1
     and @col2 != following-sibling::OP-LEFT-PAREN/@col1 - 1
   ]"
diff --git a/R/indentation_linter.R b/R/indentation_linter.R
@@ -124,7 +124,7 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
   paren_tokens_right <- c("OP-RIGHT-BRACE", "OP-RIGHT-PAREN", "OP-RIGHT-BRACKET", "OP-RIGHT-BRACKET")
   infix_tokens <- setdiff(infix_metadata$xml_tag, c("OP-LEFT-BRACE", "OP-COMMA", paren_tokens_left))
   no_paren_keywords <- c("ELSE", "REPEAT")
-  keyword_tokens <- c("FUNCTION", "IF", "FOR", "WHILE")
+  keyword_tokens <- c("FUNCTION", "OP-LAMBDA", "IF", "FOR", "WHILE")
 
   xp_last_on_line <- "@line1 != following-sibling::*[not(self::COMMENT)][1]/@line1"
 
@@ -342,7 +342,7 @@ build_indentation_style_tidy <- function() {
   #>   body
   #> }
   xp_is_double_indent <- "
-    parent::expr[FUNCTION and not(@line1 = SYMBOL_FORMALS/@line1)]
+    parent::expr[(FUNCTION or OP-LAMBDA) and not(@line1 = SYMBOL_FORMALS/@line1)]
       /OP-RIGHT-PAREN[@line1 = preceding-sibling::*[not(self::COMMENT)][1]/@line2]
   "
 
diff --git a/R/package_hooks_linter.R b/R/package_hooks_linter.R
@@ -54,7 +54,7 @@ package_hooks_linter <- function() {
     .onAttach = c(bad_msg_calls, "library.dynam")
   )
   bad_msg_call_xpath_fmt <- "
-  //FUNCTION
+  (//FUNCTION | //OP-LAMBDA)
     /parent::expr[preceding-sibling::expr/SYMBOL[text() = '%s']]
     //SYMBOL_FUNCTION_CALL[%s]
   "
@@ -81,7 +81,7 @@ package_hooks_linter <- function() {
   hook_xpath <- sprintf("string(./ancestor::expr/expr/SYMBOL[%s])", ns_calls)
 
   load_arg_name_xpath <- "
-  //FUNCTION
+  (//FUNCTION | //OP-LAMBDA)
     /parent::expr[
       preceding-sibling::expr/SYMBOL[text() = '.onAttach' or text() = '.onLoad']
       and (
@@ -95,7 +95,7 @@ package_hooks_linter <- function() {
   "
 
   library_require_xpath <- "
-  //FUNCTION
+  (//FUNCTION | //OP-LAMBDA)
     /parent::expr[preceding-sibling::expr/SYMBOL[text() = '.onAttach' or text() = '.onLoad']]
     //*[1][
       (self::SYMBOL or self::SYMBOL_FUNCTION_CALL)
@@ -104,13 +104,13 @@ package_hooks_linter <- function() {
   "
 
   bad_unload_call_xpath <- "
-  //FUNCTION
+  (//FUNCTION | //OP-LAMBDA)
     /parent::expr[preceding-sibling::expr/SYMBOL[text() = '.Last.lib' or text() = '.onDetach']]
     //SYMBOL_FUNCTION_CALL[text() = 'library.dynam.unload']
   "
 
   unload_arg_name_xpath <- "
-  //FUNCTION
+  (//FUNCTION | //OP-LAMBDA)
     /parent::expr[
       preceding-sibling::expr/SYMBOL[text() = '.onDetach' or text() = '.Last.lib']
       and (
diff --git a/R/paren_body_linter.R b/R/paren_body_linter.R
@@ -33,6 +33,7 @@ paren_body_linter <- make_linter_from_xpath(
     and @line1 = following-sibling::expr[1]/@line1
     and (
       preceding-sibling::FUNCTION
+      or preceding-sibling::OP-LAMBDA
       or preceding-sibling::IF
       or preceding-sibling::WHILE
       or preceding-sibling::OP-LAMBDA
diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R
@@ -64,7 +64,7 @@ unnecessary_lambda_linter <- function() {
   //SYMBOL_FUNCTION_CALL[ {apply_funs} ]
     /parent::expr
     /following-sibling::expr[
-      FUNCTION
+      (FUNCTION or OP-LAMBDA)
       and count(SYMBOL_FORMALS) = 1
       and {paren_path}/OP-LEFT-PAREN/following-sibling::expr[1][not(preceding-sibling::*[1][self::EQ_SUB])]/SYMBOL
       and SYMBOL_FORMALS = {paren_path}/OP-LEFT-PAREN/following-sibling::expr[1]/SYMBOL
diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R
@@ -57,7 +57,7 @@
 unreachable_code_linter <- function() {
   # NB: use not(OP-DOLLAR) to prevent matching process$stop(), #1051
   xpath_return_stop <- "
-  //FUNCTION
+  (//FUNCTION | //OP-LAMBDA)
     /following-sibling::expr
     /expr[expr[1][not(OP-DOLLAR or OP-AT) and SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop']]]
     /following-sibling::*[
diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R
@@ -2,10 +2,10 @@ test_that("brace_linter lints braces correctly", {
   open_curly_msg <- rex::rex(
     "Opening curly braces should never go on their own line"
   )
-  closed_curly_msg <- rex::rex(paste(
-    "Closing curly-braces should always be on their own line,",
+  closed_curly_msg <- rex::rex(
+    "Closing curly-braces should always be on their own line, ",
     "unless they are followed by an else."
-  ))
+  )
 
   linter <- brace_linter()
   expect_lint("blah", NULL, linter)
@@ -553,3 +553,21 @@ test_that("code with pipes is handled correctly", {
     linter
   )
 })
+
+test_that("function shorthand is treated like 'full' function", {
+  skip_if_not_r_version("4.1.0")
+  linter <- brace_linter()
+
+  expect_lint("a <- \\() {  \n}", NULL, linter)
+  expect_lint(
+    trim_some("
+      x <- \\()
+              {2}
+    "),
+    list(
+      rex::rex("Opening curly braces should never go on their own line"),
+      rex::rex("Closing curly-braces should always be on their own line")
+    ),
+    linter
+  )
+})
diff --git a/tests/testthat/test-function_left_parentheses_linter.R b/tests/testthat/test-function_left_parentheses_linter.R
@@ -167,6 +167,7 @@ test_that("it doesn't produce invalid lints", {
 
 test_that("newline in character string doesn't trigger false positive (#1963)", {
   linter <- function_left_parentheses_linter()
+
   expect_lint('foo("\n")$bar()', NULL, linter)
   # also corrected the lint metadata for similar cases
   expect_lint(
@@ -182,3 +183,13 @@ test_that("newline in character string doesn't trigger false positive (#1963)",
     linter
   )
 })
+
+test_that("shorthand functions are handled", {
+  skip_if_not_r_version("4.1.0")
+  linter <- function_left_parentheses_linter()
+  fun_lint_msg <- rex::rex("Remove spaces before the left parenthesis in a function definition.")
+
+  expect_lint("blah <- \\(blah) { }", NULL, linter)
+  expect_lint("\\(){\\(){}}()()", NULL, linter)
+  expect_lint("test <- \\ (x) { }", fun_lint_msg, linter)
+})
diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R
@@ -830,3 +830,40 @@ test_that("it doesn't error on invalid code", {
   # Part of #1427
   expect_lint("function() {)", list(linter = "error", message = rex::rex("unexpected ')'")), indentation_linter())
 })
+
+test_that("function shorthand is handled", {
+  skip_if_not_r_version("4.1.0")
+  linter <- indentation_linter()
+
+  expect_lint(
+    trim_some("
+      lapply(1:10, \\(i) {
+        i %% 2
+      })
+    "),
+    NULL,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      lapply(1:10, \\(i) {
+       i %% 2  # indentation is only 1 character
+      })
+    "),
+    "Indentation",
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      \\(
+          a = 1L,
+          b = 2L) {
+        a + b
+      }
+    "),
+    NULL,
+    linter
+  )
+})
diff --git a/tests/testthat/test-object_length_linter.R b/tests/testthat/test-object_length_linter.R
@@ -64,3 +64,13 @@ test_that("object_length_linter won't fail if dependency has no exports", {
     1L
   )
 })
+
+test_that("function shorthand is caught", {
+  skip_if_not_r_version("4.1.0")
+
+  expect_lint(
+    "abcdefghijklm <- \\() NULL",
+    "function names",
+    object_length_linter(length = 10L)
+  )
+})
diff --git a/tests/testthat/test-object_name_linter.R b/tests/testthat/test-object_name_linter.R
@@ -267,3 +267,9 @@ test_that("complex LHS of := doesn't cause false positive", {
   #   but only parent::expr[ASSIGN] is needed for strings.
   expect_lint('dplyr::mutate(df, !!paste0(v, "_l") := df$a * 2)', NULL, object_name_linter())
 })
+
+test_that("function shorthand also lints", {
+  skip_if_not_r_version("4.1.0")
+
+  expect_lint("aBc <- \\() NULL", "function name style", object_name_linter())
+})
diff --git a/tests/testthat/test-package_hooks_linter.R b/tests/testthat/test-package_hooks_linter.R
@@ -246,3 +246,34 @@ test_that("package_hooks_linter detects bad argument names in .onDetach()/.Last.
     package_hooks_linter()
   )
 })
+
+test_that("function shorthand is handled", {
+  skip_if_not_r_version("4.1.0")
+  linter <- package_hooks_linter()
+
+  expect_lint(
+    ".onLoad <- \\(lib, pkg) packageStartupMessage('hi')",
+    rex::rex("Put packageStartupMessage() calls in .onAttach()"),
+    linter
+  )
+  expect_lint(
+    ".onAttach <- \\(xxx, pkg) { }",
+    rex::rex(".onAttach() should take two arguments"),
+    linter
+  )
+  expect_lint(
+    ".onAttach <- \\(lib, pkg) { require(foo) }",
+    rex::rex("Don't alter the search() path in .onAttach() by calling require()."),
+    linter
+  )
+  expect_lint(
+    ".onDetach <- \\(lib) { library.dynam.unload() }",
+    rex::rex("Use library.dynam.unload() calls in .onUnload(), not .onDetach()."),
+    linter
+  )
+  expect_lint(
+    ".onDetach <- \\(xxx) { }",
+    rex::rex(".onDetach() should take one argument starting with 'lib'."),
+    linter
+  )
+})
diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R
@@ -84,3 +84,11 @@ test_that("multi-line versions are caught", {
     paren_body_linter()
   )
 })
+
+test_that("function shorthand is handled", {
+  skip_if_not_r_version("4.1.0")
+  linter <- paren_body_linter()
+  lint_msg <- rex::rex("There should be a space between a right parenthesis and a body expression.")
+
+  expect_lint("\\()test", lint_msg, linter)
+})
diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R
@@ -120,3 +120,13 @@ test_that("cases with braces are caught", {
     linter
   )
 })
+
+test_that("function shorthand is handled", {
+  skip_if_not_r_version("4.1.0")
+
+  expect_lint(
+    "lapply(DF, \\(x) sum(x))",
+    rex::rex("Pass sum directly as a symbol to lapply()"),
+    unnecessary_lambda_linter()
+  )
+})
diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R
@@ -375,6 +375,24 @@ test_that("unreachable_code_linter identifies unreachable code in mixed conditio
   )
 })
 
+test_that("function shorthand is handled", {
+  skip_if_not_r_version("4.1.0")
+
+  expect_lint(
+    trim_some("
+      foo <- \\(bar) {
+        return(bar)
+        x + 3
+      }
+    "),
+    list(
+      line_number = 3L,
+      message = rex::rex("Code and comments coming after a top-level return() or stop()")
+    ),
+    unreachable_code_linter()
+  )
+})
+
 # nolint start: commented_code_linter.
 # TODO(michaelchirico): extend to work on switch() statements
 # test_that("unreachable_code_linter interacts with switch() as expected", {
