Merge branch 'main' into check-random-order

.github/workflows/R-CMD-check.yaml

@@ -43,7 +43,7 @@ jobs:
           - {os: ubuntu-latest,  r: 'oldrel-2'}
           - {os: ubuntu-latest,  r: 'oldrel-3'}
           - {os: ubuntu-latest,  r: 'oldrel-4'}
-          - {os: ubuntu-latest,  r: '3.5'}
+          - {os: ubuntu-latest,  r: '3.6'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

.lintr

@@ -31,7 +31,7 @@ linters: linters_with_defaults(
     sort_linter(),
     sprintf_linter(),
     strings_as_factors_linter(),
-    undesirable_function_linter(c(Sys.setenv = NA_character_)),
+    undesirable_function_linter(c(Sys.setenv = NA_character_, mapply = NA_character_, structure = NA_character_)),
     unnecessary_nested_if_linter(),
     unnecessary_lambda_linter(),
     unnecessary_concatenation_linter(allow_single_expression = FALSE),

R/backport_linter.R

@@ -4,7 +4,7 @@
 #'
 #' @param r_version Minimum R version to test for compatibility
 #' @param except Character vector of functions to be excluded from linting.
-#'  Use this to list explicitly defined backports, e.g. those imported from the {backports} package or manually
+#'  Use this to list explicitly defined backports, e.g. those imported from the `{backports}` package or manually
 #'  defined in your package.
 #'
 #' @examples

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

R/condition_message_linter.R

@@ -1,12 +1,13 @@
 #' Block usage of `paste()` and `paste0()` with messaging functions using `...`
 #'
+#' @description
 #' This linter discourages combining condition functions like [stop()] with string concatenation
-#' functions [paste()] and [paste0()]. This is because
+#'   functions [paste()] and [paste0()]. This is because
 #'
 #'  - `stop(paste0(...))` is redundant as it is exactly equivalent to `stop(...)`
 #'  - `stop(paste(...))` is similarly equivalent to `stop(...)` with separators (see examples)
 #'
-#'   The same applies to the other default condition functions as well, i.e., [warning()], [message()],
+#' The same applies to the other default condition functions as well, i.e., [warning()], [message()],
 #'   and [packageStartupMessage()].
 #'
 #' @examples

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)

R/exclude.R

@@ -10,18 +10,25 @@
 #'   "@details",
 #'   "Exclusions can be specified in three different ways.",
 #'   "",
-#'   "1. single line in the source file. default: `# nolint`, possibly followed by a listing of linters to exclude.",
+#'   "1. Single line in the source file. default: `# nolint`, possibly followed by a listing of linters to exclude.",
 #'   "   If the listing is missing, all linters are excluded on that line. The default listing format is",
 #'   paste(
 #'     "   `#",
 #'     "nolint: linter_name, linter2_name.`. There may not be anything between the colon and the line exclusion tag"
 #'   ),
 #'   "   and the listing must be terminated with a full stop (`.`) for the linter list to be respected.",
-#'   "2. line range in the source file. default: `# nolint start`, `# nolint end`. `# nolint start` accepts linter",
+#'   "2. Line range in the source file. default: `# nolint start`, `# nolint end`. `# nolint start` accepts linter",
 #'   "   lists in the same form as `# nolint`.",
-#'   "3. exclusions parameter, a named list of files with named lists of linters and lines to exclude them on, a named",
-#'   "   list of the files and lines to exclude, or just the filenames if you want to exclude the entire file, or the",
-#'   "   directory names if you want to exclude all files in a directory."
+#'   "3. Exclusions parameter, a list with named and/or unnamed entries. ",
+#'   "   Outer elements have the following characteristics:",
+#'   "   1. Unnamed elements specify filenames or directories.",
+#'   "   2. Named elements are a vector or list of line numbers, with `Inf` indicating 'all lines'.",
+#'   "      The name gives a path relative to the config.",
+#'   "      1. Unnamed elements denote exclusion of all linters in the given path or directory.",
+#'   "      2. Named elements, where the name specifies a linter, denote exclusion for that linter.",
+#'   "   For convenience, a vector can be used in place of a list whenever it would not introduce ambiguity, e.g.",
+#'   "   a character vector of files to exclude or a vector of lines to exclude.",
+#'   NULL
 #' )
 exclude <- function(lints, exclusions = settings$exclusions, linter_names = NULL, ...) {
   if (length(lints) <= 0L) {

R/extract.R

@@ -82,10 +82,12 @@ get_chunk_positions <- function(pattern, lines) {
   #   set the initial column to the leftmost one within each chunk (including the start+end gates). See tests.
   # use 'ws_re' to make clear that we're matching knitr's definition of initial whitespace.
   ws_re <- sub("```.*", "", pattern$chunk.begin)
-  indents <- mapply(
-    function(start, end) min(vapply(gregexpr(ws_re, lines[start:end], perl = TRUE), attr, integer(1L), "match.length")),
-    starts, ends
-  )
+  extract_min_chunk_indent <- function(start, end) {
+    indents <- attr(regexpr(ws_re, lines[start:end], perl = TRUE), "match.length")
+    min(indents)
+  }
+  # NB: min() guarantees length(indents) == length(starts)
+  indents <- unlist(Map(extract_min_chunk_indent, starts, ends))
   list(starts = starts, ends = ends, indents = indents)
 }
 

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
   ]"

R/if_not_else_linter.R

@@ -23,6 +23,11 @@
 #' )
 #'
 #' lint(
+#'   text = "if (!A) x else if (!B) y else z",
+#'   linters = if_not_else_linter()
+#' )
+#'
+#' lint(
 #'   text = "ifelse(!is_treatment, x, y)",
 #'   linters = if_not_else_linter()
 #' )
@@ -39,6 +44,11 @@
 #' )
 #'
 #' lint(
+#'   text = "if (!A) x else if (B) z else y",
+#'   linters = if_not_else_linter()
+#' )
+#'
+#' lint(
 #'   text = "ifelse(is_treatment, y, x)",
 #'   linters = if_not_else_linter()
 #' )

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"
 
@@ -225,7 +225,8 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
 
     indent_levels <- re_matches(
       source_expression$file_lines,
-      rex(start, any_spaces), locations = TRUE
+      rex(start, any_spaces),
+      locations = TRUE
     )[, "end"]
     expected_indent_levels <- integer(length(indent_levels))
     is_hanging <- logical(length(indent_levels))
@@ -341,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]
   "
 
@@ -351,8 +352,7 @@ build_indentation_style_tidy <- function() {
           @line1 = following-sibling::{paren_tokens_right}/{xp_inner_expr}[position() = 1]/@line1
         ]/following-sibling::{paren_tokens_right}[
           @line1 > {xp_inner_expr}[position() = last() - 1]/@line2
-        ]"
-    ),
+        ]"),
     collapse = " | "
   )
 

