Merge remote-tracking branch 'origin/main' into rep_len

DESCRIPTION

@@ -152,6 +152,7 @@ Collate:
     'pipe_call_linter.R'
     'pipe_consistency_linter.R'
     'pipe_continuation_linter.R'
+    'pipe_return_linter.R'
     'print_linter.R'
     'quotes_linter.R'
     'redundant_equals_linter.R'

NAMESPACE

@@ -115,6 +115,7 @@ export(paste_linter)
 export(pipe_call_linter)
 export(pipe_consistency_linter)
 export(pipe_continuation_linter)
+export(pipe_return_linter)
 export(print_linter)
 export(quotes_linter)
 export(redundant_equals_linter)

NEWS.md

@@ -31,6 +31,7 @@
 * `which_grepl_linter()` for discouraging `which(grepl(ptn, x))` in favor of directly using `grep(ptn, x)` (part of #884, @MichaelChirico).
 * `list_comparison_linter()` for discouraging comparisons on the output of `lapply()`, e.g. `lapply(x, sum) > 10` (part of #884, @MichaelChirico).
 * `print_linter()` for discouraging usage of `print()` on string literals like `print("Reached here")` or `print(paste("Found", nrow(DF), "rows."))` (#1894, @MichaelChirico).
+* `pipe_return_linter()` for discouraging usage of `return()` inside a {magrittr} pipeline (part of #884, @MichaelChirico).
 
 ### Lint accuracy fixes: removing false positives
 

R/cache.R

@@ -127,9 +127,8 @@ retrieve_lint <- function(cache, expr, linter, lines) {
     )
     if (is.na(new_line_number)) {
       return(NULL)
-    } else {
-      lints[[i]]$line_number <- new_line_number
     }
+    lints[[i]]$line_number <- new_line_number
   }
   cache_lint(cache, expr, linter, lints)
   lints

R/lint.R

@@ -36,10 +36,6 @@
 #'
 #' @export
 lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = TRUE, text = NULL) {
-  if (has_positional_logical(list(...))) {
-    stop("'cache' is no longer available as a positional argument; please supply 'cache' as a named argument instead.")
-  }
-
   check_dots(...names(), c("exclude", "parse_exclusions"))
 
   needs_tempfile <- missing(filename) || re_matches(filename, rex(newline))
@@ -135,13 +131,6 @@ lint_dir <- function(path = ".", ...,
                      pattern = "(?i)[.](r|rmd|qmd|rnw|rhtml|rrst|rtex|rtxt)$",
                      parse_settings = TRUE,
                      show_progress = NULL) {
-  if (has_positional_logical(list(...))) {
-    stop(
-      "'relative_path' is no longer available as a positional argument; ",
-      "please supply 'relative_path' as a named argument instead. "
-    )
-  }
-
   check_dots(...names(), c("lint", "exclude", "parse_exclusions"))
 
   if (isTRUE(parse_settings)) {
@@ -235,15 +224,6 @@ lint_package <- function(path = ".", ...,
                          exclusions = list("R/RcppExports.R"),
                          parse_settings = TRUE,
                          show_progress = NULL) {
-  if (has_positional_logical(list(...))) {
-    # nocov start: dead code path
-    stop(
-      "'relative_path' is no longer available as a positional argument; ",
-      "please supply 'relative_path' as a named argument instead. "
-    )
-    # nocov end
-  }
-
   if (length(path) > 1L) {
     stop("Only linting one package at a time is supported.")
   }

R/pipe_return_linter.R

@@ -0,0 +1,39 @@
+#' Block usage of return() in magrittr pipelines
+#'
+#' [return()] inside a magrittr pipeline does not actually execute `return()`
+#'   like you'd expect: `\(x) { x %>% return(); FALSE }` will return `FALSE`!
+#'   It will technically work "as expected" if this is the final statement
+#'   in the function body, but such usage is misleading. Instead, assign
+#'   the pipe outcome to a variable and return that.
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = "function(x) x %>% return()",
+#'   linters = pipe_return_linter()
+#' )
+#'
+#' # okay
+#' code <- "function(x) {\n  y <- sum(x)\n  return(y)\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = pipe_return_linter()
+#' )
+#'
+#' @evalRd rd_tags("pipe_return_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+pipe_return_linter <- make_linter_from_xpath(
+  # NB: Native pipe disallows this at the parser level, so there's no need
+  #   to lint in valid R code.
+  xpath = "
+  //SPECIAL[text() = '%>%']
+    /following-sibling::expr[expr/SYMBOL_FUNCTION_CALL[text() = 'return']]
+  ",
+  lint_message = paste(
+    "Using return() as the final step of a magrittr pipeline",
+    "is an anti-pattern. Instead, assign the output of the pipeline to",
+    "a well-named object and return that."
+  )
+)

R/settings_utils.R

@@ -108,7 +108,6 @@ find_local_config <- function(path, config_file) {
 pkg_name <- function(path = find_package()) {
   if (is.null(path)) {
     return(NULL)
-  } else {
-    read.dcf(file.path(path, "DESCRIPTION"), fields = "Package")[1L]
   }
+  read.dcf(file.path(path, "DESCRIPTION"), fields = "Package")[1L]
 }

inst/lintr/linters.csv

@@ -72,6 +72,7 @@ paste_linter,best_practices consistency configurable
 pipe_call_linter,style readability
 pipe_consistency_linter,style readability configurable
 pipe_continuation_linter,style readability default
+pipe_return_linter,best_practices common_mistakes
 print_linter,best_practices consistency
 quotes_linter,style consistency readability default configurable
 redundant_equals_linter,best_practices readability efficiency common_mistakes

tests/testthat/test-cyclocomp_linter.R

@@ -11,14 +11,37 @@ test_that("returns the correct linting", {
     "unexpected symbol", cc_linter_2
   )
 
-  complexity <- readLines(
-    system.file("example/complexity.R", package = "lintr")
-  )
-  expect_lint(complexity, lint_msg, cc_linter_2)
+  complex_lines <- trim_some("
+    complexity <- function(x) {
+      if (x > 0.0) {
+        if (x > 10.0) {
+          if (x > 20.0) {
+            x <- x / 2.0
+          } else {
+            return(x)
+          }
+        } else {
+          return(x)
+        }
+      } else {
+        if (x < -10.0) {
+          if (x < -20.0) {
+            x <- x * 2.0
+          } else {
+            return(x)
+          }
+        } else {
+          return(x)
+        }
+      }
+      x
+    }
+  ")
+  expect_lint(complex_lines, lint_msg, cc_linter_2)
   expect_lint(
-    complexity,
+    complex_lines,
     "should have cyclomatic complexity of less than 2, this has 10",
     cc_linter_2
   )
-  expect_lint(complexity, NULL, cyclocomp_linter(10L))
+  expect_lint(complex_lines, NULL, cyclocomp_linter(10L))
 })

tests/testthat/test-lint.R

@@ -215,14 +215,6 @@ test_that("old compatibility usage errors", {
   )
 })
 
-test_that("Deprecated positional usage of cache= errors", {
-  expect_error(
-    lint("a = 2\n", FALSE, linters = assignment_linter()),
-    "'cache' is no longer available as a positional argument",
-    fixed = TRUE
-  )
-})
-
 test_that("Linters throwing an error give a helpful error", {
   tmp_file <- withr::local_tempfile(lines = "a <- 1")
   linter <- function() Linter(function(source_expression) stop("a broken linter"))

tests/testthat/test-lint_dir.R

@@ -99,16 +99,6 @@ test_that("lint_dir works with specific linters without specifying other argumen
   expect_length(lint_dir(the_dir, commented_code_linter(), parse_settings = FALSE), 0L)
 })
 
-test_that("lint_dir errors for relative_path= in 2nd positional argument", {
-  the_dir <- test_path("dummy_packages", "package", "vignettes")
-
-  expect_error(
-    lint_dir(the_dir, FALSE),
-    "'relative_path' is no longer available as a positional argument",
-    fixed = TRUE
-  )
-})
-
 test_that("typo in argument name gives helpful error", {
   expect_error(lint_dir(litners = identity), "Found unknown arguments in [.][.][.].*[?]lint_dir ")
 })

tests/testthat/test-pipe_return_linter.R

@@ -0,0 +1,47 @@
+test_that("pipe_return_linter skips allowed usages", {
+  linter <- pipe_return_linter()
+
+  normal_pipe_lines <- trim_some("
+    x %>%
+      filter(str > 5) %>%
+      summarize(str = sum(str))
+  ")
+  expect_lint(normal_pipe_lines, NULL, linter)
+
+  normal_function_lines <- trim_some("
+    pipeline <- function(x) {
+      out <- x %>%
+        filter(str > 5) %>%
+        summarize(str = sum(str))
+      return(out)
+    }
+  ")
+  expect_lint(normal_function_lines, NULL, linter)
+
+  nested_return_lines <- trim_some("
+    pipeline <- function(x) {
+      x_squared <- x %>%
+        sapply(function(xi) {
+          return(xi ** 2)
+        })
+      return(x_squared)
+    }
+  ")
+  expect_lint(nested_return_lines, NULL, linter)
+})
+
+test_that("pipe_return_linter blocks simple disallowed usages", {
+  lines <- trim_some("
+    pipeline <- function(x) {
+      out <- x %>%
+        filter(str > 5) %>%
+        summarize(str = sum(str)) %>%
+        return()
+    }
+  ")
+  expect_lint(
+    lines,
+    rex::rex("Using return() as the final step of a magrittr pipeline"),
+    pipe_return_linter()
+  )
+})

tests/testthat/test-spaces_left_parentheses_linter.R

@@ -63,13 +63,35 @@ test_that("spaces_left_parentheses_linter blocks disallowed usages", {
 })
 
 test_that("doesn't produce a warning", {
-  # complexity.R contains a function with nested if-statements where the conditional includes a unary minus.
+  # this contains a function with nested if-statements where the conditional includes a unary minus.
   # This specific constellation with another if-statement at the same nesting level on the other enclosing if-branch
   # caused a warning in spaces_left_parentheses_linter (e.g. 84bc3a is broken)
+  complex_lines <- trim_some("
+    complexity <- function(x) {
+      if (x > 0.0) {
+        if (x > 10.0) {
+          if (x > 20.0) {
+            x <- x / 2.0
+          } else {
+            return(x)
+          }
+        } else {
+          return(x)
+        }
+      } else {
+        if (x < -10.0) {
+          if (x < -20.0) {
+            x <- x * 2.0
+          } else {
+            return(x)
+          }
+        } else {
+          return(x)
+        }
+      }
+      x
+    }
+  ")
 
-  expect_silent(
-    lint(
-      system.file("example/complexity.R", package = "lintr")
-    )
-  )
+  expect_no_warning(lint(text = complex_lines, linters = spaces_left_parentheses_linter()))
 })