Merge branch 'main' into require_nzchar

Author: MichaelChirico

.lintr

@@ -20,7 +20,7 @@ linters: linters_with_defaults(
     implicit_integer_linter(),
     keyword_quote_linter(),
     lengths_linter(),
-    line_length_linter(120),
+    line_length_linter(120L),
     missing_argument_linter(),
     nested_ifelse_linter(),
     numeric_leading_zero_linter(),

DESCRIPTION

@@ -36,7 +36,7 @@ Imports:
     xmlparsedata (>= 1.0.5)
 Suggests:
     bookdown,
-    crayon,
+    cli,
     httr (>= 1.2.1),
     jsonlite,
     mockery,
@@ -128,6 +128,7 @@ Collate:
     'linter_tags.R'
     'lintr-deprecated.R'
     'lintr-package.R'
+    'list_comparison_linter.R'
     'literal_coercion_linter.R'
     'make_linter_from_regex.R'
     'matrix_apply_linter.R'
@@ -151,6 +152,7 @@ Collate:
     'pipe_call_linter.R'
     'pipe_consistency_linter.R'
     'pipe_continuation_linter.R'
+    'print_linter.R'
     'quotes_linter.R'
     'redundant_equals_linter.R'
     'redundant_ifelse_linter.R'

NAMESPACE

@@ -90,6 +90,7 @@ export(lint_dir)
 export(lint_package)
 export(linters_with_defaults)
 export(linters_with_tags)
+export(list_comparison_linter)
 export(literal_coercion_linter)
 export(make_linter_from_xpath)
 export(matrix_apply_linter)
@@ -114,6 +115,7 @@ export(paste_linter)
 export(pipe_call_linter)
 export(pipe_consistency_linter)
 export(pipe_continuation_linter)
+export(print_linter)
 export(quotes_linter)
 export(redundant_equals_linter)
 export(redundant_ifelse_linter)

NEWS.md

@@ -1,8 +1,24 @@
 # lintr (development version)
 
+## Deprecations & breaking changes
+
+* Various things marked deprecated since {lintr} 3.0.0 have been fully deprecated. They will be completely removed in the subsequent release.
+   + `source_file=` argument to `ids_with_token()` and `with_id()`.
+   + Passing linters by name or as non-`"linter"`-classed functions.
+   + `linter=` argument of `Lint()`.
+   + Linters `closed_curly_linter()`, `open_curly_linter()`, `paren_brace_linter()`, and `semicolon_terminator_linter()`..
+   + `with_defaults()`.
+   + Linters `closed_curly_linter()`, `open_curly_linter()`, `paren_brace_linter()`, and `semicolon_terminator_linter()`.
+   + Helper `with_defaults()`.
+
+## Bug fixes
+
+* `object_name_linter()` no longer errors when user-supplied `regexes=` have capture groups (#2188, @MichaelChirico).
+
 ## New and improved features
 
 * More helpful errors for invalid configs (#2253, @MichaelChirico).
+* `library_call_linter()` is extended to encourage all packages to be attached with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico).
 
 ### New linters
 
@@ -11,6 +27,8 @@
 * `comparison_negation_linter()` for discouraging negated comparisons when a direct negation is preferable, e.g. `!(x == y)` could be `x != y` (part of #884, @MichaelChirico).
 * `nzchar_linter()` for encouraging `nzchar()` to test for empty strings, e.g. `nchar(x) > 0` can be `nzchar(x)` (part of #884, @MichaelChirico).
 * `terminal_close_linter()` for discouraging using `close()` to end functions (part of #884, @MichaelChirico). Such usages are not robust to errors, where `close()` will not be run as intended. Put `close()` in an `on.exit()` hook, or use {withr} to manage connections with proper cleanup.
+* `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).
 
 ### Lint accuracy fixes: removing false positives
 
@@ -23,7 +41,7 @@
 
 * `infix_spaces_linter()` distinguishes `<-`, `:=`, `<<-` and `->`, `->>`, i.e. `infix_spaces_linter(exclude_operators = "->")` will no longer exclude `->>` (#2115, @MichaelChirico). This change is breaking for users relying on manually-supplied `exclude_operators` containing `"<-"` to also exclude `:=` and `<<-`. The fix is to manually supply `":="` and `"<<-"` as well. We don't expect this change to affect many users, the fix is simple, and the new behavior is much more transparent, so we are including this breakage in a minor release.
 * Removed `find_line()` and `find_column()` entries from `get_source_expressions()` expression-level objects. These have been marked deprecated since version 3.0.0. No users were found on GitHub.
-* There is experimental support for writing config in plain R scripts (as opposed to DCF files; #1210, @MichaelChirico). The script is run in a new environment and variables matching settings (`?default_settings`) are copied over. In particular, this removes the need to write R code in a DCF-friendly way, and allows normal R syntax highlighting in the saved file. We may eventually deprecate the DCF approach in favor of this one; user feedback is welcome on strong preferences for either approach, or for a different approach like YAML. Generally you should be able to convert your existing `.lintr` file to an equivalent R config by replacing the `:` key-value separators with assignments (`<-`). By default, such a config is searched for in a file named '.lintr.R'. This is a mildly breaking change if you happened to be keeping a file '.lintr.R' around since that file is given precedence over '.lintr'.
+* There is experimental support for writing config in plain R scripts (as opposed to DCF files; #1210, @MichaelChirico). The script is run in a new environment and variables matching settings (`?default_settings`) are copied over. In particular, this removes the need to write R code in a DCF-friendly way, and allows normal R syntax highlighting in the saved file. We may eventually deprecate the DCF approach in favor of this one; user feedback is welcome on strong preferences for either approach, or for a different approach like YAML. Generally you should be able to convert your existing `.lintr` file to an equivalent R config by replacing the `:` key-value separators with assignments (`<-`). By default, such a config is searched for in a file named `.lintr.R`. This is a mildly breaking change if you happened to be keeping a file `.lintr.R` around since that file is given precedence over `.lintr`.
   + We also validate config files up-front make it clearer when invalid configs are present (#2195, @MichaelChirico). There is a warning for "invalid" settings, i.e., settings not part of `?default_settings`. We think this is more likely to affect users declaring settings in R, since any variable defined in the config that's not a setting must be removed to make it clearer which variables are settings vs. ancillary.
 
 ## Bug fixes

R/deprecated.R

@@ -6,7 +6,9 @@
 NULL
 
 lintr_deprecated <- function(old, new = NULL, version = NULL,
-                             type = "Function") {
+                             type = "Function", signal = c("warning", "stop")) {
+  signal <- match.arg(signal)
+  signal <- match.fun(signal)
   msg <- c(
     c(type, " ", old, " was deprecated"),
     if (length(version) > 0L) {
@@ -18,5 +20,5 @@ lintr_deprecated <- function(old, new = NULL, version = NULL,
     }
   )
   msg <- paste0(msg, collapse = "")
-  warning(msg, call. = FALSE, domain = NA)
+  signal(msg, call. = FALSE, domain = NA)
 }

R/exclude.R

@@ -35,20 +35,20 @@ exclude <- function(lints, exclusions = settings$exclusions, linter_names = NULL
     return(lints)
   }
 
-  df <- as.data.frame(lints)
+  lint_df <- as.data.frame(lints)
 
-  filenames <- unique(df$filename)
+  filenames <- unique(lint_df$filename)
   source_exclusions <- lapply(filenames, parse_exclusions, linter_names = linter_names, ...)
   names(source_exclusions) <- filenames
 
 
   exclusions <- normalize_exclusions(c(source_exclusions, exclusions))
   to_exclude <- vapply(
-    seq_len(nrow(df)),
+    seq_len(nrow(lint_df)),
     function(i) {
-      file <- df$filename[i]
-      file %in% names(exclusions) &&
-        is_excluded(df$line_number[i], df$linter[i], exclusions[[file]])
+      filename <- lint_df$filename[i]
+      filename %in% names(exclusions) &&
+        is_excluded(lint_df$line_number[i], lint_df$linter[i], exclusions[[filename]])
     },
     logical(1L)
   )
@@ -375,11 +375,11 @@ remove_linter_duplicates <- function(x) {
 
     if (length(unique_linters) < length(ex)) {
       ex <- lapply(unique_linters, function(linter) {
-        lines <- unlist(ex[names2(ex) == linter])
-        if (Inf %in% lines) {
+        excluded_lines <- unlist(ex[names2(ex) == linter])
+        if (Inf %in% excluded_lines) {
           Inf
         } else {
-          lines
+          excluded_lines
         }
       })
 

R/expect_lint.R

@@ -99,19 +99,19 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") {
             itr, field, deparse(value), deparse(check)
           )
           # deparse ensures that NULL, list(), etc are handled gracefully
-          exp <- if (field == "message") {
+          ok <- if (field == "message") {
             re_matches(value, check)
           } else {
             isTRUE(all.equal(value, check))
           }
-          if (!is.logical(exp)) {
+          if (!is.logical(ok)) {
             stop(
               "Invalid regex result, did you mistakenly have a capture group in the regex? ",
               "Be sure to escape parenthesis with `[]`",
               call. = FALSE
             )
           }
-          testthat::expect(exp, msg)
+          testthat::expect(ok, msg)
         })
       },
       lints,

R/extract.R

@@ -93,8 +93,8 @@ get_chunk_positions <- function(pattern, lines) {
 
 filter_chunk_start_positions <- function(starts, lines) {
   # keep blocks that don't set a knitr engine (and so contain evaluated R code)
-  drop <- defines_knitr_engine(lines[starts])
-  starts[!drop]
+  drop_idx <- defines_knitr_engine(lines[starts])
+  starts[!drop_idx]
 }
 
 filter_chunk_end_positions <- function(starts, ends) {

R/ids_with_token.R

@@ -29,8 +29,11 @@
 #' @export
 ids_with_token <- function(source_expression, value, fun = `==`, source_file = NULL) {
   if (!missing(source_file)) {
-    lintr_deprecated(old = "source_file", new = "source_expression", version = "3.0.0", type = "Argument")
-    source_expression <- source_file
+    lintr_deprecated(
+      old = "source_file", new = "source_expression",
+      version = "3.0.0", type = "Argument",
+      signal = "stop"
+    )
   }
   if (!is_lint_level(source_expression, "expression")) {
     return(integer())

R/library_call_linter.R

@@ -1,46 +1,64 @@
 #' Library call linter
 #'
-#' Force library calls to all be at the top of the script.
+#' This linter covers several rules related to [library()] calls:
+#'
+#'  - Enforce such calls to all be at the top of the script.
+#'  - Block usage of argument `character.only`, in particular
+#'    for loading packages in a loop.
 #'
 #' @param allow_preamble Logical, default `TRUE`. If `FALSE`,
 #'   no code is allowed to precede the first `library()` call,
 #'   otherwise some setup code is allowed, but all `library()`
 #'   calls must follow consecutively after the first one.
 #' @examples
 #' # will produce lints
+#'
+#' code <- "library(dplyr)\nprint('test')\nlibrary(tidyr)"
+#' writeLines(code)
 #' lint(
-#'   text = "
-#'     library(dplyr)
-#'     print('test')
-#'     library(tidyr)
-#'   ",
+#'   text = code,
 #'   linters = library_call_linter()
 #' )
 #'
 #' lint(
-#'   text = "
-#'     library(dplyr)
-#'     print('test')
-#'     library(tidyr)
-#'     library(purrr)
-#'   ",
+#'   text = "library('dplyr', character.only = TRUE)",
+#'   linters = library_call_linter()
+#' )
+#'
+#' code <- paste(
+#'   "pkg <- c('dplyr', 'tibble')",
+#'   "sapply(pkg, library, character.only = TRUE)",
+#'   sep = "\n"
+#' )
+#' writeLines(code)
+#' lint(
+#'   text = code,
 #'   linters = library_call_linter()
 #' )
 #'
 #' # okay
+#' code <- "library(dplyr)\nprint('test')"
+#' writeLines(code)
 #' lint(
-#'   text = "
-#'     library(dplyr)
-#'     print('test')
-#'   ",
+#'   text = code,
 #'   linters = library_call_linter()
 #' )
 #'
+#' code <- "# comment\nlibrary(dplyr)"
 #' lint(
-#'   text = "
-#'     # comment
-#'     library(dplyr)
-#'   ",
+#'   text = code,
+#'   linters = library_call_linter()
+#' )
+#'
+#' code <- paste(
+#'   "foo <- function(pkg) {",
+#'   "  sapply(pkg, library, character.only = TRUE)",
+#'   "}",
+#'   sep = "\n"
+#' )
+#' writeLines(code)
+#' lint(
+#'   text = code,
 #'   linters = library_call_linter()
 #' )
 #'
@@ -56,30 +74,93 @@ library_call_linter <- function(allow_preamble = TRUE) {
       glue("@line1 > //SYMBOL_FUNCTION_CALL[{ attach_call }][1]/@line1")
     )
   }
-  xpath <- glue("
+  upfront_call_xpath <- glue("
     //SYMBOL_FUNCTION_CALL[{ attach_call }][last()]
       /preceding::expr
       /SYMBOL_FUNCTION_CALL[{ unsuppressed_call }][last()]
       /following::expr[SYMBOL_FUNCTION_CALL[{ attach_call }]]
       /parent::expr
   ")
 
+  # STR_CONST: block library|require("..."), i.e., supplying a string literal
+  # ancestor::expr[FUNCTION]: Skip usages inside functions a la {knitr}
+  char_only_direct_xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'library' or text() = 'require']
+    /parent::expr
+    /parent::expr[
+      expr[2][STR_CONST]
+      or (
+        SYMBOL_SUB[text() = 'character.only']
+        and not(ancestor::expr[FUNCTION])
+      )
+    ]
+  "
+
+  bad_indirect_funs <- c("do.call", "lapply", "sapply", "map", "walk")
+  call_symbol_cond <- "
+  SYMBOL[text() = 'library' or text() = 'require']
+    or STR_CONST[text() = '\"library\"' or text() = '\"require\"']
+  "
+  char_only_indirect_xpath <- glue("
+  //SYMBOL_FUNCTION_CALL[{ xp_text_in_table(bad_indirect_funs) }]
+    /parent::expr
+    /parent::expr[
+      not(ancestor::expr[FUNCTION])
+      and expr[{ call_symbol_cond }]
+    ]
+  ")
+  call_symbol_path <- glue("./expr[{call_symbol_cond}]")
+
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "file")) {
       return(list())
     }
 
     xml <- source_expression$full_xml_parsed_content
 
-    bad_expr <- xml_find_all(xml, xpath)
+    upfront_call_expr <- xml_find_all(xml, upfront_call_xpath)
 
-    call_name <- xp_call_name(bad_expr)
+    call_name <- xp_call_name(upfront_call_expr)
 
-    xml_nodes_to_lints(
-      bad_expr,
+    upfront_call_lints <- xml_nodes_to_lints(
+      upfront_call_expr,
       source_expression = source_expression,
       lint_message = sprintf("Move all %s calls to the top of the script.", call_name),
       type = "warning"
     )
+
+    char_only_direct_expr <- xml_find_all(xml, char_only_direct_xpath)
+    char_only_direct_calls <- xp_call_name(char_only_direct_expr)
+    character_only <-
+      xml_find_first(char_only_direct_expr, "./SYMBOL_SUB[text() = 'character.only']")
+    char_only_direct_msg_fmt <- ifelse(
+      is.na(character_only),
+      "Use symbols, not strings, in %s calls.",
+      "Use symbols in %s calls to avoid the need for 'character.only'."
+    )
+    char_only_direct_msg <-
+      sprintf(as.character(char_only_direct_msg_fmt), char_only_direct_calls)
+    char_only_direct_lints <- xml_nodes_to_lints(
+      char_only_direct_expr,
+      source_expression = source_expression,
+      lint_message = char_only_direct_msg,
+      type = "warning"
+    )
+
+    char_only_indirect_expr <- xml_find_all(xml, char_only_indirect_xpath)
+    char_only_indirect_lib_calls <- get_r_string(char_only_indirect_expr, call_symbol_path)
+    char_only_indirect_loop_calls <- xp_call_name(char_only_indirect_expr)
+    char_only_indirect_msg <- sprintf(
+      "Call %s() directly, not vectorized with %s().",
+      char_only_indirect_lib_calls, char_only_indirect_loop_calls
+    )
+    char_only_indirect_lints <- xml_nodes_to_lints(
+      char_only_indirect_expr,
+      source_expression = source_expression,
+      lint_message = char_only_indirect_msg,
+      type = "warning"
+    )
+
+    c(upfront_call_lints, char_only_direct_lints, char_only_indirect_lints)
   })
 }