R/keyword_quote_linter.R

@@ -39,7 +39,7 @@
 #' )
 #'
 #' lint(
-#'   text = 'my_list$`a b`',
+#'   text = "my_list$`a b`",
 #'   linters = keyword_quote_linter()
 #' )
 #'

R/line_length_linter.R

@@ -34,7 +34,7 @@ line_length_linter <- function(length = 80L) {
     line_lengths <- nchar(source_expression$file_lines)
     long_lines <- which(line_lengths > length)
 
-    mapply(
+    Map(
       function(long_line, line_length) {
         Lint(
           filename = source_expression$filename,
@@ -46,8 +46,8 @@ line_length_linter <- function(length = 80L) {
           ranges = list(c(1L, line_length))
         )
       },
-      long_lines, line_lengths[long_lines],
-      SIMPLIFY = FALSE
+      long_lines,
+      line_lengths[long_lines]
     )
   })
 }

R/lint.R

@@ -10,18 +10,19 @@
 #' Note that if files contain unparseable encoding problems, only the encoding problem will be linted to avoid
 #' unintelligible error messages from other linters.
 #'
-#' @param filename either the filename for a file to lint, or a character string of inline R code for linting.
-#' The latter (inline data) applies whenever `filename` has a newline character (\\n).
-#' @param linters a named list of linter functions to apply. See [linters] for a full list of default and available
-#' linters.
+#' @param filename Either the filename for a file to lint, or a character string of inline R code for linting.
+#'   The latter (inline data) applies whenever `filename` has a newline character (\\n).
+#' @param linters A named list of linter functions to apply. See [linters] for a full list of default and available
+#'   linters.
 #' @param ... Provide additional arguments to be passed to:
-#' - [exclude()] (in case of `lint()`; e.g. `lints` or `exclusions`)
-#' - [lint()] (in case of `lint_dir()` and `lint_package()`; e.g. `linters` or `cache`)
-#' @param cache given a logical, toggle caching of lint results. If passed a character string, store the cache in this
-#' directory.
-#' @param parse_settings whether to try and parse the settings.
+#'   - [exclude()] (in case of `lint()`; e.g. `lints` or `exclusions`)
+#'   - [lint()] (in case of `lint_dir()` and `lint_package()`; e.g. `linters` or `cache`)
+#' @param cache When logical, toggle caching of lint results. I1f passed a character string, store the cache in this
+#'   directory.
+#' @param parse_settings Logical, default `TRUE`. Whether to try and parse the settings;
+#'   otherwise, the [default_settings()] are used.
 #' @param text Optional argument for supplying a string or lines directly, e.g. if the file is already in memory or
-#' linting is being done ad hoc.
+#'   linting is being done ad hoc.
 #'
 #' @aliases lint_file
 # TODO(next release after 3.0.0): remove the alias
@@ -58,7 +59,7 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings =
 
   if (isTRUE(parse_settings)) {
     read_settings(filename)
-    on.exit(clear_settings, add = TRUE)
+    on.exit(reset_settings(), add = TRUE)
   }
 
   linters <- define_linters(linters)
