From 616405ad5aba9d4f17819e7f5e66852f7c495121 Mon Sep 17 00:00:00 2001 From: Konrad Pagacz Date: Wed, 7 Jul 2021 18:02:28 +0200 Subject: [PATCH 01/10] feat(new linter): added a new linter * Added a new linter that checks for a space between the right parenthesis and the function body in function definitions that span one line and don't use braces Closes #809 --- DESCRIPTION | 1 + NAMESPACE | 1 + R/paren_body_linter.R | 33 ++++++++++++++++++++ R/zzz.R | 1 + man/default_linters.Rd | 2 +- man/linters.Rd | 22 ++++++++----- tests/testthat/test-paren_body_linter.R | 41 +++++++++++++++++++++++++ 7 files changed, 93 insertions(+), 8 deletions(-) create mode 100644 R/paren_body_linter.R create mode 100644 tests/testthat/test-paren_body_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 872236df53..8a4ddfe4c6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -75,6 +75,7 @@ Collate: 'no_tab_linter.R' 'object_usage_linter.R' 'open_curly_linter.R' + 'paren_body_linter.R' 'paren_brace_linter.R' 'path_linters.R' 'pipe_call_linter.R' diff --git a/NAMESPACE b/NAMESPACE index becf3a8eb4..a9295d2fcd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,6 +51,7 @@ export(object_length_linter) export(object_name_linter) export(object_usage_linter) export(open_curly_linter) +export(paren_body_linter) export(paren_brace_linter) export(pipe_call_linter) export(pipe_continuation_linter) diff --git a/R/paren_body_linter.R b/R/paren_body_linter.R new file mode 100644 index 0000000000..c126f4b991 --- /dev/null +++ b/R/paren_body_linter.R @@ -0,0 +1,33 @@ +#' @describeIn linters check that there is a space between the +#' right parenthesis and the function body when no braces are used +#' to define a function. +#' +#' @export +paren_body_linter <- function() { + Linter(function(source_file) { + if (is.null(source_file$xml_parsed_content)) return(NULL) + + xpath <- paste( + "//expr[", + "@line1 = preceding-sibling::FUNCTION/@line1", + "and", + "@col1 = preceding-sibling::OP-RIGHT-PAREN/@col1 + 1", + "]" + ) + matched_expressions <- xml2::xml_find_all(source_file$xml_parsed_content, xpath) + + lapply(matched_expressions, get_lint_from_expression, source_file = source_file) + }) +} + +get_lint_from_expression <- function(expression, source_file) { + expression <- xml2::as_list(expression) + Lint( + filename = source_file$filename, + message = "There should be a space between the right parenthesis and the function body.", + column_number = expression@col1, + line_number = expression@line1, + line = source_file$lines[[as.character(expression@line1)]], + ranges = list(as.integer(c(expression@col1, expression@col2))) + ) +} \ No newline at end of file diff --git a/R/zzz.R b/R/zzz.R index c64baa8768..ae4bc7be2b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -97,6 +97,7 @@ default_linters <- with_defaults( object_name_linter(), object_usage_linter(), open_curly_linter(), + paren_body_linter(), paren_brace_linter(), pipe_continuation_linter(), semicolon_terminator_linter(), diff --git a/man/default_linters.Rd b/man/default_linters.Rd index 08d072337b..c3aaaec7d3 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 diff --git a/man/linters.Rd b/man/linters.Rd index cd05b469ae..72ceb0da20 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -7,13 +7,14 @@ % R/implicit_integer_linter.R, R/infix_spaces_linter.R, % R/line_length_linter.R, R/missing_argument_linter.R, % R/missing_package_linter.R, R/namespace_linter.R, R/no_tab_linter.R, -% R/object_usage_linter.R, R/open_curly_linter.R, R/paren_brace_linter.R, -% R/path_linters.R, R/pipe_call_linter.R, R/pipe_continuation_linter.R, -% R/semicolon_terminator_linter.R, R/seq_linter.R, R/single_quotes_linter.R, -% R/spaces_inside_linter.R, R/spaces_left_parentheses_linter.R, -% R/sprintf_linter.R, R/trailing_blank_lines_linter.R, -% R/trailing_whitespace_linter.R, R/undesirable_function_linter.R, -% R/undesirable_operator_linter.R, R/unneeded_concatenation_linter.R +% R/object_usage_linter.R, R/open_curly_linter.R, R/paren_body_linter.R, +% R/paren_brace_linter.R, R/path_linters.R, R/pipe_call_linter.R, +% R/pipe_continuation_linter.R, R/semicolon_terminator_linter.R, +% R/seq_linter.R, R/single_quotes_linter.R, R/spaces_inside_linter.R, +% R/spaces_left_parentheses_linter.R, R/sprintf_linter.R, +% R/trailing_blank_lines_linter.R, R/trailing_whitespace_linter.R, +% R/undesirable_function_linter.R, R/undesirable_operator_linter.R, +% R/unneeded_concatenation_linter.R \name{linters} \alias{linters} \alias{T_and_F_symbol_linter} @@ -39,6 +40,7 @@ \alias{no_tab_linter} \alias{object_usage_linter} \alias{open_curly_linter} +\alias{paren_body_linter} \alias{paren_brace_linter} \alias{absolute_path_linter} \alias{nonportable_path_linter} @@ -103,6 +105,8 @@ object_usage_linter() open_curly_linter(allow_single_line = FALSE) +paren_body_linter() + paren_brace_linter() absolute_path_linter(lax = TRUE) @@ -257,6 +261,10 @@ load packages used in user code so it could potentially change the global state. \item \code{open_curly_linter}: Check that opening curly braces are never on their own line and are always followed by a newline. +\item \code{paren_body_linter}: check that there is a space between the +right parenthesis and the function body when no braces are used +to define a function. + \item \code{paren_brace_linter}: check that there is a space between right parenthesis and an opening curly brace. diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R new file mode 100644 index 0000000000..f8e576dd4d --- /dev/null +++ b/tests/testthat/test-paren_body_linter.R @@ -0,0 +1,41 @@ +testthat::test_that("paren_body_linter returns correct lints", { + linter <- paren_body_linter() + msg <- "There should be a space between the right parenthesis and the function body." + + # No space after the closing parenthesis prompts a lint + expect_lint("function()test", msg, linter) + expect_lint("print('hello')\nx <- function(x)NULL\nprint('hello')", msg, linter) + + # A space after the closing parenthesis does not prompt a lint + expect_lint("function() test", NULL, linter) + + # Symbols after the closing parentheses of a function call do not prompt a lint + expect_lint("head(mtcars)$cyl", NULL, linter) + + # paren_body_linter returns the correct column number + expect_lint("function()test", list(column_number = 11L), linter) + + # paren_body_linter returns the correct line number + expect_lint("function()test", list(line_number = 1L), linter) + expect_lint( + "print('hello')\nx <- function(x)NULL\nprint('hello')", + list(line_number = 2L), + linter + ) + + # paren_body_linter returns the correct type + expect_lint("function()test", list(type = "style"), linter) + + # paren_body_linter returns the correct line + expect_lint("function()test", list(line = "function()test"), linter) + + # paren_body_linter returns the correct range + expect_lint("function()test", list(ranges = list(c(11L, 14L))), linter) + + # paren_body_linter does not lint when the function body is defined + # on a new line + expect_lint("function()\n test", NULL, linter) + + # paren_body_linter does not lint comments + expect_lint("#function()test", NULL, linter) +}) From cfcf93ca09455c03d0e654ae9b132c7bce6fc1c3 Mon Sep 17 00:00:00 2001 From: Konrad Pagacz Date: Wed, 7 Jul 2021 18:10:52 +0200 Subject: [PATCH 02/10] Added a new line at the end of paren_body_linter.R --- R/paren_body_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/paren_body_linter.R b/R/paren_body_linter.R index c126f4b991..176ae6779e 100644 --- a/R/paren_body_linter.R +++ b/R/paren_body_linter.R @@ -30,4 +30,4 @@ get_lint_from_expression <- function(expression, source_file) { line = source_file$lines[[as.character(expression@line1)]], ranges = list(as.integer(c(expression@col1, expression@col2))) ) -} \ No newline at end of file +} From d129dfd768187ecdc52b3a022df0caf20cf6546a Mon Sep 17 00:00:00 2001 From: Konrad Pagacz Date: Fri, 9 Jul 2021 16:08:27 +0200 Subject: [PATCH 03/10] Updated after review no 1 --- R/paren_body_linter.R | 33 ++++++++-------- tests/testthat/test-paren_body_linter.R | 50 +++++++++++++------------ 2 files changed, 45 insertions(+), 38 deletions(-) diff --git a/R/paren_body_linter.R b/R/paren_body_linter.R index 176ae6779e..86ca558be0 100644 --- a/R/paren_body_linter.R +++ b/R/paren_body_linter.R @@ -6,28 +6,31 @@ paren_body_linter <- function() { Linter(function(source_file) { if (is.null(source_file$xml_parsed_content)) return(NULL) - + xpath <- paste( "//expr[", "@line1 = preceding-sibling::FUNCTION/@line1", + "|", + "preceding-sibling::IF/@line1", + "|", + "preceding-sibling::WHILE/@line1", "and", "@col1 = preceding-sibling::OP-RIGHT-PAREN/@col1 + 1", + "]", + "|", + "//expr[", + "@line1 = preceding-sibling::forcond/@line1", + "and", + "@col1 = preceding-sibling::forcond/OP-RIGHT-PAREN/@col1 + 1", "]" ) matched_expressions <- xml2::xml_find_all(source_file$xml_parsed_content, xpath) - - lapply(matched_expressions, get_lint_from_expression, source_file = source_file) - }) -} -get_lint_from_expression <- function(expression, source_file) { - expression <- xml2::as_list(expression) - Lint( - filename = source_file$filename, - message = "There should be a space between the right parenthesis and the function body.", - column_number = expression@col1, - line_number = expression@line1, - line = source_file$lines[[as.character(expression@line1)]], - ranges = list(as.integer(c(expression@col1, expression@col2))) - ) + lapply( + matched_expressions, + xml_nodes_to_lint, + source_file = source_file, + message = "There should be a space between right parenthesis and a body expression." + ) + }) } diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R index f8e576dd4d..f5edfb5c1c 100644 --- a/tests/testthat/test-paren_body_linter.R +++ b/tests/testthat/test-paren_body_linter.R @@ -1,41 +1,45 @@ testthat::test_that("paren_body_linter returns correct lints", { linter <- paren_body_linter() - msg <- "There should be a space between the right parenthesis and the function body." - + msg <- "There should be a space between right parenthesis and a body expression." + # No space after the closing parenthesis prompts a lint expect_lint("function()test", msg, linter) expect_lint("print('hello')\nx <- function(x)NULL\nprint('hello')", msg, linter) - + expect_lint("if (TRUE)test", msg, linter) + expect_lint("while (TRUE)test", msg, linter) + expect_lint("for (i in seq_along(1))test", msg, linter) + # A space after the closing parenthesis does not prompt a lint expect_lint("function() test", NULL, linter) - - # Symbols after the closing parentheses of a function call do not prompt a lint + + # Symbols after the closing parenthesis of a function call do not prompt a lint expect_lint("head(mtcars)$cyl", NULL, linter) - - # paren_body_linter returns the correct column number - expect_lint("function()test", list(column_number = 11L), linter) - + # paren_body_linter returns the correct line number - expect_lint("function()test", list(line_number = 1L), linter) expect_lint( "print('hello')\nx <- function(x)NULL\nprint('hello')", list(line_number = 2L), linter ) - - # paren_body_linter returns the correct type - expect_lint("function()test", list(type = "style"), linter) - - # paren_body_linter returns the correct line - expect_lint("function()test", list(line = "function()test"), linter) - - # paren_body_linter returns the correct range - expect_lint("function()test", list(ranges = list(c(11L, 14L))), linter) - - # paren_body_linter does not lint when the function body is defined - # on a new line + + expect_lint( + "function()test", + list( + line_number = 1L, + column_number = 11L, + type = "style", + line = c("1" = "function()test"), + ranges = list(c(11L, 14L)) + ), + linter + ) + + # paren_body_linter does not lint when the function body is defined on a new line expect_lint("function()\n test", NULL, linter) - + # paren_body_linter does not lint comments expect_lint("#function()test", NULL, linter) + + # multiple lints on the same line + expect_lint("function()if(TRUE)while(TRUE)test", list(msg, msg, msg), linter) }) From 7eb25d2c064b0a2295fcb7d7d083880507bcef74 Mon Sep 17 00:00:00 2001 From: Konrad Pagacz Date: Fri, 9 Jul 2021 16:16:45 +0200 Subject: [PATCH 04/10] Added `\` --- R/paren_body_linter.R | 2 ++ tests/testthat/test-paren_body_linter.R | 1 + 2 files changed, 3 insertions(+) diff --git a/R/paren_body_linter.R b/R/paren_body_linter.R index 86ca558be0..9ebbf02384 100644 --- a/R/paren_body_linter.R +++ b/R/paren_body_linter.R @@ -14,6 +14,8 @@ paren_body_linter <- function() { "preceding-sibling::IF/@line1", "|", "preceding-sibling::WHILE/@line1", + "|", + "preceding-sibling::OP-LAMBDA/@line1", "and", "@col1 = preceding-sibling::OP-RIGHT-PAREN/@col1 + 1", "]", diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R index f5edfb5c1c..ebf4ea5d76 100644 --- a/tests/testthat/test-paren_body_linter.R +++ b/tests/testthat/test-paren_body_linter.R @@ -8,6 +8,7 @@ testthat::test_that("paren_body_linter returns correct lints", { expect_lint("if (TRUE)test", msg, linter) expect_lint("while (TRUE)test", msg, linter) expect_lint("for (i in seq_along(1))test", msg, linter) + expect_lint("\\()test", msg, linter) # A space after the closing parenthesis does not prompt a lint expect_lint("function() test", NULL, linter) From 5bb7b23ef1958d13b3d7fb457f377c3598e15c2b Mon Sep 17 00:00:00 2001 From: Konrad Pagacz Date: Sat, 10 Jul 2021 06:50:27 +0200 Subject: [PATCH 05/10] Updated NEWS and README --- NEWS.md | 1 + README.md | 1 + 2 files changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index adfb1c6ebb..0956b47cb2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -68,6 +68,7 @@ * `get_source_expressions()` no longer fails if `getParseData()` returns a truncated (invalid) Unicode character as parsed text (#815, #816, @leogama) * lintr now supports non-system character Encodings. Auto-detects the correct encoding from .Rproj or DESCRIPTION files in your project. Override the default in the `encoding` setting of lintr. (#752, #782, @AshesITR) +* New `paren_body_linter()` (#809, #830, @kpagacz) # lintr 2.0.1 diff --git a/README.md b/README.md index b4341eb72f..d586102ccc 100644 --- a/README.md +++ b/README.md @@ -60,6 +60,7 @@ If you need a bit automatic help for re-styling your code, have a look at [the ` [base::eval()](https://rdrr.io/r/base/eval.html) on the code, so do not use with untrusted code. * `open_curly_linter`: check that opening curly braces are never on their own line and are always followed by a newline. +* `paren_body_linter`: check that there is a space between right parenthesis and a body expression. * `paren_brace_linter`: check that there is a space between right parenthesis and an opening curly brace. * `pipe_call_linter`: force explicit calls in magrittr pipes. * `pipe_continuation_linter`: Check that each step in a pipeline is on a new From 268286a17dcb671868eaa653d69a07fc3c51cdba Mon Sep 17 00:00:00 2001 From: Alexander Rosenstock Date: Wed, 14 Jul 2021 08:12:24 +0200 Subject: [PATCH 06/10] update roxygen and document() --- R/paren_body_linter.R | 4 +--- man/checkstyle_output.Rd | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/R/paren_body_linter.R b/R/paren_body_linter.R index 9ebbf02384..0684e2b876 100644 --- a/R/paren_body_linter.R +++ b/R/paren_body_linter.R @@ -1,6 +1,4 @@ -#' @describeIn linters check that there is a space between the -#' right parenthesis and the function body when no braces are used -#' to define a function. +#' @describeIn linters check that there is a space between right parenthesis and a body expression. #' #' @export paren_body_linter <- function() { diff --git a/man/checkstyle_output.Rd b/man/checkstyle_output.Rd index 77991de1cb..c4d40b2e1d 100644 --- a/man/checkstyle_output.Rd +++ b/man/checkstyle_output.Rd @@ -13,5 +13,5 @@ checkstyle_output(lints, filename = "lintr_results.xml") } \description{ Generate a report of the linting results using the -\href{https://checkstyle.sourceforge.io/}{Checkstyle} XML format. +\href{http://checkstyle.sourceforge.net/}{Checkstyle} XML format. } From c759017b5b18604a6ef3cbd6ac07d12251f2db59 Mon Sep 17 00:00:00 2001 From: Alexander Rosenstock Date: Wed, 14 Jul 2021 08:12:42 +0200 Subject: [PATCH 07/10] update roxygen and document() --- man/linters.Rd | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/man/linters.Rd b/man/linters.Rd index 72ceb0da20..5838d7389b 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -261,9 +261,7 @@ load packages used in user code so it could potentially change the global state. \item \code{open_curly_linter}: Check that opening curly braces are never on their own line and are always followed by a newline. -\item \code{paren_body_linter}: check that there is a space between the -right parenthesis and the function body when no braces are used -to define a function. +\item \code{paren_body_linter}: check that there is a space between right parenthesis and a body expression. \item \code{paren_brace_linter}: check that there is a space between right parenthesis and an opening curly brace. From 976e4b54ff09f4447f00913d975bdd4c38581e23 Mon Sep 17 00:00:00 2001 From: Konrad Pagacz Date: Wed, 14 Jul 2021 18:42:41 +0200 Subject: [PATCH 08/10] Added a skip condition to the test with syntax available since R 4.1.0 --- tests/testthat/test-paren_body_linter.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R index ebf4ea5d76..8aa42e0e94 100644 --- a/tests/testthat/test-paren_body_linter.R +++ b/tests/testthat/test-paren_body_linter.R @@ -8,7 +8,6 @@ testthat::test_that("paren_body_linter returns correct lints", { expect_lint("if (TRUE)test", msg, linter) expect_lint("while (TRUE)test", msg, linter) expect_lint("for (i in seq_along(1))test", msg, linter) - expect_lint("\\()test", msg, linter) # A space after the closing parenthesis does not prompt a lint expect_lint("function() test", NULL, linter) @@ -43,4 +42,11 @@ testthat::test_that("paren_body_linter returns correct lints", { # multiple lints on the same line expect_lint("function()if(TRUE)while(TRUE)test", list(msg, msg, msg), linter) + + # No space after the closing parenthesis of an anonymous function prompts a lint + testthat::skip_if( + compareVersion(paste(R.version$major, R.version$minor, sep = "."), "4.1.0") < 0, + message = "Not run on R version < 4.1.0" + ) + expect_lint("\\()test", msg, linter) }) From c981ced2ffdd420ff513296f59b7f888d450d18d Mon Sep 17 00:00:00 2001 From: Konrad Pagacz Date: Wed, 14 Jul 2021 22:42:54 +0200 Subject: [PATCH 09/10] Refactored comparing versions --- tests/testthat/test-paren_body_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-paren_body_linter.R b/tests/testthat/test-paren_body_linter.R index 8aa42e0e94..dd36dc2080 100644 --- a/tests/testthat/test-paren_body_linter.R +++ b/tests/testthat/test-paren_body_linter.R @@ -45,7 +45,7 @@ testthat::test_that("paren_body_linter returns correct lints", { # No space after the closing parenthesis of an anonymous function prompts a lint testthat::skip_if( - compareVersion(paste(R.version$major, R.version$minor, sep = "."), "4.1.0") < 0, + getRversion() < "4.1", message = "Not run on R version < 4.1.0" ) expect_lint("\\()test", msg, linter) From 57ef0bee85cb9ece12a639a0023337a889584237 Mon Sep 17 00:00:00 2001 From: Alexander Rosenstock Date: Wed, 14 Jul 2021 23:16:32 +0200 Subject: [PATCH 10/10] update NEWS to indicate paren_body_linter() is a default linter. --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 0956b47cb2..7eeef58290 100644 --- a/NEWS.md +++ b/NEWS.md @@ -68,7 +68,8 @@ * `get_source_expressions()` no longer fails if `getParseData()` returns a truncated (invalid) Unicode character as parsed text (#815, #816, @leogama) * lintr now supports non-system character Encodings. Auto-detects the correct encoding from .Rproj or DESCRIPTION files in your project. Override the default in the `encoding` setting of lintr. (#752, #782, @AshesITR) -* New `paren_body_linter()` (#809, #830, @kpagacz) +* New default linter `paren_body_linter()` checks that there is a space between right parenthesis and a body + expression. (#809, #830, @kpagacz) # lintr 2.0.1