diff --git a/.dev/compare_branches.R b/.dev/compare_branches.R index b1c5ae927..de6e0d40e 100755 --- a/.dev/compare_branches.R +++ b/.dev/compare_branches.R @@ -344,6 +344,9 @@ get_linter_from_name <- function(linter_name) { # did not make it into the release? if (linter_name == "line_length_linter" && !is.integer(formals(linter_name)$length)) { eval(call(linter_name, 80L)) + } else if (endsWith(linter_name, ")")) { + # allow custom parameters + eval(parse(text = linter_name)) } else { eval(call(linter_name)) }, diff --git a/DESCRIPTION b/DESCRIPTION index ea8c75ed1..6d9383edc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -107,6 +107,7 @@ Collate: 'ids_with_token.R' 'ifelse_censor_linter.R' 'implicit_integer_linter.R' + 'indentation_linter.R' 'infix_spaces_linter.R' 'inner_combine_linter.R' 'is_lint_level.R' diff --git a/NAMESPACE b/NAMESPACE index ec64a54da..ddfa8af13 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -67,6 +67,7 @@ export(get_source_expressions) export(ids_with_token) export(ifelse_censor_linter) export(implicit_integer_linter) +export(indentation_linter) export(infix_spaces_linter) export(inner_combine_linter) export(is_lint_level) diff --git a/NEWS.md b/NEWS.md index 5b3cc8660..954638e72 100644 --- a/NEWS.md +++ b/NEWS.md @@ -29,6 +29,8 @@ the style guide on handling this case awaits clarification: https://github.com/tidyverse/style/issues/191. (#1346, @MichaelChirico) +* The new `indentation_linter()` is part of the default linters. See "New linters" for more details. + ## New and improved features * New `get_r_string()` helper to get the R-equivalent value of a string, especially useful for R-4-style raw strings. @@ -93,6 +95,9 @@ * `routine_registration_linter()` for identifying native routines that don't use registration (`useDynLib` in the `NAMESPACE`; @MichaelChirico) +* `indentation_linter()` for checking that the indentation conforms to 2-space Tidyverse-style (@AshesITR and @dgkf, #1411). + + ## Notes * `lint()` continues to support Rmarkdown documents. For users of custom .Rmd engines, e.g. @@ -164,6 +169,7 @@ * `get_source_expressions()` no longer fails on R files that match a knitr pattern (#743, #879, #1406, @AshesITR). * Parse error lints now appear with the linter name `"error"` instead of `NA` (#1405, @AshesITR). Also, linting no longer runs if the `source_expressions` contain invalid string data that would cause error messages + in other linters. in other linters. * Prevent `lint()` from hanging on Rmd files with some syntax errors (#1443, @MichaelChirico). * `get_source_expressions()` no longer omits trailing non-code lines from knitr files (#1400, #1415, @AshesITR). diff --git a/R/backport_linter.R b/R/backport_linter.R index 7ebc44dde..3aeb86a43 100644 --- a/R/backport_linter.R +++ b/R/backport_linter.R @@ -81,10 +81,14 @@ backport_linter <- function(r_version = getRversion(), except = character()) { } normalize_r_version <- function(r_version) { - if (is.character(r_version) && - re_matches(r_version, rex(start, "release" %or% + rx_release_spec <- rex( + start, + "release" %or% list("oldrel", maybe("-", digits)) %or% - "devel", end))) { + "devel", + end + ) + if (is.character(r_version) && re_matches(r_version, rx_release_spec)) { # Support devel, release, oldrel, oldrel-1, ... if (r_version == "oldrel") { r_version <- "oldrel-1" diff --git a/R/extract.R b/R/extract.R index 18af42b4e..095b60b3b 100644 --- a/R/extract.R +++ b/R/extract.R @@ -132,15 +132,8 @@ replace_prefix <- function(lines, prefix_pattern) { m <- gregexpr(prefix_pattern, lines) non_na <- !is.na(m) - blanks <- function(n) { - vapply(Map(rep.int, rep.int(" ", length(n)), n, USE.NAMES = FALSE), - paste, "", - collapse = "" - ) - } - - regmatches(lines[non_na], m[non_na]) <- - Map(blanks, lapply(regmatches(lines[non_na], m[non_na]), nchar)) + prefix_lengths <- lapply(regmatches(lines[non_na], m[non_na]), nchar) + regmatches(lines[non_na], m[non_na]) <- lapply(prefix_lengths, strrep, x = " ") lines } diff --git a/R/get_source_expressions.R b/R/get_source_expressions.R index 8224aa12d..6abcf5c13 100644 --- a/R/get_source_expressions.R +++ b/R/get_source_expressions.R @@ -110,15 +110,14 @@ get_source_expressions <- function(filename, lines = NULL) { } # add global expression - expressions[[length(expressions) + 1L]] <- - list( - filename = filename, - file_lines = source_expression$lines, - content = source_expression$lines, - full_parsed_content = parsed_content, - full_xml_parsed_content = xml_parsed_content, - terminal_newline = terminal_newline - ) + expressions[[length(expressions) + 1L]] <- list( + filename = filename, + file_lines = source_expression$lines, + content = source_expression$lines, + full_parsed_content = parsed_content, + full_xml_parsed_content = xml_parsed_content, + terminal_newline = terminal_newline + ) } list(expressions = expressions, error = e, lines = source_expression$lines) @@ -355,7 +354,8 @@ lint_parse_error_nonstandard <- function(e, source_expression) { if (nrow(line_location) == 0L) { if (grepl("attempt to use zero-length variable name", e$message, fixed = TRUE)) { # empty symbol: ``, ``(), ''(), ""(), fun(''=42), fun(""=42), fun(a=1,""=42) - loc <- re_matches(source_expression$content, + loc <- re_matches( + source_expression$content, rex( "``" %or% list(or("''", '""'), any_spaces, "(") %or% diff --git a/R/indentation_linter.R b/R/indentation_linter.R new file mode 100644 index 000000000..3d235e321 --- /dev/null +++ b/R/indentation_linter.R @@ -0,0 +1,231 @@ +#' Check that indentation is consistent +#' +#' @param indent Number of spaces, that a code block should be indented by relative to its parent code block. +#' Used for multi-line code blocks (`{ ... }`), function calls (`( ... )`) and extractions (`[ ... ]`, `[[ ... ]]`). +#' Defaults to 2. +#' @param hanging_indent_style Indentation style for multi-line function calls with arguments in their first line. +#' Defaults to tidyverse style, i.e. a block indent is used if the function call terminates with `)` on a separate +#' line and a hanging indent if not. +#' Note that function multi-line function calls without arguments on their first line will always be expected to have +#' block-indented arguments. +#' +#' ```r +#' # complies to any style +#' map( +#' x, +#' f, +#' additional_arg = 42 +#' ) +#' +#' # complies to "tidy" and "never" +#' map(x, f, +#' additional_arg = 42 +#' ) +#' +#' # complies to "always" +#' map(x, f, +#' additional_arg = 42 +#' ) +#' +#' # complies to "tidy" and "always" +#' map(x, f, +#' additional_arg = 42) +#' +#' # complies to "never" +#' map(x, f, +#' additional_arg = 42) +#' ``` +#' +#' @examples +#' # will produce lints +#' lint( +#' text = "if (TRUE) {\n1 + 1\n}", +#' linters = indentation_linter() +#' ) +#' +#' lint( +#' text = "if (TRUE) {\n 1 + 1\n}", +#' linters = indentation_linter() +#' ) +#' +#' lint( +#' text = "map(x, f,\n additional_arg = 42\n)", +#' linters = indentation_linter(hanging_indent_style = "always") +#' ) +#' +#' lint( +#' text = "map(x, f,\n additional_arg = 42)", +#' linters = indentation_linter(hanging_indent_style = "never") +#' ) +#' +#' # okay +#' lint( +#' text = "map(x, f,\n additional_arg = 42\n)", +#' linters = indentation_linter() +#' ) +#' +#' lint( +#' text = "if (TRUE) {\n 1 + 1\n}", +#' linters = indentation_linter(indent = 4) +#' ) +#' +#' @evalRd rd_tags("indentation_linter") +#' @seealso [linters] for a complete list of linters available in lintr. \cr +#' +#' +#' @export +indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "always", "never")) { + paren_tokens_left <- c("OP-LEFT-BRACE", "OP-LEFT-PAREN", "OP-LEFT-BRACKET", "LBB") + 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") + + xp_last_on_line <- "@line1 != following-sibling::*[not(self::COMMENT)][1]/@line1" + + hanging_indent_style <- match.arg(hanging_indent_style) + + if (hanging_indent_style == "tidy") { + xp_is_not_hanging <- paste( + c( + glue::glue( + "self::{paren_tokens_left}/following-sibling::{paren_tokens_right}[@line1 > preceding-sibling::*[1]/@line2]" + ), + glue::glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))} and {xp_last_on_line}]") + ), + collapse = " | " + ) + } else if (hanging_indent_style == "always") { + xp_is_not_hanging <- glue::glue("self::*[{xp_last_on_line}]") + } # "never" makes no use of xp_is_not_hanging, so no definition is necessary + + xp_block_ends <- paste0( + "number(", + paste( + c( + glue::glue("self::{paren_tokens_left}/following-sibling::{paren_tokens_right}/preceding-sibling::*[1]/@line2"), + glue::glue("self::*[{xp_and(paste0('not(self::', paren_tokens_left, ')'))}] + /following-sibling::SYMBOL_FUNCTION_CALL/parent::expr/following-sibling::expr[1]/@line2"), + glue::glue("self::*[ + {xp_and(paste0('not(self::', paren_tokens_left, ')'))} and + not(following-sibling::SYMBOL_FUNCTION_CALL) + ]/following-sibling::*[1]/@line2") + ), + collapse = " | " + ), + ")" + ) + + xp_indent_changes <- paste( + c( + glue::glue("//{paren_tokens_left}[not(@line1 = following-sibling::expr[ + @line2 > @line1 and + ({xp_or(paste0('descendant::', paren_tokens_left, '[', xp_last_on_line, ']'))}) + ]/@line1)]"), + glue::glue("//{infix_tokens}[{xp_last_on_line}]"), + glue::glue("//{no_paren_keywords}[{xp_last_on_line}]"), + glue::glue("//{keyword_tokens}/following-sibling::OP-RIGHT-PAREN[ + {xp_last_on_line} and + not(following-sibling::expr[1][OP-LEFT-BRACE]) + ]") + ), + collapse = " | " + ) + + xp_multiline_string <- "//STR_CONST[@line1 < @line2]" + + Linter(function(source_expression) { + # must run on file level because a line can contain multiple expressions, losing indentation information, e.g. + # + #> fun( + # a) # comment + # + # will have "# comment" as a separate expression + if (!is_lint_level(source_expression, "file")) { + return(list()) + } + + xml <- source_expression$full_xml_parsed_content + # Indentation increases by 1 for: + # - { } blocks that span multiple lines + # - ( ), [ ], or [[ ]] calls that span multiple lines + # + if a token follows (, a hanging indent is required until ) + # + if there is no token following ( on the same line, a block indent is required until ) + # - binary operators where the second arguments starts on a new line + + indent_levels <- rex::re_matches( + source_expression$file_lines, + rex::rex(start, any_spaces), locations = TRUE + )[, "end"] + expected_indent_levels <- integer(length(indent_levels)) + is_hanging <- logical(length(indent_levels)) + + indent_changes <- xml2::xml_find_all(xml, xp_indent_changes) + for (change in indent_changes) { + if (hanging_indent_style != "never") { + change_starts_hanging <- length(xml2::xml_find_first(change, xp_is_not_hanging)) == 0L + } else { + change_starts_hanging <- FALSE + } + change_begin <- as.integer(xml2::xml_attr(change, "line1")) + 1L + change_end <- xml2::xml_find_num(change, xp_block_ends) + if (change_begin <= change_end) { + to_indent <- seq(from = change_begin, to = change_end) + if (change_starts_hanging) { + expected_indent_levels[to_indent] <- as.integer(xml2::xml_attr(change, "col2")) + is_hanging[to_indent] <- TRUE + } else { + expected_indent_levels[to_indent] <- expected_indent_levels[to_indent] + indent + is_hanging[to_indent] <- FALSE + } + } + } + + in_str_const <- logical(length(indent_levels)) + multiline_strings <- xml2::xml_find_all(xml, xp_multiline_string) + for (string in multiline_strings) { + is_in_str <- seq( + from = as.integer(xml2::xml_attr(string, "line1")) + 1L, + to = as.integer(xml2::xml_attr(string, "line2")) + ) + in_str_const[is_in_str] <- TRUE + } + + # Only lint non-empty lines if the indentation level doesn't match. + bad_lines <- which(indent_levels != expected_indent_levels & + nzchar(trimws(source_expression$file_lines)) & + !in_str_const) + if (length(bad_lines)) { + # Suppress consecutive lints with the same indentation difference, to not generate an excessive number of lints + is_consecutive_lint <- c(FALSE, diff(bad_lines) == 1L) + indent_diff <- expected_indent_levels[bad_lines] - indent_levels[bad_lines] + is_same_diff <- c(FALSE, diff(indent_diff) == 0L) + + bad_lines <- bad_lines[!(is_consecutive_lint & is_same_diff)] + + lint_messages <- sprintf( + "%s should be %d spaces but is %d spaces.", + ifelse(is_hanging[bad_lines], "Hanging indent", "Indentation"), + expected_indent_levels[bad_lines], + indent_levels[bad_lines] + ) + lint_lines <- unname(as.integer(names(source_expression$file_lines)[bad_lines])) + lint_ranges <- cbind( + pmin(expected_indent_levels[bad_lines] + 1L, indent_levels[bad_lines]), + pmax(expected_indent_levels[bad_lines], indent_levels[bad_lines]) + ) + Map( + Lint, + filename = source_expression$filename, + line_number = lint_lines, + column_number = indent_levels[bad_lines], + type = "style", + message = lint_messages, + line = unname(source_expression$file_lines[bad_lines]), + ranges = apply(lint_ranges, 1L, list, simplify = FALSE) + ) + } else { + list() + } + }) +} diff --git a/R/lint.R b/R/lint.R index 2bab70ad2..78e6c2652 100644 --- a/R/lint.R +++ b/R/lint.R @@ -543,7 +543,8 @@ checkstyle_output <- function(lints, filename = "lintr_results.xml") { style = "info", x$type ), - message = x$message) + message = x$message + ) }) }) @@ -665,8 +666,7 @@ sarif_output <- function(lints, filename = "lintr_results.sarif") { rule_index_exists <- which(sapply(sarif$runs[[1L]]$tool$driver$rules, function(x) x$id == lint$linter)) - if (length(rule_index_exists) == 0L || - is.na(rule_index_exists[1L])) { + if (length(rule_index_exists) == 0L || is.na(rule_index_exists[1L])) { rule_index_exists <- 0L } } diff --git a/R/make_linter_from_regex.R b/R/make_linter_from_regex.R index fdf507c9c..ed98441a3 100644 --- a/R/make_linter_from_regex.R +++ b/R/make_linter_from_regex.R @@ -28,8 +28,10 @@ make_linter_from_regex <- function(regex, lapply( split(line_matches, seq_len(nrow(line_matches))), function(.match) { - if (is.na(.match[["start"]]) || - .in_ignorable_position(source_expression, line_number, .match)) { + if ( + is.na(.match[["start"]]) || + .in_ignorable_position(source_expression, line_number, .match) + ) { return() } start <- .match[["start"]] diff --git a/R/zzz.R b/R/zzz.R index 5726af512..1e6be7915 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -20,6 +20,7 @@ default_linters <- modify_defaults( cyclocomp_linter(), equals_na_linter(), function_left_parentheses_linter(), + indentation_linter(), infix_spaces_linter(), line_length_linter(), no_tab_linter(), diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 333075e5c..1a1997388 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -35,6 +35,7 @@ function_left_parentheses_linter,style readability default function_return_linter,readability best_practices ifelse_censor_linter,best_practices efficiency implicit_integer_linter,style consistency best_practices configurable +indentation_linter,style readability default configurable infix_spaces_linter,style readability default configurable inner_combine_linter,efficiency consistency readability is_numeric_linter,readability best_practices consistency diff --git a/man/configurable_linters.Rd b/man/configurable_linters.Rd index 5b001499e..bbd01d6f5 100644 --- a/man/configurable_linters.Rd +++ b/man/configurable_linters.Rd @@ -21,6 +21,7 @@ The following linters are tagged with 'configurable': \item{\code{\link{cyclocomp_linter}}} \item{\code{\link{duplicate_argument_linter}}} \item{\code{\link{implicit_integer_linter}}} +\item{\code{\link{indentation_linter}}} \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{line_length_linter}}} \item{\code{\link{missing_argument_linter}}} diff --git a/man/default_linters.Rd b/man/default_linters.Rd index 1323992e6..60ad47055 100644 --- a/man/default_linters.Rd +++ b/man/default_linters.Rd @@ -5,7 +5,7 @@ \alias{default_linters} \title{Default linters} \format{ -An object of class \code{list} of length 24. +An object of class \code{list} of length 25. } \usage{ default_linters @@ -32,6 +32,7 @@ The following linters are tagged with 'default': \item{\code{\link{cyclocomp_linter}}} \item{\code{\link{equals_na_linter}}} \item{\code{\link{function_left_parentheses_linter}}} +\item{\code{\link{indentation_linter}}} \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{line_length_linter}}} \item{\code{\link{no_tab_linter}}} diff --git a/man/indentation_linter.Rd b/man/indentation_linter.Rd new file mode 100644 index 000000000..32a58e087 --- /dev/null +++ b/man/indentation_linter.Rd @@ -0,0 +1,92 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/indentation_linter.R +\name{indentation_linter} +\alias{indentation_linter} +\title{Check that indentation is consistent} +\usage{ +indentation_linter( + indent = 2L, + hanging_indent_style = c("tidy", "always", "never") +) +} +\arguments{ +\item{indent}{Number of spaces, that a code block should be indented by relative to its parent code block. +Used for multi-line code blocks (\code{{ ... }}), function calls (\code{( ... )}) and extractions (\verb{[ ... ]}, \verb{[[ ... ]]}). +Defaults to 2.} + +\item{hanging_indent_style}{Indentation style for multi-line function calls with arguments in their first line. +Defaults to tidyverse style, i.e. a block indent is used if the function call terminates with \verb{)} on a separate +line and a hanging indent if not. +Note that function multi-line function calls without arguments on their first line will always be expected to have +block-indented arguments. + +\if{html}{\out{
}}\preformatted{# complies to any style +map( + x, + f, + additional_arg = 42 +) + +# complies to "tidy" and "never" +map(x, f, + additional_arg = 42 +) + +# complies to "always" +map(x, f, + additional_arg = 42 +) + +# complies to "tidy" and "always" +map(x, f, + additional_arg = 42) + +# complies to "never" +map(x, f, + additional_arg = 42) +}\if{html}{\out{
}}} +} +\description{ +Check that indentation is consistent +} +\examples{ +# will produce lints +lint( + text = "if (TRUE) {\n1 + 1\n}", + linters = indentation_linter() +) + +lint( + text = "if (TRUE) {\n 1 + 1\n}", + linters = indentation_linter() +) + +lint( + text = "map(x, f,\n additional_arg = 42\n)", + linters = indentation_linter(hanging_indent_style = "always") +) + +lint( + text = "map(x, f,\n additional_arg = 42)", + linters = indentation_linter(hanging_indent_style = "never") +) + +# okay +lint( + text = "map(x, f,\n additional_arg = 42\n)", + linters = indentation_linter() +) + +lint( + text = "if (TRUE) {\n 1 + 1\n}", + linters = indentation_linter(indent = 4) +) + +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. \cr +\url{https://style.tidyverse.org/syntax.html#indenting} +} +\section{Tags}{ +\link[=configurable_linters]{configurable}, \link[=default_linters]{default}, \link[=readability_linters]{readability}, \link[=style_linters]{style} +} diff --git a/man/linters.Rd b/man/linters.Rd index ae81e54b2..4f0814f4f 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -19,17 +19,17 @@ The following tags exist: \itemize{ \item{\link[=best_practices_linters]{best_practices} (47 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (7 linters)} -\item{\link[=configurable_linters]{configurable} (29 linters)} +\item{\link[=configurable_linters]{configurable} (30 linters)} \item{\link[=consistency_linters]{consistency} (18 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} -\item{\link[=default_linters]{default} (24 linters)} +\item{\link[=default_linters]{default} (25 linters)} \item{\link[=deprecated_linters]{deprecated} (4 linters)} \item{\link[=efficiency_linters]{efficiency} (21 linters)} \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} -\item{\link[=readability_linters]{readability} (46 linters)} +\item{\link[=readability_linters]{readability} (47 linters)} \item{\link[=robustness_linters]{robustness} (14 linters)} -\item{\link[=style_linters]{style} (36 linters)} +\item{\link[=style_linters]{style} (37 linters)} } } \section{Linters}{ @@ -71,6 +71,7 @@ The following linters exist: \item{\code{\link{function_return_linter}} (tags: best_practices, readability)} \item{\code{\link{ifelse_censor_linter}} (tags: best_practices, efficiency)} \item{\code{\link{implicit_integer_linter}} (tags: best_practices, configurable, consistency, style)} +\item{\code{\link{indentation_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{infix_spaces_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{inner_combine_linter}} (tags: consistency, efficiency, readability)} \item{\code{\link{is_numeric_linter}} (tags: best_practices, consistency, readability)} diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index 73f1de903..d5c7b012e 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -29,6 +29,7 @@ The following linters are tagged with 'readability': \item{\code{\link{for_loop_index_linter}}} \item{\code{\link{function_left_parentheses_linter}}} \item{\code{\link{function_return_linter}}} +\item{\code{\link{indentation_linter}}} \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{inner_combine_linter}}} \item{\code{\link{is_numeric_linter}}} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index 084c2ed3f..ee5fe65f8 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -23,6 +23,7 @@ The following linters are tagged with 'style': \item{\code{\link{function_argument_linter}}} \item{\code{\link{function_left_parentheses_linter}}} \item{\code{\link{implicit_integer_linter}}} +\item{\code{\link{indentation_linter}}} \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{line_length_linter}}} \item{\code{\link{no_tab_linter}}} diff --git a/tests/testthat/default_linter_testcode.R b/tests/testthat/default_linter_testcode.R index 99f7a3cef..4bcce2e61 100644 --- a/tests/testthat/default_linter_testcode.R +++ b/tests/testthat/default_linter_testcode.R @@ -13,6 +13,7 @@ f = function (x,y = 1){} # cyclocomp # equals_na # brace_linter +# indentation # infix_spaces # line_length # object_length @@ -22,7 +23,7 @@ f = function (x,y = 1){} # T_and_F_symbol someComplicatedFunctionWithALongCamelCaseName <- function(x) { - y <- 1 + y <- 1 if (1 > 2 && 2 > 3 && 3 > 4 && 4 > 5 && 5*10 > 6 && 5 > 6 && 6 > 7 && x == NA) {T} else F } @@ -37,6 +38,7 @@ my_metric <- function(x) # pipe_continuation # seq_linter # spaces_inside +# indentation x <- 1:10 x[ 2] 1:length(x) %>% lapply(function(x) x*2) %>% diff --git a/tests/testthat/test-implicit_integer_linter.R b/tests/testthat/test-implicit_integer_linter.R index be7dff813..cd0bebec0 100644 --- a/tests/testthat/test-implicit_integer_linter.R +++ b/tests/testthat/test-implicit_integer_linter.R @@ -4,42 +4,42 @@ local({ # Note: cases indicated by "*" are whole numbers, but don't lint because the user has # effectively declared "this is a double" much as adding '.0' is otherwise accepted. cases <- tibble::tribble( - ~num_value_str, ~should_lint, - "Inf", FALSE, - "NaN", FALSE, - "TRUE", FALSE, - "FALSE", FALSE, - "NA", FALSE, - "NA_character_", FALSE, - "2.000", FALSE, - "2.", FALSE, - "2L", FALSE, - "2.0", FALSE, - "2.1", FALSE, - "2", TRUE, - "1e3", TRUE, - "1e3L", FALSE, - "1.0e3L", FALSE, - "1.2e3", FALSE, # * ( = 1200) - "1.2e-3", FALSE, - "1e-3", FALSE, - "1e-33", FALSE, - "1.2e0", FALSE, - "0x1p+0", FALSE, # * ( = 1) - "0x1.ecp+6L", FALSE, - "0x1.ecp+6", FALSE, # * ( = 123) - "0x1.ec66666666666p+6", FALSE, - "8i", FALSE, - "8.0i", FALSE + ~num_value_str, ~should_lint, + "Inf", FALSE, + "NaN", FALSE, + "TRUE", FALSE, + "FALSE", FALSE, + "NA", FALSE, + "NA_character_", FALSE, + "2.000", FALSE, + "2.", FALSE, + "2L", FALSE, + "2.0", FALSE, + "2.1", FALSE, + "2", TRUE, + "1e3", TRUE, + "1e3L", FALSE, + "1.0e3L", FALSE, + "1.2e3", FALSE, # * ( = 1200) + "1.2e-3", FALSE, + "1e-3", FALSE, + "1e-33", FALSE, + "1.2e0", FALSE, + "0x1p+0", FALSE, # * ( = 1) + "0x1.ecp+6L", FALSE, + "0x1.ecp+6", FALSE, # * ( = 123) + "0x1.ec66666666666p+6", FALSE, + "8i", FALSE, + "8.0i", FALSE ) # for convenience of coercing these to string (since tribble doesn't support auto-conversion) int_max <- .Machine[["integer.max"]] # largest number that R can represent as an integer cases_int_max <- tibble::tribble( ~num_value_str, ~should_lint, - -int_max - 1.0, FALSE, - -int_max, TRUE, - int_max, TRUE, - int_max + 1.0, FALSE + -int_max - 1.0, FALSE, + -int_max, TRUE, + int_max, TRUE, + int_max + 1.0, FALSE ) cases_int_max$num_value_str <- as.character(cases_int_max$num_value_str) cases <- rbind(cases, cases_int_max) @@ -94,14 +94,14 @@ patrick::with_parameters_test_that( implicit_integer_linter(allow_colon = allow_colon) ), .cases = tibble::tribble( - ~left, ~right, ~n_lints, ~allow_colon, ~.test_name, - "1", "1", 2L, FALSE, "1:1, !allow_colon", - "1", "1", 0L, TRUE, "1:1, allow_colon", - "1", "1L", 1L, FALSE, "1:1L, !allow_colon", - "1", "1L", 0L, TRUE, "1:1L, allow_colon", - "1L", "1", 1L, FALSE, "1L:1, !allow_colon", - "1L", "1", 0L, TRUE, "1L:1, allow_colon", - "1L", "1L", 0L, FALSE, "1L:1L, !allow_colon", - "1L", "1L", 0L, TRUE, "1L:1L, allow_colon" + ~left, ~right, ~n_lints, ~allow_colon, ~.test_name, + "1", "1", 2L, FALSE, "1:1, !allow_colon", + "1", "1", 0L, TRUE, "1:1, allow_colon", + "1", "1L", 1L, FALSE, "1:1L, !allow_colon", + "1", "1L", 0L, TRUE, "1:1L, allow_colon", + "1L", "1", 1L, FALSE, "1L:1, !allow_colon", + "1L", "1", 0L, TRUE, "1L:1, allow_colon", + "1L", "1L", 0L, FALSE, "1L:1L, !allow_colon", + "1L", "1L", 0L, TRUE, "1L:1L, allow_colon" ) ) diff --git a/tests/testthat/test-indentation_linter.R b/tests/testthat/test-indentation_linter.R new file mode 100644 index 000000000..e57af23b4 --- /dev/null +++ b/tests/testthat/test-indentation_linter.R @@ -0,0 +1,495 @@ +test_that("indentation linter flags unindented expressions", { + linter <- indentation_linter(indent = 2L) + + expect_lint( + trim_some(" + lapply(1:10, function(i) { + i %% 2 + }) + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + lapply(1:10, function(i) { + i %% 2 # indentation is only 1 character + }) + "), + "Indentation", + linter + ) + + expect_lint( + trim_some(" + lapply(1:10, function(i) { + # indentation is only 1 character + i %% 2 + }) + "), + "Indentation", + linter + ) + + # no double-block indents even if the indentation-starting tokens are immediately next to each other + expect_lint( + trim_some(" + local({ + # no lint + }) + + local({ + # must lint + }) + "), + list(line_number = 6L, message = "Indentation"), + linter + ) + + expect_lint( + trim_some(" + lapply(1:10, function(i) { + i %% 2 + }) + "), + NULL, + indentation_linter(indent = 4L) + ) + + expect_lint( + trim_some(" + lapply(1:10, function(i) { + i %% 2 # indentation is only 2 characters + }) + "), + "Indentation", + indentation_linter(indent = 4L) + ) + + # ugly code, but still correctly indented + expect_lint( + trim_some(" + list( + 1, + 2) + "), + NULL, + linter + ) + + # comments do not trigger hanging indent rule + expect_lint( + trim_some(" + list( # comment + ok + ) + "), + NULL, + linter + ) + + # assignment triggers indent + expect_lint( + trim_some(" + a <- + expr( + 42 + ) + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (cond) + code + + if (cond) code else code2 + + if (cond) { + code + } else + code + + if (cond) { + code + } else { + code + } + "), + NULL, + linter + ) +}) + +test_that("indentation linter flags improper closing curly braces", { + linter <- indentation_linter(indent = 2L) + expect_lint( + trim_some(" + lapply(1:10, function(i) { + { + i %% 2 + } + }) + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + lapply(1:10, function(i) { + i %% 2 + } # closing curly doesn't return to parent indentation + ) + "), + "Indentation", + linter + ) +}) + +test_that("function argument indentation works in tidyverse-style", { + linter <- indentation_linter() + expect_lint( + trim_some(" + function(a = 1L, + b = 2L) { + a + b + } + "), + NULL, + linter + ) + + # anchor is correctly found with assignments as well + expect_lint( + trim_some(" + test <- function(a = 1L, + b = 2L) { + a + b + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + function(a = 1L, + b = 2L) { + a + b + } + "), + "Hanging", + linter + ) + + # This is a case for brace_linter + expect_lint( + trim_some(" + function(a = 1L, + b = 2L) + { + a + b + } + "), + NULL, + linter + ) +}) + +test_that("indentation with operators works", { + linter <- indentation_linter() + expect_lint( + trim_some(" + a %>% + b() + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + (a + b + c) / + (d + e + f) / + (g + h + i) + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + a %>% + b() + "), + "Indentation", + linter + ) + + expect_lint( + trim_some(" + a + + b() + "), + "Indentation", + linter + ) + + expect_lint( + trim_some(" + abc$ + def$ + ghi + "), + NULL, + linter + ) +}) + +test_that("indentation with bracket works", { + linter <- indentation_linter() + + expect_lint( + trim_some(" + dt[ + , col := 42L + ][ + , ok + ] + + bla[hanging, + also_ok] + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + abc[[ + 'elem' + ]] + + def[[a, + b]] + "), + NULL, + linter + ) +}) + +test_that("indentation works with control flow statements", { + linter <- indentation_linter() + + expect_lint( + trim_some(" + if (TRUE) { + do_something + } else { + do_other_thing + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + while (1 > 2) { + do_something + } + "), + "Indentation", + linter + ) + + expect_lint( + trim_some(" + if (FALSE) { + do_something + } else { + do_other_thing + } + "), + "Indentation", + linter + ) +}) + +test_that("indentation lint messages are dynamic", { + linter <- indentation_linter() + + expect_lint( + trim_some(" + local({ + # should be 2 + }) + "), + rex::rex("Indentation should be 2 spaces but is 4 spaces."), + linter + ) + + expect_lint( + trim_some(" + fun( + 3) # should be 4 + "), + rex::rex("Hanging indent should be 4 spaces but is 2 spaces."), + linter + ) +}) + +test_that("indentation within string constants is ignored", { + expect_lint( + trim_some(" + x <- ' + an indented string + ' + "), + NULL, + indentation_linter() + ) + + expect_lint( + trim_some(" + x <- ' + an indented string with 3 spaces indentation + ' + "), + NULL, + indentation_linter() + ) +}) + +test_that("combined hanging and block indent works", { + linter <- indentation_linter() + expect_lint( + trim_some(" + func(hang, and, + block( + combined + )) + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + func(ha, + func2(ab, + block( + indented + ))) + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + func(func2( + a = 42 + )) + "), + NULL, + linter + ) + + # Adapted from cli R/ansi.R L231-234 + expect_lint( + trim_some(" + stopifnot(is.character(style) && length(style) == 1 || + is_rgb_matrix(style) && ncol(style) == 1, + is.logical(bg) && length(bg) == 1, + is.numeric(colors) && length(colors) == 1) + "), + NULL, + linter + ) + + # Adapted from cli inst/scripts/up.R L26-37 + expect_lint( + trim_some(" + http_head(url, ...)$ + then(function(res) { + if (res$status_code < 300) { + cli_alert_success() + } else { + cli_alert_danger() + } + })$ + catch(error = function(err) { + e <- if (grepl('timed out', err$message)) 'timed out' else 'error' + cli_alert_danger() + }) + "), + NULL, + linter + ) +}) + +test_that("hanging_indent_stlye works", { + code_block_multi_line <- "map(x, f,\n extra_arg = 42\n)" + code_hanging_multi_line <- "map(x, f,\n extra_arg = 42\n)" + code_block_same_line <- "map(x, f,\n extra_arg = 42)" + code_hanging_same_line <- "map(x, f,\n extra_arg = 42)" + + tidy_linter <- indentation_linter() + hanging_linter <- indentation_linter(hanging_indent_style = "always") + non_hanging_linter <- indentation_linter(hanging_indent_style = "never") + + expect_lint(code_block_multi_line, NULL, tidy_linter) + expect_lint(code_block_multi_line, "Hanging indent", hanging_linter) + expect_lint(code_block_multi_line, NULL, non_hanging_linter) + + expect_lint(code_hanging_multi_line, "Indent", tidy_linter) + expect_lint(code_hanging_multi_line, NULL, hanging_linter) + expect_lint(code_hanging_multi_line, "Indent", non_hanging_linter) + + expect_lint(code_block_same_line, "Hanging indent", tidy_linter) + expect_lint(code_block_same_line, "Hanging indent", hanging_linter) + expect_lint(code_block_same_line, NULL, non_hanging_linter) + + expect_lint(code_hanging_same_line, NULL, tidy_linter) + expect_lint(code_hanging_same_line, NULL, hanging_linter) + expect_lint(code_hanging_same_line, "Indent", non_hanging_linter) +}) + +test_that("consecutive same-level lints are suppressed", { + bad_code <- trim_some(" + ok_code <- 42 + + wrong_hanging <- fun(a, b, c, + d, e %>% + f()) + + wrong_block <- function() { + a + b + c + d + if (a == 24) + boo + } + + wrong_hanging_args <- function(a = 1, b = 2, + c = 3, d = 4, + e = 5, f = 6) + { + a + b + c + d + e + f + } + ") + + expect_lint( + bad_code, + list( + list(line_number = 4L, message = "Hanging indent"), + list(line_number = 8L, message = "Indentation"), + list(line_number = 15L, message = "Hanging indent") + ), + indentation_linter() + ) +}) diff --git a/tests/testthat/test-knitr_formats.R b/tests/testthat/test-knitr_formats.R index a6899e074..ac33060bb 100644 --- a/tests/testthat/test-knitr_formats.R +++ b/tests/testthat/test-knitr_formats.R @@ -3,7 +3,8 @@ regexes <- list( local_var = rex::rex("local variable"), quotes = rex::rex("Only use double-quotes."), trailing = rex::rex("Trailing blank lines are superfluous."), - trailws = rex::rex("Trailing whitespace is superfluous.") + trailws = rex::rex("Trailing whitespace is superfluous."), + indent = rex("Indentation should be") ) test_that("it handles dir", { @@ -92,12 +93,16 @@ test_that("it handles tex", { expect_lint( file = test_path("knitr_formats", "test.Rtex"), checks = list( + list(regexes[["indent"]], line_number = 11L), + # TODO(AshesITR): + # masking the Rtex escape char by whitespace causes false-positive indentation lints list(regexes[["assign"]], line_number = 11L), + list(regexes[["indent"]], line_number = 22L), list(regexes[["local_var"]], line_number = 23L), list(regexes[["assign"]], line_number = 23L), list(regexes[["trailing"]], line_number = 25L), list(regexes[["trailws"]], line_number = 25L) - # FIXME(AshesITR): #1043 + # TODO(AshesITR): #1043 # file_lines contains a whitespace on the final line for Rtex, because that is used to mark the Rtex escape char # "%" as well. # cf. get_source_expressions("tests/testthat/knitr_formats/test.Rtex")$lines[[25]]