@@ -145,7 +146,7 @@ lint_dir <- function(path = ".", ...,
 
   if (isTRUE(parse_settings)) {
     read_settings(path)
-    on.exit(clear_settings, add = TRUE)
+    on.exit(reset_settings(), add = TRUE)
 
     exclusions <- c(exclusions, settings$exclusions)
   }
@@ -170,6 +171,12 @@ lint_dir <- function(path = ".", ...,
   # Remove fully ignored files to avoid reading & parsing
   files <- drop_excluded(files, exclusions)
 
+  if (length(files) == 0L) {
+    lints <- list()
+    class(lints) <- "lints"
+    return(lints)
+  }
+
   pb <- if (isTRUE(show_progress)) {
     txtProgressBar(max = length(files), style = 3L)
   }
@@ -249,7 +256,7 @@ lint_package <- function(path = ".", ...,
 
   if (parse_settings) {
     read_settings(pkg_path)
-    on.exit(clear_settings, add = TRUE)
+    on.exit(reset_settings(), add = TRUE)
   }
 
   exclusions <- normalize_exclusions(
@@ -568,64 +575,7 @@ sarif_output <- function(lints, filename = "lintr_results.sarif") {
 
   # setup template
   sarif <- jsonlite::fromJSON(
-    '{
-      "$schema": "https://schemastore.azurewebsites.net/schemas/json/sarif-2.1.0-rtm.5.json",
-      "version": "2.1.0",
-      "runs": [
-        {
-          "tool": {
-            "driver": {
-              "name": "lintr",
-              "informationUri": "https://lintr.r-lib.org/",
-              "version": "2.0.1",
-              "rules": [
-                {
-                  "id": "trailing_whitespace_linter",
-                  "fullDescription": {
-                    "text": "Trailing whitespace is superfluous."
-                  },
-                  "defaultConfiguration": {
-                    "level": "note"
-                  }
-                }
-              ]
-            }
-          },
-          "results": [
-            {
-              "ruleId": "trailing_whitespace_linter",
-              "ruleIndex": 0,
-              "message": {
-                "text": "Trailing blank lines are superfluous."
-              },
-              "locations": [
-                {
-                  "physicalLocation": {
-                    "artifactLocation": {
-                      "uri": "TestFileFolder/hello.r",
-                      "uriBaseId": "ROOTPATH"
-                    },
-                    "region": {
-                      "startLine": 2,
-                      "startColumn": 22,
-                      "snippet": {
-                        "text": "print(Hello World!) "
-                      }
-                    }
-                  }
-                }
-              ]
-            }
-          ],
-          "columnKind": "utf16CodeUnits",
-          "originalUriBaseIds": {
-            "ROOTPATH": {
-              "uri": "file:///C:/repos/repototest/"
-            }
-          }
-        }
-      ]
-    }',
+    system.file("extdata", "sarif-template.json", package = "lintr"),
     simplifyVector = TRUE,
     simplifyDataFrame = FALSE,
     simplifyMatrix = FALSE

R/matrix_apply_linter.R

@@ -30,7 +30,6 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 matrix_apply_linter <- function() {
-
   # mean() and sum() have very different signatures so we treat them separately.
   # sum() takes values to sum over via ..., has just one extra argument and is not a generic
   # mean() is a generic, takes values to average via a single argument, and can have extra arguments
@@ -73,7 +72,7 @@ matrix_apply_linter <- function() {
 
   # This doesn't handle the case when MARGIN and FUN are named and in a different position
   # but this should be relatively rate
-  var_xpath  <- "expr[position() = 2]"
+  var_xpath <- "expr[position() = 2]"
   margin_xpath <- "expr[position() = 3]"
   fun_xpath <- "expr[position() = 4]"
 
@@ -108,7 +107,6 @@ matrix_apply_linter <- function() {
 }
 
 craft_colsums_rowsums_msg <- function(var, margin, fun, narm_val) {
-
   if (is.na(xml_find_first(margin, "OP-COLON"))) {
     l1 <- xml_text(margin)
     l2 <- NULL

R/methods.R

@@ -74,11 +74,11 @@ format.lints <- function(x, ...) {
 
 #' @export
 print.lints <- function(x, ...) {
-  use_rstudio_source_markers <- getOption("lintr.rstudio_source_markers", TRUE) &&
+  use_rstudio_source_markers <- lintr_option("rstudio_source_markers", TRUE) &&
     requireNamespace("rstudioapi", quietly = TRUE) &&
     rstudioapi::hasFun("sourceMarkers")
 
-  github_annotation_project_dir <- getOption("lintr.github_annotation_project_dir", "")
+  github_annotation_project_dir <- lintr_option("github_annotation_project_dir", "")
 
   if (length(x) > 0L) {
     inline_data <- x[[1L]][["filename"]] == "<text>"