From b1f1dd8981c38b855024071a2098f30c8e48caf8 Mon Sep 17 00:00:00 2001 From: AshesITR Date: Tue, 26 Apr 2022 22:54:03 +0200 Subject: [PATCH] delete else_same_line_linter and merge it into brace_linter (#1093) * delete else_same_line_linter and merge it into brace_linter * delete function_brace_linter and merge it into brace_linter (#1094) * delete function_brace_linter and merge it into brace_linter * delete if_else_match_braces_linter and merge it into brace_linter (#1095) * delete if_else_match_braces_linter and merge it into brace_linter * deprecate open_curly_linter and merge it into brace_linter (#1096) * deprecate open_curly_linter - remove open_curly_linter from defaults - refactor to XPath based approach - no longer lint trailing whitespace (there's a separate linter for that) * merge paren_brace_linter into brace_linter (#1097) * deprecate paren_brace_linter - remove paren_brace_linter from defaults - extend to else{ and repeat{ * `code` Co-authored-by: Michael Chirico * add explicit test for different behaviour compared to closed_curly_linter Co-authored-by: Michael Chirico Co-authored-by: Michael Chirico Co-authored-by: Michael Chirico Co-authored-by: Michael Chirico --- DESCRIPTION | 3 - NAMESPACE | 3 - NEWS.md | 13 +- R/brace_linter.R | 106 +++++++- R/else_same_line_linter.R | 31 --- R/function_brace_linter.R | 30 --- R/if_else_match_braces_linter.R | 48 ---- R/open_curly_linter.R | 1 + R/paren_brace_linter.R | 1 + R/zzz.R | 4 - inst/lintr/linters.csv | 7 +- man/brace_linter.Rd | 12 +- man/default_linters.Rd | 6 +- man/else_same_line_linter.Rd | 18 -- man/function_brace_linter.Rd | 19 -- man/if_else_match_braces_linter.Rd | 20 -- man/linters.Rd | 13 +- man/open_curly_linter.Rd | 2 +- man/paren_brace_linter.Rd | 2 +- man/readability_linters.Rd | 3 - man/style_linters.Rd | 3 - tests/testthat/default_linter_testcode.R | 4 +- tests/testthat/test-brace_linter.R | 231 +++++++++++++++++- tests/testthat/test-else_same_line_linter.R | 42 ---- tests/testthat/test-function_brace_linter.R | 22 -- .../test-if_else_match_braces_linter.R | 64 ----- tests/testthat/test-open_curly_linter.R | 51 ++-- tests/testthat/test-paren_brace_linter.R | 6 +- 28 files changed, 399 insertions(+), 366 deletions(-) delete mode 100644 R/else_same_line_linter.R delete mode 100644 R/function_brace_linter.R delete mode 100644 R/if_else_match_braces_linter.R delete mode 100644 man/else_same_line_linter.Rd delete mode 100644 man/function_brace_linter.Rd delete mode 100644 man/if_else_match_braces_linter.Rd delete mode 100644 tests/testthat/test-else_same_line_linter.R delete mode 100644 tests/testthat/test-function_brace_linter.R delete mode 100644 tests/testthat/test-if_else_match_braces_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 82470efc2..5c6f096dc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -68,7 +68,6 @@ Collate: 'declared_functions.R' 'deprecated.R' 'duplicate_argument_linter.R' - 'else_same_line_linter.R' 'equals_na_linter.R' 'exclude.R' 'expect_comparison_linter.R' @@ -83,11 +82,9 @@ Collate: 'expect_type_linter.R' 'extract.R' 'extraction_operator_linter.R' - 'function_brace_linter.R' 'function_left_parentheses.R' 'get_source_expressions.R' 'ids_with_token.R' - 'if_else_match_braces_linter.R' 'ifelse_censor_linter.R' 'implicit_integer_linter.R' 'infix_spaces_linter.R' diff --git a/NAMESPACE b/NAMESPACE index 21b0e3c06..12d3e025c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,7 +35,6 @@ export(default_settings) export(default_undesirable_functions) export(default_undesirable_operators) export(duplicate_argument_linter) -export(else_same_line_linter) export(equals_na_linter) export(expect_comparison_linter) export(expect_identical_linter) @@ -50,11 +49,9 @@ export(expect_s4_class_linter) export(expect_true_false_linter) export(expect_type_linter) export(extraction_operator_linter) -export(function_brace_linter) export(function_left_parentheses_linter) export(get_source_expressions) export(ids_with_token) -export(if_else_match_braces_linter) export(ifelse_censor_linter) export(implicit_integer_linter) export(infix_spaces_linter) diff --git a/NEWS.md b/NEWS.md index aa7492377..61f76e5d7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,13 @@ * Rename `semicolon_terminator_linter` to `semicolon_linter` for better consistency. `semicolon_terminator_linter` survives but is marked for deprecation. The new linter also has a new signature, taking arguments `allow_compound` and `allow_trailing` to replace the old single argument `semicolon=`, again for signature consistency with other linters. * Combined several curly brace related linters into a new `brace_linter`: + `closed_curly_linter()`, also allowing `}]` in addition to `})` and `},` as exceptions. +* Combined several curly brace related linters into a new `brace_linter` (#1041, @AshesITR): + + `closed_curly_linter()` + + `open_curly_linter()`, no longer linting unnecessary trailing whitespace + + `paren_brace_linter()`, also linting `if`/`else` and `repeat` with missing whitespace + + Require `else` to come on the same line as the preceding `}`, if present (#884, @michaelchirico) + + Require functions spanning multiple lines to use curly braces (@michaelchirico) + + Require balanced usage of `{}` in `if`/`else` conditions (@michaelchirico) * The `...` arguments for `lint()`, `lint_dir()`, and `lint_package()` have promoted to an earlier position to better match the [Tidyverse design principal](https://design.tidyverse.org/args-data-details.html) of data->descriptor->details. This change enables passing objects to `...` without needing to specify non-required arguments, e.g. `lint_dir("/path/to/dir", linter())` now works without the need to specify `relative_path`. This affects some code that uses positional arguments. (#935, @michaelchirico) + For `lint()`, `...` is now the 3rd argument, where earlier this was `cache=` + For `lint_dir()` and `lint_package()`, `...` is now the 2nd argument, where earlier this was `relative_path=` @@ -119,7 +126,6 @@ function calls. (#850, #851, @renkun-ken) + Extended for #1067 to exclude `$` extractions like `expect_equal(x$"key", 2)` * `expect_identical_linter()` Require usage of `expect_identical()` by default, and `expect_equal()` only by exception * `expect_comparison_linter()` Require usage of `expect_gt(x, y)` over `expect_true(x > y)` and similar - * `if_else_match_braces_linter()` Require balanced usage of `{}` in `if`/`else` conditions * `vector_logic_linter()` Require use of scalar logical operators (`&&` and `||`) inside `if()` conditions and similar * `any_is_na_linter()` Require usage of `anyNA(x)` over `any(is.na(x))` * `class_equals_linter()` Prevent comparing `class(x)` with `==`, `!=`, or `%in%`, where `inherits()` is typically preferred @@ -133,7 +139,10 @@ function calls. (#850, #851, @renkun-ken) * `nested_ifelse_linter()` Prevent nested calls to `ifelse()` like `ifelse(A, x, ifelse(B, y, z))`, and similar * `condition_message_linter` Prevent condition messages from being constructed like `stop(paste(...))` (where just `stop(...)` is preferable) * `redundant_ifelse_linter()` Prevent usage like `ifelse(A & B, TRUE, FALSE)` or `ifelse(C, 0, 1)` (the latter is `as.numeric(!C)`) - * `else_same_line_linter()` Require `else` to come on the same line as the preceding `}`, if present + * Extensions to `brace_linter()` + + Require `else` to come on the same line as the preceding `}`, if present + + Require balanced usage of `{}` in `if`/`else` conditions + + Require functions spanning multiple lines to use curly braces * `unreachable_code_linter()` Prevent code after `return()` and `stop()` statements that will never be reached (extended for #1051 thanks to early user testing, thanks @bersbersbers!) * `regex_subset_linter()` Require usage of `grep(ptn, x, value = TRUE)` over `x[grep(ptn, x)]` and similar * `consecutive_stopifnot_linter()` Require consecutive calls to `stopifnot()` to be unified into one diff --git a/R/brace_linter.R b/R/brace_linter.R index 19f62cdfc..40ebfa4a9 100644 --- a/R/brace_linter.R +++ b/R/brace_linter.R @@ -2,12 +2,20 @@ #' #' Perform various style checks related to placement and spacing of curly braces: #' -#' - Curly braces are on their own line unless they are followed by an `else`. +#' - Opening curly braces are never on their own line and are always followed by a newline. +#' - Opening curly braces have a space before them. +#' - Closing curly braces are on their own line unless they are followed by an `else`. +#' - Closing curly braces in `if` conditions are on the same line as the corresponding `else`. +#' - Either both or neither branch in `if`/`else` use curly braces, i.e., either both branches use `{...}` or neither +#' does. +#' - Functions spanning multiple lines use curly braces. #' #' @param allow_single_line if `TRUE`, allow an open and closed curly pair on the same line. #' #' @evalRd rd_tags("brace_linter") -#' @seealso [linters] for a complete list of linters available in lintr. +#' @seealso [linters] for a complete list of linters available in lintr. \cr +#' \cr +#' #' @export brace_linter <- function(allow_single_line = FALSE) { Linter(function(source_expression) { @@ -17,6 +25,51 @@ brace_linter <- function(allow_single_line = FALSE) { lints <- list() + xp_cond_open <- xp_and(c( + # matching } is on same line + if (isTRUE(allow_single_line)) { + "(@line1 != following-sibling::OP-LEFT-BRACE/@line1)" + }, + # double curly + "not( + (@line1 = parent::expr/preceding-sibling::OP-LEFT-BRACE/@line1) or + (@line1 = following-sibling::expr/OP-LEFT-BRACE/@line1) + )" + )) + + # TODO (AshesITR): if c_style_braces is TRUE, invert the preceding-sibling condition + xp_open_curly <- glue::glue("//OP-LEFT-BRACE[ + { xp_cond_open } and ( + not(@line1 = parent::expr/preceding-sibling::*/@line2) or + @line1 = following-sibling::*[1][not(self::COMMENT)]/@line1 + ) + ]") + + lints <- c(lints, lapply( + xml2::xml_find_all(source_expression$xml_parsed_content, xp_open_curly), + xml_nodes_to_lint, + source_file = source_expression, + lint_message = paste( + "Opening curly braces should never go on their own line and", + "should always be followed by a new line." + ) + )) + + xp_open_preceding <- "parent::expr/preceding-sibling::*[1][self::OP-RIGHT-PAREN or self::ELSE or self::REPEAT]" + + xp_paren_brace <- glue::glue("//OP-LEFT-BRACE[ + @line1 = { xp_open_preceding }/@line1 + and + @col1 = { xp_open_preceding }/@col2 + 1 + ]") + + lints <- c(lints, lapply( + xml2::xml_find_all(source_expression$xml_parsed_content, xp_paren_brace), + xml_nodes_to_lint, + source_file = source_expression, + lint_message = "There should be a space before an opening curly brace." + )) + xp_cond_closed <- xp_and(c( # matching { is on same line if (isTRUE(allow_single_line)) { @@ -35,6 +88,7 @@ brace_linter <- function(allow_single_line = FALSE) { )" )) + # TODO (AshesITR): if c_style_braces is TRUE, skip the not(ELSE) condition xp_closed_curly <- glue::glue("//OP-RIGHT-BRACE[ { xp_cond_closed } and ( (@line1 = preceding-sibling::*[1]/@line2) or @@ -52,6 +106,54 @@ brace_linter <- function(allow_single_line = FALSE) { ) )) + xp_else_closed_curly <- "preceding-sibling::IF/following-sibling::expr[2]/OP-RIGHT-BRACE" + # need to (?) repeat previous_curly_path since != will return true if there is + # no such node. ditto for approach with not(@line1 = ...). + # TODO (AshesITR): if c_style_braces is TRUE, this needs to be @line2 + 1 + xp_else_same_line <- glue::glue("//ELSE[{xp_else_closed_curly} and @line1 != {xp_else_closed_curly}/@line2]") + + lints <- c(lints, lapply( + xml2::xml_find_all(source_expression$xml_parsed_content, xp_else_same_line), + xml_nodes_to_lint, + source_file = source_expression, + lint_message = "`else` should come on the same line as the previous `}`." + )) + + xp_function_brace <- "//expr[FUNCTION and @line1 != @line2 and not(expr[OP-LEFT-BRACE])]" + + lints <- c(lints, lapply( + xml2::xml_find_all(source_expression$xml_parsed_content, xp_function_brace), + xml_nodes_to_lint, + source_file = source_expression, + lint_message = "Any function spanning multiple lines should use curly braces." + )) + + # if (x) { ... } else if (y) { ... } else { ... } is OK; fully exact pairing + # of if/else would require this to be + # if (x) { ... } else { if (y) { ... } else { ... } } since there's no + # elif operator/token in R, which is pretty unseemly + xp_if_else_match_brace <- " + //IF[ + following-sibling::expr[2][OP-LEFT-BRACE] + and following-sibling::ELSE + /following-sibling::expr[1][not(OP-LEFT-BRACE or IF/following-sibling::expr[2][OP-LEFT-BRACE])] + ] + + | + + //ELSE[ + following-sibling::expr[1][OP-LEFT-BRACE] + and preceding-sibling::IF/following-sibling::expr[2][not(OP-LEFT-BRACE)] + ] + " + + lints <- c(lints, lapply( + xml2::xml_find_all(source_expression$xml_parsed_content, xp_if_else_match_brace), + xml_nodes_to_lint, + source_file = source_expression, + lint_message = "Either both or neither branch in `if`/`else` should use curly braces." + )) + lints }) } diff --git a/R/else_same_line_linter.R b/R/else_same_line_linter.R deleted file mode 100644 index bfe409eb0..000000000 --- a/R/else_same_line_linter.R +++ /dev/null @@ -1,31 +0,0 @@ -#' Require else to come on the same line as \}, if present -#' -#' This linter catches `if`/`else` clauses where `if` uses `\{` and its terminal -#' `\}` is on a different line than the matched `else`. -#' -#' @evalRd rd_tags("else_same_line_linter") -#' @seealso [linters] for a complete list of linters available in lintr. -#' @export -else_same_line_linter <- function() { - Linter(function(source_file) { - if (length(source_file$xml_parsed_content) == 0L) { - return(list()) - } - - xml <- source_file$xml_parsed_content - - previous_curly_path <- "preceding-sibling::IF/following-sibling::expr[2]/OP-RIGHT-BRACE" - # need to (?) repeat previous_curly_path since != will return true if there is - # no such node. ditto for approach with not(@line1 = ...). - bad_expr_xpath <- glue::glue("//ELSE[{previous_curly_path} and @line1 != {previous_curly_path}/@line2]") - bad_expr <- xml2::xml_find_all(xml, bad_expr_xpath) - - return(lapply( - bad_expr, - xml_nodes_to_lint, - source_file = source_file, - lint_message = "`else` should come on the same line as the previous `}`.", - type = "warning" - )) - }) -} diff --git a/R/function_brace_linter.R b/R/function_brace_linter.R deleted file mode 100644 index c7f2e213f..000000000 --- a/R/function_brace_linter.R +++ /dev/null @@ -1,30 +0,0 @@ -#' Require multi-line functions to use braces -#' -#' This linter catches function definitions spanning multiple lines of code -#' that aren't wrapped in braces -#' -#' @evalRd rd_tags("function_brace_linter") -#' @seealso -#' [linters] for a complete list of linters available in lintr. \cr -#' -#' @export -function_brace_linter <- function() { - Linter(function(source_file) { - if (length(source_file$xml_parsed_content) == 0L) { - return(list()) - } - - xml <- source_file$xml_parsed_content - - bad_expr_xpath <- "//expr[FUNCTION and @line1 != @line2 and not(expr[OP-LEFT-BRACE])]" - bad_expr <- xml2::xml_find_all(xml, bad_expr_xpath) - - return(lapply( - bad_expr, - xml_nodes_to_lint, - source_file = source_file, - lint_message = "Any function spanning multiple lines must use curly braces.", - type = "style" - )) - }) -} diff --git a/R/if_else_match_braces_linter.R b/R/if_else_match_braces_linter.R deleted file mode 100644 index e35132649..000000000 --- a/R/if_else_match_braces_linter.R +++ /dev/null @@ -1,48 +0,0 @@ -#' Require both or neither if/else branches to use curly braces -#' -#' This linter catches `if`/`else` clauses where the `if` branch is wrapped -#' in `{...}` but the `else` branch is not, or vice versa, i.e., it ensures -#' that either both branches use `{...}` or neither does. -#' -#' @evalRd rd_tags("if_else_match_braces_linter") -#' @seealso -#' [linters] for a complete list of linters available in lintr. \cr -#' -#' @export -if_else_match_braces_linter <- function() { - Linter(function(source_file) { - if (length(source_file$xml_parsed_content) == 0L) { - return(list()) - } - - xml <- source_file$xml_parsed_content - - # if (x) { ... } else if (y) { ... } else { ... } is OK; fully exact pairing - # of if/else would require this to be - # if (x) { ... } else { if (y) { ... } else { ... } } since there's no - # elif operator/token in R, which is pretty unseemly - xpath <- " - //IF[ - following-sibling::expr[2][OP-LEFT-BRACE] - and following-sibling::ELSE - /following-sibling::expr[1][not(OP-LEFT-BRACE or IF/following-sibling::expr[2][OP-LEFT-BRACE])] - ] - - | - - //ELSE[ - following-sibling::expr[1][OP-LEFT-BRACE] - and preceding-sibling::IF/following-sibling::expr[2][not(OP-LEFT-BRACE)] - ] - " - bad_expr <- xml2::xml_find_all(xml, xpath) - - return(lapply( - bad_expr, - xml_nodes_to_lint, - source_file = source_file, - lint_message = "Either both or neither branch in `if`/`else` should use curly braces.", - type = "warning" - )) - }) -} diff --git a/R/open_curly_linter.R b/R/open_curly_linter.R index 29be743bd..2350217d9 100644 --- a/R/open_curly_linter.R +++ b/R/open_curly_linter.R @@ -9,6 +9,7 @@ #' #' @export open_curly_linter <- function(allow_single_line = FALSE) { + lintr_deprecated("open_curly_linter", new = "brace_linter", version = "2.0.1.9001", type = "Linter") Linter(function(source_file) { lapply( ids_with_token(source_file, "'{'"), diff --git a/R/paren_brace_linter.R b/R/paren_brace_linter.R index c2523a22e..e7548719e 100644 --- a/R/paren_brace_linter.R +++ b/R/paren_brace_linter.R @@ -6,6 +6,7 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export paren_brace_linter <- function() { + lintr_deprecated("paren_brace_linter", new = "brace_linter", version = "2.0.1.9001", type = "Linter") Linter(function(source_file) { if (is.null(source_file$xml_parsed_content)) { return(NULL) diff --git a/R/zzz.R b/R/zzz.R index c4c94e2e9..0e8062f8c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -18,18 +18,14 @@ default_linters <- with_defaults( commented_code_linter(), cyclocomp_linter(), equals_na_linter(), - function_brace_linter(), function_left_parentheses_linter(), - if_else_match_braces_linter(), infix_spaces_linter(), line_length_linter(), no_tab_linter(), object_length_linter(), object_name_linter(), object_usage_linter(), - open_curly_linter(), paren_body_linter(), - paren_brace_linter(), pipe_continuation_linter(), semicolon_linter(), seq_linter(), diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index a2f1e8047..1405e9700 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -14,7 +14,6 @@ conjunct_test_linter,package_development best_practices readability consecutive_stopifnot_linter,style readability consistency cyclocomp_linter,style readability best_practices default configurable duplicate_argument_linter,correctness common_mistakes configurable -else_same_line_linter,style readability equals_na_linter,robustness correctness common_mistakes default expect_comparison_linter,package_development best_practices expect_identical_linter,package_development @@ -27,9 +26,7 @@ expect_s4_class_linter,package_development best_practices expect_true_false_linter,package_development best_practices readability expect_type_linter,package_development best_practices extraction_operator_linter,style best_practices -function_brace_linter,default style readability function_left_parentheses_linter,style readability default -if_else_match_braces_linter,default style readability ifelse_censor_linter,best_practices efficiency implicit_integer_linter,style consistency best_practices infix_spaces_linter,style readability default @@ -46,11 +43,11 @@ numeric_leading_zero_linter,style consistency readability object_length_linter,style readability default configurable object_name_linter,style consistency default configurable object_usage_linter,style readability correctness default -open_curly_linter,style readability default configurable +open_curly_linter,style readability configurable outer_negation_linter,readability efficiency best_practices package_hooks_linter,style correctness package_development paren_body_linter,style readability default -paren_brace_linter,style readability default +paren_brace_linter,style readability paste_linter,best_practices consistency pipe_call_linter,style readability pipe_continuation_linter,style readability default diff --git a/man/brace_linter.Rd b/man/brace_linter.Rd index 4b4dec9e6..da1f91e5c 100644 --- a/man/brace_linter.Rd +++ b/man/brace_linter.Rd @@ -14,11 +14,19 @@ Perform various style checks related to placement and spacing of curly braces: } \details{ \itemize{ -\item Curly braces are on their own line unless they are followed by an \verb{else}. +\item Opening curly braces are never on their own line and are always followed by a newline. +\item Opening curly braces have a space before them. +\item Closing curly braces are on their own line unless they are followed by an \verb{else}. +\item Closing curly braces in \code{if} conditions are on the same line as the corresponding \verb{else}. +\item Either both or neither branch in \code{if}/\verb{else} use curly braces, i.e., either both branches use \code{{...}} or neither +does. +\item Functions spanning multiple lines use curly braces. } } \seealso{ -\link{linters} for a complete list of linters available in lintr. +\link{linters} for a complete list of linters available in lintr. \cr +\url{https://style.tidyverse.org/syntax.html#indenting} \cr +\url{https://style.tidyverse.org/syntax.html#if-statements} } \section{Tags}{ \link[=configurable_linters]{configurable}, \link[=default_linters]{default}, \link[=readability_linters]{readability}, \link[=style_linters]{style} diff --git a/man/default_linters.Rd b/man/default_linters.Rd index e267c4037..2a0aedfba 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 28. +An object of class \code{list} of length 24. } \usage{ default_linters @@ -30,18 +30,14 @@ The following linters are tagged with 'default': \item{\code{\link{commented_code_linter}}} \item{\code{\link{cyclocomp_linter}}} \item{\code{\link{equals_na_linter}}} -\item{\code{\link{function_brace_linter}}} \item{\code{\link{function_left_parentheses_linter}}} -\item{\code{\link{if_else_match_braces_linter}}} \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{line_length_linter}}} \item{\code{\link{no_tab_linter}}} \item{\code{\link{object_length_linter}}} \item{\code{\link{object_name_linter}}} \item{\code{\link{object_usage_linter}}} -\item{\code{\link{open_curly_linter}}} \item{\code{\link{paren_body_linter}}} -\item{\code{\link{paren_brace_linter}}} \item{\code{\link{pipe_continuation_linter}}} \item{\code{\link{semicolon_linter}}} \item{\code{\link{seq_linter}}} diff --git a/man/else_same_line_linter.Rd b/man/else_same_line_linter.Rd deleted file mode 100644 index cbd054512..000000000 --- a/man/else_same_line_linter.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/else_same_line_linter.R -\name{else_same_line_linter} -\alias{else_same_line_linter} -\title{Require else to come on the same line as \}, if present} -\usage{ -else_same_line_linter() -} -\description{ -This linter catches \code{if}/\verb{else} clauses where \code{if} uses \verb{\\\{} and its terminal -\verb{\\\}} is on a different line than the matched \verb{else}. -} -\seealso{ -\link{linters} for a complete list of linters available in lintr. -} -\section{Tags}{ -\link[=readability_linters]{readability}, \link[=style_linters]{style} -} diff --git a/man/function_brace_linter.Rd b/man/function_brace_linter.Rd deleted file mode 100644 index 033381570..000000000 --- a/man/function_brace_linter.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/function_brace_linter.R -\name{function_brace_linter} -\alias{function_brace_linter} -\title{Require multi-line functions to use braces} -\usage{ -function_brace_linter() -} -\description{ -This linter catches function definitions spanning multiple lines of code -that aren't wrapped in braces -} -\seealso{ -\link{linters} for a complete list of linters available in lintr. \cr -\url{https://style.tidyverse.org/syntax.html#indenting} -} -\section{Tags}{ -\link[=default_linters]{default}, \link[=readability_linters]{readability}, \link[=style_linters]{style} -} diff --git a/man/if_else_match_braces_linter.Rd b/man/if_else_match_braces_linter.Rd deleted file mode 100644 index 7e3a94b91..000000000 --- a/man/if_else_match_braces_linter.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/if_else_match_braces_linter.R -\name{if_else_match_braces_linter} -\alias{if_else_match_braces_linter} -\title{Require both or neither if/else branches to use curly braces} -\usage{ -if_else_match_braces_linter() -} -\description{ -This linter catches \code{if}/\verb{else} clauses where the \code{if} branch is wrapped -in \code{{...}} but the \verb{else} branch is not, or vice versa, i.e., it ensures -that either both branches use \code{{...}} or neither does. -} -\seealso{ -\link{linters} for a complete list of linters available in lintr. \cr -\url{https://style.tidyverse.org/syntax.html#if-statements} -} -\section{Tags}{ -\link[=default_linters]{default}, \link[=readability_linters]{readability}, \link[=style_linters]{style} -} diff --git a/man/linters.Rd b/man/linters.Rd index 2fa394a09..e7d36e2f8 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -22,12 +22,12 @@ The following tags exist: \item{\link[=configurable_linters]{configurable} (18 linters)} \item{\link[=consistency_linters]{consistency} (16 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} -\item{\link[=default_linters]{default} (28 linters)} +\item{\link[=default_linters]{default} (24 linters)} \item{\link[=efficiency_linters]{efficiency} (14 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} -\item{\link[=readability_linters]{readability} (38 linters)} +\item{\link[=readability_linters]{readability} (35 linters)} \item{\link[=robustness_linters]{robustness} (12 linters)} -\item{\link[=style_linters]{style} (38 linters)} +\item{\link[=style_linters]{style} (35 linters)} } } \section{Linters}{ @@ -48,7 +48,6 @@ The following linters exist: \item{\code{\link{consecutive_stopifnot_linter}} (tags: consistency, readability, style)} \item{\code{\link{cyclocomp_linter}} (tags: best_practices, configurable, default, readability, style)} \item{\code{\link{duplicate_argument_linter}} (tags: common_mistakes, configurable, correctness)} -\item{\code{\link{else_same_line_linter}} (tags: readability, style)} \item{\code{\link{equals_na_linter}} (tags: common_mistakes, correctness, default, robustness)} \item{\code{\link{expect_comparison_linter}} (tags: best_practices, package_development)} \item{\code{\link{expect_identical_linter}} (tags: package_development)} @@ -61,9 +60,7 @@ The following linters exist: \item{\code{\link{expect_true_false_linter}} (tags: best_practices, package_development, readability)} \item{\code{\link{expect_type_linter}} (tags: best_practices, package_development)} \item{\code{\link{extraction_operator_linter}} (tags: best_practices, style)} -\item{\code{\link{function_brace_linter}} (tags: default, readability, style)} \item{\code{\link{function_left_parentheses_linter}} (tags: default, readability, style)} -\item{\code{\link{if_else_match_braces_linter}} (tags: default, readability, style)} \item{\code{\link{ifelse_censor_linter}} (tags: best_practices, efficiency)} \item{\code{\link{implicit_integer_linter}} (tags: best_practices, consistency, style)} \item{\code{\link{infix_spaces_linter}} (tags: default, readability, style)} @@ -80,11 +77,11 @@ The following linters exist: \item{\code{\link{object_length_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{object_name_linter}} (tags: configurable, consistency, default, style)} \item{\code{\link{object_usage_linter}} (tags: correctness, default, readability, style)} -\item{\code{\link{open_curly_linter}} (tags: configurable, default, readability, style)} +\item{\code{\link{open_curly_linter}} (tags: configurable, readability, style)} \item{\code{\link{outer_negation_linter}} (tags: best_practices, efficiency, readability)} \item{\code{\link{package_hooks_linter}} (tags: correctness, package_development, style)} \item{\code{\link{paren_body_linter}} (tags: default, readability, style)} -\item{\code{\link{paren_brace_linter}} (tags: default, readability, style)} +\item{\code{\link{paren_brace_linter}} (tags: readability, style)} \item{\code{\link{paste_linter}} (tags: best_practices, consistency)} \item{\code{\link{pipe_call_linter}} (tags: readability, style)} \item{\code{\link{pipe_continuation_linter}} (tags: default, readability, style)} diff --git a/man/open_curly_linter.Rd b/man/open_curly_linter.Rd index 971cb8f99..640eaff0d 100644 --- a/man/open_curly_linter.Rd +++ b/man/open_curly_linter.Rd @@ -17,5 +17,5 @@ Check that opening curly braces are never on their own line and are always follo \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} +\link[=configurable_linters]{configurable}, \link[=readability_linters]{readability}, \link[=style_linters]{style} } diff --git a/man/paren_brace_linter.Rd b/man/paren_brace_linter.Rd index ef8d54b7a..369571b69 100644 --- a/man/paren_brace_linter.Rd +++ b/man/paren_brace_linter.Rd @@ -13,5 +13,5 @@ Check that there is a space between right parentheses and an opening curly brace \link{linters} for a complete list of linters available in lintr. } \section{Tags}{ -\link[=default_linters]{default}, \link[=readability_linters]{readability}, \link[=style_linters]{style} +\link[=readability_linters]{readability}, \link[=style_linters]{style} } diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index 0e12cf6f1..91c38b71b 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -19,14 +19,11 @@ The following linters are tagged with 'readability': \item{\code{\link{conjunct_test_linter}}} \item{\code{\link{consecutive_stopifnot_linter}}} \item{\code{\link{cyclocomp_linter}}} -\item{\code{\link{else_same_line_linter}}} \item{\code{\link{expect_length_linter}}} \item{\code{\link{expect_named_linter}}} \item{\code{\link{expect_not_linter}}} \item{\code{\link{expect_true_false_linter}}} -\item{\code{\link{function_brace_linter}}} \item{\code{\link{function_left_parentheses_linter}}} -\item{\code{\link{if_else_match_braces_linter}}} \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{inner_combine_linter}}} \item{\code{\link{line_length_linter}}} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index 5bc022ffd..e33d35c18 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -19,11 +19,8 @@ The following linters are tagged with 'style': \item{\code{\link{commented_code_linter}}} \item{\code{\link{consecutive_stopifnot_linter}}} \item{\code{\link{cyclocomp_linter}}} -\item{\code{\link{else_same_line_linter}}} \item{\code{\link{extraction_operator_linter}}} -\item{\code{\link{function_brace_linter}}} \item{\code{\link{function_left_parentheses_linter}}} -\item{\code{\link{if_else_match_braces_linter}}} \item{\code{\link{implicit_integer_linter}}} \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{line_length_linter}}} diff --git a/tests/testthat/default_linter_testcode.R b/tests/testthat/default_linter_testcode.R index ef3a20e63..99f7a3cef 100644 --- a/tests/testthat/default_linter_testcode.R +++ b/tests/testthat/default_linter_testcode.R @@ -2,7 +2,7 @@ # assignment # function_left_parentheses -# closed_curly +# brace_linter # commas # paren_brace f = function (x,y = 1){} @@ -12,7 +12,7 @@ f = function (x,y = 1){} # cyclocomp # equals_na -# if_else_match_braces_linter +# brace_linter # infix_spaces # line_length # object_length diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index 642c4c3be..dff057344 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -1,4 +1,7 @@ -test_that("brace_linter lints closed braces correctly", { +test_that("brace_linter lints braces correctly", { + open_curly_msg <- rex::rex( + "Opening curly braces should never go on their own line and should always be followed by a new line." + ) closed_curly_msg <- rex::rex(paste( "Closing curly-braces should always be on their own line,", "unless they are followed by an else." @@ -7,8 +10,9 @@ test_that("brace_linter lints closed braces correctly", { linter <- brace_linter() expect_lint("blah", NULL, linter) expect_lint("a <- function() {\n}", NULL, linter) + expect_lint("a <- function() { \n}", NULL, linter) - expect_lint("a <- function() { 1 }", closed_curly_msg, linter) + expect_lint("a <- function() { 1 }", list(open_curly_msg, closed_curly_msg), linter) # allowed by allow_single_line expect_lint("a <- function() { 1 }", NULL, brace_linter(allow_single_line = TRUE)) @@ -47,9 +51,9 @@ test_that("brace_linter lints closed braces correctly", { ) # }) is allowed - expect_lint("eval(bquote({...}))", NULL, linter) + expect_lint("eval(bquote({\n...\n}))", NULL, linter) # }] is too - expect_lint("df[, {...}]", NULL, linter) + expect_lint("df[, {\n...\n}]", NULL, linter) # }, is allowed expect_lint( @@ -79,6 +83,223 @@ test_that("brace_linter lints closed braces correctly", { linter ) - # }} is allowed + # {{ }} is allowed expect_lint("{{ x }}", NULL, linter) + + expect_lint( + trim_some(" + pkg_name <- function(path = find_package()) { + if (is.null(path)) { + return(NULL) + } else { + read.dcf(file.path(path, \"DESCRIPTION\"), fields = \"Package\")[1] + } + } + "), + NULL, + linter + ) + + expect_lint("a <- function()\n{\n 1 \n}", open_curly_msg, linter) + expect_lint("a <- function()\n {\n 1 \n}", open_curly_msg, linter) + expect_lint("a <- function()\n\t{\n 1 \n}", open_curly_msg, linter) + + # trailing comments are allowed + expect_lint( + trim_some(' + if ("P" != "NP") { # what most people expect + print("Cryptomania is possible") + } + '), + NULL, + linter + ) +}) + +test_that("brace_linter lints spaces before open braces", { + linter <- brace_linter() + msg <- rex::rex("There should be a space before an opening curly brace.") + + expect_lint( + "blah <- function(){\n}", + list( + message = msg, + column_number = 19L + ), + linter + ) + + expect_lint( + "\nblah <- function(){\n\n\n}", + list( + message = msg, + column_number = 19L + ), + linter + ) + + # should also lint if/else + expect_lint( + "a <- if (a){\n} else{\n}", + list( + list(message = msg, line_number = 1L, column_number = 12L), + list(message = msg, line_number = 2L, column_number = 7L) + ), + linter + ) + + # should lint repeat{ + expect_lint( + "repeat{\nblah\n}", + list(message = msg, line_number = 1L, column_number = 7L), + linter + ) + + # should ignore strings and comments, as in regexes: + expect_lint("grepl('(iss){2}', 'Mississippi')", NULL, linter) + expect_lint( + "x <- 123 # dont flag (paren){brace} if inside a comment", + NULL, + linter + ) + # should not be thrown when the brace lies on subsequent line + expect_lint( + trim_some(" + x <- function() + {2} + "), + list( + rex::rex("Opening curly braces should never go on their own line and should always be followed by a new line."), + rex::rex("Closing curly-braces should always be on their own line, unless they are followed by an else.") + ), #, but not msg + linter + ) +}) + +test_that("brace_linter lints else correctly", { + linter <- brace_linter() + expect_lint("if (TRUE) 1 else 2", NULL, linter) + expect_lint("if (TRUE) 1", NULL, linter) + + lines_brace <- trim_some(" + if (TRUE) { + 1 + } else { + 2 + } + ") + expect_lint(lines_brace, NULL, linter) + + # such usage is also not allowed by the style guide, but test anyway + lines_unbrace <- trim_some(" + foo <- function(x) { + if (TRUE) + 1 + else + 2 + } + ") + expect_lint(lines_unbrace, NULL, linter) + + lines <- trim_some(" + foo <- function(x) { + if (x) { + 1 + } + else { + 2 + } + } + ") + expect_lint( + lines, + rex::rex("`else` should come on the same line as the previous `}`."), + linter + ) +}) + +test_that("brace_linter lints function expressions correctly", { + linter <- brace_linter() + expect_lint("function(x) 4", NULL, linter) + + lines <- trim_some(" + function(x) { + x + 4 + } + ") + expect_lint(lines, NULL, linter) + + lines <- trim_some(" + function(x) + x+4 + ") + expect_lint( + lines, + rex::rex("Any function spanning multiple lines should use curly braces."), + linter + ) +}) + +test_that("brace_linter lints if/else matching braces correctly", { + linter <- brace_linter() + expect_lint("if (TRUE) 1 else 2", NULL, linter) + expect_lint("if (TRUE) 1", NULL, linter) + + lines_brace <- trim_some(" + if (TRUE) { + 1 + } else { + 2 + } + ") + expect_lint(lines_brace, NULL, linter) + + # such usage is also not allowed by the style guide, but test anyway + lines_unbrace <- trim_some(" + foo <- function(x) { + if (TRUE) + 1 + else + 2 + } + ") + expect_lint(lines_unbrace, NULL, linter) + + # else if is OK + lines_else_if <- trim_some(" + if (x) { + 1 + } else if (y) { + 2 + } else { + 3 + } + ") + expect_lint(lines_else_if, NULL, linter) + + lines_if <- trim_some(" + foo <- function(x) { + if (x) { + 1 + } else 2 + } + ") + expect_lint( + lines_if, + rex::rex("Either both or neither branch in `if`/`else` should use curly braces."), + linter + ) + + lines_else <- trim_some(" + foo <- function(x) { + if (x) 1 else { + 2 + } + } + ") + expect_lint( + lines_else, + rex::rex("Either both or neither branch in `if`/`else` should use curly braces."), + linter + ) }) diff --git a/tests/testthat/test-else_same_line_linter.R b/tests/testthat/test-else_same_line_linter.R deleted file mode 100644 index 567ba2b0d..000000000 --- a/tests/testthat/test-else_same_line_linter.R +++ /dev/null @@ -1,42 +0,0 @@ -test_that("else_same_line_linter skips allowed usages", { - expect_lint("if (TRUE) 1 else 2", NULL, else_same_line_linter()) - expect_lint("if (TRUE) 1", NULL, else_same_line_linter()) - - lines_brace <- trim_some(" - if (TRUE) { - 1 - } else { - 2 - } - ") - expect_lint(lines_brace, NULL, else_same_line_linter()) - - # such usage is also not allowed by the style guide, but test anyway - lines_unbrace <- trim_some(" - foo <- function(x) { - if (TRUE) - 1 - else - 2 - } - ") - expect_lint(lines_unbrace, NULL, else_same_line_linter()) -}) - -test_that("else_same_line_linter blocks disallowed usage", { - lines <- trim_some(" - foo <- function(x) { - if (x) { - 1 - } - else { - 2 - } - } - ") - expect_lint( - lines, - rex::rex("`else` should come on the same line as the previous `}`."), - else_same_line_linter() - ) -}) diff --git a/tests/testthat/test-function_brace_linter.R b/tests/testthat/test-function_brace_linter.R deleted file mode 100644 index e18fb4eb6..000000000 --- a/tests/testthat/test-function_brace_linter.R +++ /dev/null @@ -1,22 +0,0 @@ -test_that("function_brace_linter skips allowed usages", { - expect_lint("function(x) 4", NULL, function_brace_linter()) - - lines <- trim_some(" - function(x) { - x + 4 - } - ") - expect_lint(lines, NULL, function_brace_linter()) -}) - -test_that("function_brace_linter blocks disallowed usage", { - lines <- trim_some(" - function(x) - x+4 - ") - expect_lint( - lines, - rex::rex("Any function spanning multiple lines must use curly braces."), - function_brace_linter() - ) -}) diff --git a/tests/testthat/test-if_else_match_braces_linter.R b/tests/testthat/test-if_else_match_braces_linter.R deleted file mode 100644 index d52762c60..000000000 --- a/tests/testthat/test-if_else_match_braces_linter.R +++ /dev/null @@ -1,64 +0,0 @@ -test_that("if_else_match_braces_linter skips allowed usages", { - expect_lint("if (TRUE) 1 else 2", NULL, if_else_match_braces_linter()) - expect_lint("if (TRUE) 1", NULL, if_else_match_braces_linter()) - - lines_brace <- trim_some(" - if (TRUE) { - 1 - } else { - 2 - } - ") - expect_lint(lines_brace, NULL, if_else_match_braces_linter()) - - # such usage is also not allowed by the style guide, but test anyway - lines_unbrace <- trim_some(" - foo <- function(x) { - if (TRUE) - 1 - else - 2 - } - ") - expect_lint(lines_unbrace, NULL, if_else_match_braces_linter()) - - # else if is OK - lines_else_if <- trim_some(" - if (x) { - 1 - } else if (y) { - 2 - } else { - 3 - } - ") - expect_lint(lines_else_if, NULL, if_else_match_braces_linter()) -}) - -test_that("if_else_match_braces_linter blocks disallowed usage", { - lines_if <- trim_some(" - foo <- function(x) { - if (x) { - 1 - } else 2 - } - ") - expect_lint( - lines_if, - rex::rex("Either both or neither branch in `if`/`else` should use curly braces."), - if_else_match_braces_linter() - ) - - lines_else <- trim_some(" - foo <- function(x) { - if (x) 1 else { - 2 - } - } - ") - expect_lint( - lines_else, - rex::rex("Either both or neither branch in `if`/`else` should use curly braces."), - if_else_match_braces_linter() - ) -}) diff --git a/tests/testthat/test-open_curly_linter.R b/tests/testthat/test-open_curly_linter.R index 5e02c3cf4..acd4a969e 100644 --- a/tests/testthat/test-open_curly_linter.R +++ b/tests/testthat/test-open_curly_linter.R @@ -1,49 +1,56 @@ test_that("returns the correct linting", { + msg <- rex("Opening curly braces should never go on their own line and should always be followed by a new line.") - expect_lint("blah", NULL, open_curly_linter()) + expect_warning( + linter <- open_curly_linter(), + "Linter open_curly_linter was deprecated", + fixed = TRUE + ) + + expect_lint("blah", NULL, linter) - expect_lint("a <- function() {\n}", NULL, open_curly_linter()) + expect_lint("a <- function() {\n}", NULL, linter) expect_lint( -"pkg_name <- function(path = find_package()) { - if (is.null(path)) { - return(NULL) - } else { - read.dcf(file.path(path, \"DESCRIPTION\"), fields = \"Package\")[1] - } -}", NULL, open_curly_linter()) + "pkg_name <- function(path = find_package()) { + if (is.null(path)) { + return(NULL) + } else { + read.dcf(file.path(path, \"DESCRIPTION\"), fields = \"Package\")[1] + } + }", NULL, linter) expect_lint("a <- function()\n{\n 1 \n}", - rex("Opening curly braces should never go on their own line and should always be followed by a new line."), - open_curly_linter()) + msg, + linter) expect_lint("a <- function()\n {\n 1 \n}", - rex("Opening curly braces should never go on their own line and should always be followed by a new line."), - open_curly_linter()) + msg, + linter) expect_lint("a <- function()\n\t{\n 1 \n}", - rex("Opening curly braces should never go on their own line and should always be followed by a new line."), - open_curly_linter()) + msg, + linter) expect_lint("a <- function() { \n}", - rex("Opening curly braces should never go on their own line and should always be followed by a new line."), - open_curly_linter()) + msg, + linter) expect_lint("a <- function() { 1 }", - rex("Opening curly braces should never go on their own line and should always be followed by a new line."), - open_curly_linter()) + msg, + linter) expect_lint("a <- function() { 1 }", NULL, - open_curly_linter(allow_single_line = TRUE)) + suppressWarnings(open_curly_linter(allow_single_line = TRUE))) expect_lint( 'if ("P" != "NP") { # what most people expect print("Cryptomania is possible") }', NULL, - open_curly_linter() +linter ) - expect_lint("{{x}}", NULL, open_curly_linter()) + expect_lint("{{x}}", NULL, linter) }) diff --git a/tests/testthat/test-paren_brace_linter.R b/tests/testthat/test-paren_brace_linter.R index 1bce78215..b5058f2a9 100644 --- a/tests/testthat/test-paren_brace_linter.R +++ b/tests/testthat/test-paren_brace_linter.R @@ -1,5 +1,9 @@ test_that("returns the correct linting", { - linter <- paren_brace_linter() + expect_warning( + linter <- paren_brace_linter(), + "Linter paren_brace_linter was deprecated", + fixed = TRUE + ) msg <- rex("There should be a space between right parenthesis and an opening curly brace.") expect_lint("blah", NULL, linter)