From b6fd3b232a345f1fbe58b969c35ef09cec03b66f Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 09:07:42 +0200 Subject: [PATCH 01/11] Add `allow_trailing_comma` parameter to `commas_linter` --- R/commas_linter.R | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/R/commas_linter.R b/R/commas_linter.R index d7ff5ac143..478514b63f 100644 --- a/R/commas_linter.R +++ b/R/commas_linter.R @@ -2,6 +2,9 @@ #' #' Check that all commas are followed by spaces, but do not have spaces before them. #' +#' @param allow_trailing_comma If `TRUE`, the linter allows a comma to be followed +#' directly by a closing bracket without a space. +#' #' @examples #' # will produce lints #' lint( @@ -19,6 +22,11 @@ #' linters = commas_linter() #' ) #' +#' lint( +#' text = "x[1,]", +#' linters = commas_linter() +#' ) +#' #' # okay #' lint( #' text = "switch(op, x = foo, y = bar)", @@ -40,12 +48,17 @@ #' linters = commas_linter() #' ) #' +#' lint( +#' text = "x[1,]", +#' linters = commas_linter(allow_trailing_comma = TRUE) +#' ) +#' #' @evalRd rd_tags("commas_linter") #' @seealso #' - [linters] for a complete list of linters available in lintr. #' - #' @export -commas_linter <- function() { +commas_linter <- function(allow_trailing_comma = FALSE) { # conditions are in carefully-chosen order for performance -- # an expression like c(a,b,c,....) with many elements can have # a huge number of preceding-siblings and the performance of @@ -58,7 +71,11 @@ commas_linter <- function() { @line1 = preceding-sibling::*[1]/@line1 and not(preceding-sibling::*[1][self::OP-COMMA or self::EQ_SUB]) ]" - xpath_after <- "//OP-COMMA[@line1 = following-sibling::*[1]/@line1 and @col1 = following-sibling::*[1]/@col1 - 1]" + xpath_after <- paste0( + "//OP-COMMA[@line1 = following-sibling::*[1]/@line1 and @col1 = following-sibling::*[1]/@col1 - 1", + if(allow_trailing_comma) " and not(following-sibling::*[1]/self::OP-RIGHT-BRACKET)", + "]" + ) Linter(function(source_expression) { if (!is_lint_level(source_expression, "expression")) { From 983edd2f93b302848c96871ec4ddb6dd66845ca7 Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 09:08:37 +0200 Subject: [PATCH 02/11] `commas_linter` tests use new parameter --- tests/testthat/test-commas_linter.R | 55 ++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index 0bb9e2abd2..f01ec7048f 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -1,4 +1,4 @@ -test_that("returns the correct linting", { +test_that("returns the correct linting (with default parameters)", { linter <- commas_linter() msg_after <- rex::rex("Commas should always have a space after.") msg_before <- rex::rex("Commas should never have a space before.") @@ -13,6 +13,8 @@ test_that("returns the correct linting", { expect_lint("fun(1\n,1)", msg_after, linter) expect_lint("fun(1,1)", msg_after, linter) expect_lint("\nfun(1,1)", msg_after, linter) + expect_lint("a(1,)", msg_after, linter) + expect_lint("a[1,]", msg_after, linter) expect_lint( "fun(1 ,1)", list( @@ -46,3 +48,54 @@ test_that("returns the correct linting", { linter ) }) + +test_that("returns the correct linting (with 'allow_trailing_comma' set)", { + linter <- commas_linter(allow_trailing_comma = TRUE) + msg_after <- rex::rex("Commas should always have a space after.") + msg_before <- rex::rex("Commas should never have a space before.") + + expect_lint("blah", NULL, linter) + expect_lint("fun(1, 1)", NULL, linter) + expect_lint("fun(1,\n 1)", NULL, linter) + expect_lint("fun(1,\n1)", NULL, linter) + expect_lint("fun(1\n,\n1)", NULL, linter) + expect_lint("fun(1\n ,\n1)", NULL, linter) + expect_lint("a[1,]", NULL, linter) + + expect_lint("fun(1\n,1)", msg_after, linter) + expect_lint("fun(1,1)", msg_after, linter) + expect_lint("\nfun(1,1)", msg_after, linter) + expect_lint("a(1,)", msg_after, linter) + expect_lint( + "fun(1 ,1)", + list( + msg_before, + msg_after + ), + linter + ) + + expect_lint("\"fun(1 ,1)\"", NULL, linter) + expect_lint("a[1, , 2]", NULL, linter) + expect_lint("a[1, , 2, , 3]", NULL, linter) + + expect_lint("switch(op, x = foo, y = bar)", NULL, linter) + expect_lint("switch(op, x = , y = bar)", NULL, linter) + expect_lint("switch(op, \"x\" = , y = bar)", NULL, linter) + expect_lint("switch(op, x = ,\ny = bar)", NULL, linter) + + expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) + expect_lint("switch(op, x = foo , y = bar)", msg_before, linter) + expect_lint("switch(op , x = foo, y = bar)", msg_before, linter) + expect_lint("switch(op, x = foo, y = bar(a = 4 , b = 5))", msg_before, linter) + expect_lint("fun(op, x = foo , y = switch(bar, a = 4, b = 5))", msg_before, linter) + + expect_lint( + "fun(op ,bar)", + list( + list(message = msg_before, column_number = 7L, ranges = list(c(7L, 10L))), + list(message = msg_after, column_number = 12L, ranges = list(c(12L, 12L))) + ), + linter + ) +}) \ No newline at end of file From a83523ce9dce0dc2c8257fb8858fa2590559a488 Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 09:35:20 +0200 Subject: [PATCH 03/11] Lint annotations incorporated --- R/commas_linter.R | 2 +- tests/testthat/test-commas_linter.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/commas_linter.R b/R/commas_linter.R index 478514b63f..2e3f139958 100644 --- a/R/commas_linter.R +++ b/R/commas_linter.R @@ -73,7 +73,7 @@ commas_linter <- function(allow_trailing_comma = FALSE) { ]" xpath_after <- paste0( "//OP-COMMA[@line1 = following-sibling::*[1]/@line1 and @col1 = following-sibling::*[1]/@col1 - 1", - if(allow_trailing_comma) " and not(following-sibling::*[1]/self::OP-RIGHT-BRACKET)", + if (allow_trailing_comma) " and not(following-sibling::*[1]/self::OP-RIGHT-BRACKET)", "]" ) diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index f01ec7048f..ca881840ac 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -98,4 +98,4 @@ test_that("returns the correct linting (with 'allow_trailing_comma' set)", { ), linter ) -}) \ No newline at end of file +}) From 67230a04ac43de627f31e65a005cc0f670ed407e Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 09:52:04 +0200 Subject: [PATCH 04/11] Update `commas_linter` doc --- man/commas_linter.Rd | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/man/commas_linter.Rd b/man/commas_linter.Rd index 8c005e68cc..a0a9e15bcb 100644 --- a/man/commas_linter.Rd +++ b/man/commas_linter.Rd @@ -4,7 +4,11 @@ \alias{commas_linter} \title{Commas linter} \usage{ -commas_linter() +commas_linter(allow_trailing_comma = FALSE) +} +\arguments{ +\item{allow_trailing_comma}{If \code{TRUE}, the linter allows a comma to be followed +directly by a closing bracket without a space.} } \description{ Check that all commas are followed by spaces, but do not have spaces before them. @@ -26,6 +30,11 @@ lint( linters = commas_linter() ) +lint( + text = "x[1,]", + linters = commas_linter() +) + # okay lint( text = "switch(op, x = foo, y = bar)", @@ -47,6 +56,11 @@ lint( linters = commas_linter() ) +lint( + text = "x[1,]", + linters = commas_linter(allow_trailing_comma = TRUE) +) + } \seealso{ \itemize{ From cb88d3fc541fcfbbaaf4f1639e852650bda46a42 Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 10:11:30 +0200 Subject: [PATCH 05/11] Add changes of `commas_linter` to NEWS --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index c2a2fbf11d..02692cf474 100644 --- a/NEWS.md +++ b/NEWS.md @@ -40,6 +40,7 @@ * `keyword_quote_linter()` for finding unnecessary or discouraged quoting of symbols in assignment, function arguments, or extraction (part of #884, @MichaelChirico). Quoting is unnecessary when the target is a valid R name, e.g. `c("a" = 1)` can be `c(a = 1)`. The same goes to assignment (`"a" <- 1`) and extraction (`x$"a"`). Where quoting is necessary, the linter encourages doing so with backticks (e.g. `` x$`a b` `` instead of `x$"a b"`). * `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico). * `if_not_else_linter()` for encouraging `if` statements to be structured as `if (A) x else y` instead of `if (!A) y else x` (part of #884, @MichaelChirico). +* `commas_linter()` add parameter `allow_trailing_comma` to allow trailing commas while indexing. ## Changes to defaults From 176ecdc7b5f8f71efb16aa15471127299c49e863 Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 10:35:11 +0200 Subject: [PATCH 06/11] Add 'configurable' tag to `commas_linter` --- inst/lintr/linters.csv | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 263c0d345f..d49834abab 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -8,7 +8,7 @@ boolean_arithmetic_linter,efficiency best_practices readability brace_linter,style readability default configurable class_equals_linter,best_practices robustness consistency closed_curly_linter,style readability deprecated configurable -commas_linter,style readability default +commas_linter,style readability default configurable commented_code_linter,style readability best_practices default condition_message_linter,best_practices consistency conjunct_test_linter,package_development best_practices readability configurable pkg_testthat From 69ffa1e3a2279e7aa475b9c8f848a65b7ea70905 Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 10:41:05 +0200 Subject: [PATCH 07/11] Update tag dependent docs --- man/commas_linter.Rd | 2 +- man/configurable_linters.Rd | 1 + man/linters.Rd | 4 ++-- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/man/commas_linter.Rd b/man/commas_linter.Rd index a0a9e15bcb..c309d396dd 100644 --- a/man/commas_linter.Rd +++ b/man/commas_linter.Rd @@ -69,5 +69,5 @@ lint( } } \section{Tags}{ -\link[=default_linters]{default}, \link[=readability_linters]{readability}, \link[=style_linters]{style} +\link[=configurable_linters]{configurable}, \link[=default_linters]{default}, \link[=readability_linters]{readability}, \link[=style_linters]{style} } diff --git a/man/configurable_linters.Rd b/man/configurable_linters.Rd index f92ca3b0ca..6526073361 100644 --- a/man/configurable_linters.Rd +++ b/man/configurable_linters.Rd @@ -16,6 +16,7 @@ The following linters are tagged with 'configurable': \item{\code{\link{assignment_linter}}} \item{\code{\link{backport_linter}}} \item{\code{\link{brace_linter}}} +\item{\code{\link{commas_linter}}} \item{\code{\link{conjunct_test_linter}}} \item{\code{\link{cyclocomp_linter}}} \item{\code{\link{duplicate_argument_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index bf56015070..60f7ae87b9 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -19,7 +19,7 @@ The following tags exist: \itemize{ \item{\link[=best_practices_linters]{best_practices} (52 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (7 linters)} -\item{\link[=configurable_linters]{configurable} (31 linters)} +\item{\link[=configurable_linters]{configurable} (32 linters)} \item{\link[=consistency_linters]{consistency} (21 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} @@ -44,7 +44,7 @@ The following linters exist: \item{\code{\link{boolean_arithmetic_linter}} (tags: best_practices, efficiency, readability)} \item{\code{\link{brace_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{class_equals_linter}} (tags: best_practices, consistency, robustness)} -\item{\code{\link{commas_linter}} (tags: default, readability, style)} +\item{\code{\link{commas_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{commented_code_linter}} (tags: best_practices, default, readability, style)} \item{\code{\link{condition_message_linter}} (tags: best_practices, consistency)} \item{\code{\link{conjunct_test_linter}} (tags: best_practices, configurable, package_development, pkg_testthat, readability)} From 6c1415965673053afe52736d5526dbed31d21ee3 Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 21:12:07 +0200 Subject: [PATCH 08/11] Ignore trailing commas on 'RBB' and 'OP-RIGHT-PAREN' --- R/commas_linter.R | 2 +- tests/testthat/test-commas_linter.R | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/commas_linter.R b/R/commas_linter.R index 2e3f139958..8b462d7da6 100644 --- a/R/commas_linter.R +++ b/R/commas_linter.R @@ -73,7 +73,7 @@ commas_linter <- function(allow_trailing_comma = FALSE) { ]" xpath_after <- paste0( "//OP-COMMA[@line1 = following-sibling::*[1]/@line1 and @col1 = following-sibling::*[1]/@col1 - 1", - if (allow_trailing_comma) " and not(following-sibling::*[1]/self::OP-RIGHT-BRACKET)", + if (allow_trailing_comma) " and not(following-sibling::*[1][self::OP-RIGHT-BRACKET or self::RBB or self::OP-RIGHT-PAREN])", "]" ) diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index ca881840ac..4203b9bcc8 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -15,6 +15,7 @@ test_that("returns the correct linting (with default parameters)", { expect_lint("\nfun(1,1)", msg_after, linter) expect_lint("a(1,)", msg_after, linter) expect_lint("a[1,]", msg_after, linter) + expect_lint("a[[1,]]", msg_after, linter) expect_lint( "fun(1 ,1)", list( @@ -61,11 +62,11 @@ test_that("returns the correct linting (with 'allow_trailing_comma' set)", { expect_lint("fun(1\n,\n1)", NULL, linter) expect_lint("fun(1\n ,\n1)", NULL, linter) expect_lint("a[1,]", NULL, linter) + expect_lint("a(1,)", NULL, linter) expect_lint("fun(1\n,1)", msg_after, linter) expect_lint("fun(1,1)", msg_after, linter) expect_lint("\nfun(1,1)", msg_after, linter) - expect_lint("a(1,)", msg_after, linter) expect_lint( "fun(1 ,1)", list( @@ -78,6 +79,7 @@ test_that("returns the correct linting (with 'allow_trailing_comma' set)", { expect_lint("\"fun(1 ,1)\"", NULL, linter) expect_lint("a[1, , 2]", NULL, linter) expect_lint("a[1, , 2, , 3]", NULL, linter) + expect_lint("a[[1,]]", NULL, linter) expect_lint("switch(op, x = foo, y = bar)", NULL, linter) expect_lint("switch(op, x = , y = bar)", NULL, linter) From 4038152f891aa488775cdd624c8bfbc00b2b57f9 Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 21:14:21 +0200 Subject: [PATCH 09/11] Reduce parameter to `allow_trailing` --- NEWS.md | 2 +- R/commas_linter.R | 8 ++++---- man/commas_linter.Rd | 6 +++--- tests/testthat/test-commas_linter.R | 4 ++-- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/NEWS.md b/NEWS.md index 02692cf474..d8b3b9819b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -40,7 +40,7 @@ * `keyword_quote_linter()` for finding unnecessary or discouraged quoting of symbols in assignment, function arguments, or extraction (part of #884, @MichaelChirico). Quoting is unnecessary when the target is a valid R name, e.g. `c("a" = 1)` can be `c(a = 1)`. The same goes to assignment (`"a" <- 1`) and extraction (`x$"a"`). Where quoting is necessary, the linter encourages doing so with backticks (e.g. `` x$`a b` `` instead of `x$"a b"`). * `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico). * `if_not_else_linter()` for encouraging `if` statements to be structured as `if (A) x else y` instead of `if (!A) y else x` (part of #884, @MichaelChirico). -* `commas_linter()` add parameter `allow_trailing_comma` to allow trailing commas while indexing. +* `commas_linter()` add parameter `allow_trailing` to allow trailing commas while indexing. ## Changes to defaults diff --git a/R/commas_linter.R b/R/commas_linter.R index 8b462d7da6..a97764cab8 100644 --- a/R/commas_linter.R +++ b/R/commas_linter.R @@ -2,7 +2,7 @@ #' #' Check that all commas are followed by spaces, but do not have spaces before them. #' -#' @param allow_trailing_comma If `TRUE`, the linter allows a comma to be followed +#' @param allow_trailing If `TRUE`, the linter allows a comma to be followed #' directly by a closing bracket without a space. #' #' @examples @@ -50,7 +50,7 @@ #' #' lint( #' text = "x[1,]", -#' linters = commas_linter(allow_trailing_comma = TRUE) +#' linters = commas_linter(allow_trailing = TRUE) #' ) #' #' @evalRd rd_tags("commas_linter") @@ -58,7 +58,7 @@ #' - [linters] for a complete list of linters available in lintr. #' - #' @export -commas_linter <- function(allow_trailing_comma = FALSE) { +commas_linter <- function(allow_trailing = FALSE) { # conditions are in carefully-chosen order for performance -- # an expression like c(a,b,c,....) with many elements can have # a huge number of preceding-siblings and the performance of @@ -73,7 +73,7 @@ commas_linter <- function(allow_trailing_comma = FALSE) { ]" xpath_after <- paste0( "//OP-COMMA[@line1 = following-sibling::*[1]/@line1 and @col1 = following-sibling::*[1]/@col1 - 1", - if (allow_trailing_comma) " and not(following-sibling::*[1][self::OP-RIGHT-BRACKET or self::RBB or self::OP-RIGHT-PAREN])", + if (allow_trailing) " and not(following-sibling::*[1][self::OP-RIGHT-BRACKET or self::RBB or self::OP-RIGHT-PAREN])", "]" ) diff --git a/man/commas_linter.Rd b/man/commas_linter.Rd index c309d396dd..c7e679235d 100644 --- a/man/commas_linter.Rd +++ b/man/commas_linter.Rd @@ -4,10 +4,10 @@ \alias{commas_linter} \title{Commas linter} \usage{ -commas_linter(allow_trailing_comma = FALSE) +commas_linter(allow_trailing = FALSE) } \arguments{ -\item{allow_trailing_comma}{If \code{TRUE}, the linter allows a comma to be followed +\item{allow_trailing}{If \code{TRUE}, the linter allows a comma to be followed directly by a closing bracket without a space.} } \description{ @@ -58,7 +58,7 @@ lint( lint( text = "x[1,]", - linters = commas_linter(allow_trailing_comma = TRUE) + linters = commas_linter(allow_trailing = TRUE) ) } diff --git a/tests/testthat/test-commas_linter.R b/tests/testthat/test-commas_linter.R index 4203b9bcc8..eaceb651f3 100644 --- a/tests/testthat/test-commas_linter.R +++ b/tests/testthat/test-commas_linter.R @@ -50,8 +50,8 @@ test_that("returns the correct linting (with default parameters)", { ) }) -test_that("returns the correct linting (with 'allow_trailing_comma' set)", { - linter <- commas_linter(allow_trailing_comma = TRUE) +test_that("returns the correct linting (with 'allow_trailing' set)", { + linter <- commas_linter(allow_trailing = TRUE) msg_after <- rex::rex("Commas should always have a space after.") msg_before <- rex::rex("Commas should never have a space before.") From 2838a6a0cdef36909a3f8daa0943d5241f358e2f Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 21:22:14 +0200 Subject: [PATCH 10/11] Adaptation to NEWS style --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index d8b3b9819b..4aa15a2721 100644 --- a/NEWS.md +++ b/NEWS.md @@ -40,7 +40,7 @@ * `keyword_quote_linter()` for finding unnecessary or discouraged quoting of symbols in assignment, function arguments, or extraction (part of #884, @MichaelChirico). Quoting is unnecessary when the target is a valid R name, e.g. `c("a" = 1)` can be `c(a = 1)`. The same goes to assignment (`"a" <- 1`) and extraction (`x$"a"`). Where quoting is necessary, the linter encourages doing so with backticks (e.g. `` x$`a b` `` instead of `x$"a b"`). * `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico). * `if_not_else_linter()` for encouraging `if` statements to be structured as `if (A) x else y` instead of `if (!A) y else x` (part of #884, @MichaelChirico). -* `commas_linter()` add parameter `allow_trailing` to allow trailing commas while indexing. +* `commas_linter()` gains an option `allow_trailing` (default `FALSE`) to allow trailing commas while indexing. (#2104, @MEO265) ## Changes to defaults From b71d22e3a15f29aae7b2627b7e2f679a28df2dbc Mon Sep 17 00:00:00 2001 From: Matthias Ollech Date: Mon, 4 Sep 2023 21:37:46 +0200 Subject: [PATCH 11/11] Line length under 120 --- R/commas_linter.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/commas_linter.R b/R/commas_linter.R index a97764cab8..88f9c33b88 100644 --- a/R/commas_linter.R +++ b/R/commas_linter.R @@ -72,8 +72,8 @@ commas_linter <- function(allow_trailing = FALSE) { not(preceding-sibling::*[1][self::OP-COMMA or self::EQ_SUB]) ]" xpath_after <- paste0( - "//OP-COMMA[@line1 = following-sibling::*[1]/@line1 and @col1 = following-sibling::*[1]/@col1 - 1", - if (allow_trailing) " and not(following-sibling::*[1][self::OP-RIGHT-BRACKET or self::RBB or self::OP-RIGHT-PAREN])", + "//OP-COMMA[@line1 = following-sibling::*[1]/@line1 and @col1 = following-sibling::*[1]/@col1 - 1 ", + if (allow_trailing) "and not(following-sibling::*[1][self::OP-RIGHT-BRACKET or self::RBB or self::OP-RIGHT-PAREN])", "]" )